{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.TxWits (
  ShelleyTxWits (
    MkShelleyTxWits,
    ShelleyTxWits,
    addrWits,
    bootWits,
    scriptWits
  ),
  ShelleyTxWitsRaw (..),
  scriptShelleyTxWitsL,
  addrShelleyTxWitsL,
  bootAddrShelleyTxWitsL,
  addrWits',
  shelleyEqTxWitsRaw,
) where

import Cardano.Ledger.Binary (
  DecCBOR (decCBOR),
  EncCBOR (encCBOR),
  decodeList,
 )
import Cardano.Ledger.Binary.Coders
import qualified Cardano.Ledger.Binary.Plain as Plain (ToCBOR (..))
import Cardano.Ledger.Core (
  Era,
  EraScript (Script),
  EraTxWits (..),
  ScriptHash,
  hashScript,
 )
import Cardano.Ledger.Hashes (SafeToHash (..))
import Cardano.Ledger.Keys (BootstrapWitness, KeyRole (Witness), WitVKey (..))
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  MemoBytes,
  Memoized (..),
  decodeMemoized,
  getMemoRawType,
  lensMemoRawType,
  mkMemoizedEra,
 )
import Cardano.Ledger.Shelley.Era (ShelleyEra)
import Cardano.Ledger.Shelley.Scripts ()
import Cardano.Ledger.Shelley.TxAuxData ()
import Control.DeepSeq (NFData)
import Data.Functor.Classes (Eq1 (liftEq))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.MapExtras as Map (fromElems)
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import GHC.Records ()
import Lens.Micro (Lens', (^.))
import NoThunks.Class (NoThunks (..))

data ShelleyTxWitsRaw era = ShelleyTxWitsRaw
  { forall era. ShelleyTxWitsRaw era -> Set (WitVKey 'Witness)
stwrAddrTxWits :: !(Set (WitVKey 'Witness))
  , forall era. ShelleyTxWitsRaw era -> Map ScriptHash (Script era)
stwrScriptTxWits :: !(Map ScriptHash (Script era))
  , forall era. ShelleyTxWitsRaw era -> Set BootstrapWitness
stwrBootAddrTxWits :: !(Set BootstrapWitness)
  }
  deriving ((forall x. ShelleyTxWitsRaw era -> Rep (ShelleyTxWitsRaw era) x)
-> (forall x. Rep (ShelleyTxWitsRaw era) x -> ShelleyTxWitsRaw era)
-> Generic (ShelleyTxWitsRaw era)
forall x. Rep (ShelleyTxWitsRaw era) x -> ShelleyTxWitsRaw era
forall x. ShelleyTxWitsRaw era -> Rep (ShelleyTxWitsRaw era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTxWitsRaw era) x -> ShelleyTxWitsRaw era
forall era x. ShelleyTxWitsRaw era -> Rep (ShelleyTxWitsRaw era) x
$cfrom :: forall era x. ShelleyTxWitsRaw era -> Rep (ShelleyTxWitsRaw era) x
from :: forall x. ShelleyTxWitsRaw era -> Rep (ShelleyTxWitsRaw era) x
$cto :: forall era x. Rep (ShelleyTxWitsRaw era) x -> ShelleyTxWitsRaw era
to :: forall x. Rep (ShelleyTxWitsRaw era) x -> ShelleyTxWitsRaw era
Generic)

addrWits' :: ShelleyTxWitsRaw era -> Set (WitVKey 'Witness)
addrWits' :: forall era. ShelleyTxWitsRaw era -> Set (WitVKey 'Witness)
addrWits' = ShelleyTxWitsRaw era -> Set (WitVKey 'Witness)
forall era. ShelleyTxWitsRaw era -> Set (WitVKey 'Witness)
stwrAddrTxWits
{-# DEPRECATED addrWits' "In favor of `stwrAddrTxWits`" #-}

deriving instance EraScript era => Show (ShelleyTxWitsRaw era)

deriving instance EraScript era => Eq (ShelleyTxWitsRaw era)

instance
  ( Era era
  , NFData (Script era)
  , NFData (WitVKey 'Witness)
  , NFData BootstrapWitness
  ) =>
  NFData (ShelleyTxWitsRaw era)

instance EraScript era => NoThunks (ShelleyTxWitsRaw era)

newtype ShelleyTxWits era = MkShelleyTxWits (MemoBytes (ShelleyTxWitsRaw era))
  deriving ((forall x. ShelleyTxWits era -> Rep (ShelleyTxWits era) x)
-> (forall x. Rep (ShelleyTxWits era) x -> ShelleyTxWits era)
-> Generic (ShelleyTxWits era)
forall x. Rep (ShelleyTxWits era) x -> ShelleyTxWits era
forall x. ShelleyTxWits era -> Rep (ShelleyTxWits era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyTxWits era) x -> ShelleyTxWits era
forall era x. ShelleyTxWits era -> Rep (ShelleyTxWits era) x
$cfrom :: forall era x. ShelleyTxWits era -> Rep (ShelleyTxWits era) x
from :: forall x. ShelleyTxWits era -> Rep (ShelleyTxWits era) x
$cto :: forall era x. Rep (ShelleyTxWits era) x -> ShelleyTxWits era
to :: forall x. Rep (ShelleyTxWits era) x -> ShelleyTxWits era
Generic)
  deriving newtype (ShelleyTxWits era -> Int
ShelleyTxWits era -> ByteString
(ShelleyTxWits era -> ByteString)
-> (ShelleyTxWits era -> Int)
-> (forall i. Proxy i -> ShelleyTxWits era -> SafeHash i)
-> SafeToHash (ShelleyTxWits era)
forall i. Proxy i -> ShelleyTxWits era -> SafeHash i
forall era. ShelleyTxWits era -> Int
forall era. ShelleyTxWits era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall i. Proxy i -> t -> SafeHash i)
-> SafeToHash t
forall era i. Proxy i -> ShelleyTxWits era -> SafeHash i
$coriginalBytes :: forall era. ShelleyTxWits era -> ByteString
originalBytes :: ShelleyTxWits era -> ByteString
$coriginalBytesSize :: forall era. ShelleyTxWits era -> Int
originalBytesSize :: ShelleyTxWits era -> Int
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> ShelleyTxWits era -> SafeHash i
makeHashWithExplicitProxys :: forall i. Proxy i -> ShelleyTxWits era -> SafeHash i
SafeToHash, Typeable (ShelleyTxWits era)
Typeable (ShelleyTxWits era) =>
(ShelleyTxWits era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (ShelleyTxWits era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [ShelleyTxWits era] -> Size)
-> ToCBOR (ShelleyTxWits era)
ShelleyTxWits era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyTxWits era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTxWits era) -> Size
forall era. Typeable era => Typeable (ShelleyTxWits era)
forall era. Typeable era => ShelleyTxWits era -> Encoding
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyTxWits era] -> Size
forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTxWits era) -> Size
$ctoCBOR :: forall era. Typeable era => ShelleyTxWits era -> Encoding
toCBOR :: ShelleyTxWits era -> Encoding
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTxWits era) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTxWits era) -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyTxWits era] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [ShelleyTxWits era] -> Size
Plain.ToCBOR)

instance Memoized (ShelleyTxWits era) where
  type RawType (ShelleyTxWits era) = ShelleyTxWitsRaw era

deriving newtype instance EraScript era => Eq (ShelleyTxWits era)

deriving newtype instance EraScript era => Show (ShelleyTxWits era)

instance
  ( Era era
  , NFData (Script era)
  , NFData (WitVKey 'Witness)
  , NFData BootstrapWitness
  ) =>
  NFData (ShelleyTxWits era)

instance EraScript era => NoThunks (ShelleyTxWits era)

instance EraScript era => DecCBOR (ShelleyTxWits era) where
  decCBOR :: forall s. Decoder s (ShelleyTxWits era)
decCBOR = MemoBytes (ShelleyTxWitsRaw era) -> ShelleyTxWits era
forall era. MemoBytes (ShelleyTxWitsRaw era) -> ShelleyTxWits era
MkShelleyTxWits (MemoBytes (ShelleyTxWitsRaw era) -> ShelleyTxWits era)
-> Decoder s (MemoBytes (ShelleyTxWitsRaw era))
-> Decoder s (ShelleyTxWits era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ShelleyTxWitsRaw era)
-> Decoder s (MemoBytes (ShelleyTxWitsRaw era))
forall s t. Decoder s t -> Decoder s (MemoBytes t)
decodeMemoized Decoder s (ShelleyTxWitsRaw era)
forall s. Decoder s (ShelleyTxWitsRaw era)
forall a s. DecCBOR a => Decoder s a
decCBOR

-- =======================================================
-- Accessors
-- =======================================================

-- | Addresses witness setter and getter for `ShelleyTxWits`. The
-- setter does update memoized binary representation.
addrShelleyTxWitsL ::
  EraScript era => Lens' (ShelleyTxWits era) (Set (WitVKey 'Witness))
addrShelleyTxWitsL :: forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Set (WitVKey 'Witness))
addrShelleyTxWitsL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ShelleyEra RawType (ShelleyTxWits era) -> Set (WitVKey 'Witness)
ShelleyTxWitsRaw era -> Set (WitVKey 'Witness)
forall era. ShelleyTxWitsRaw era -> Set (WitVKey 'Witness)
stwrAddrTxWits ((RawType (ShelleyTxWits era)
  -> Set (WitVKey 'Witness) -> RawType (ShelleyTxWits era))
 -> forall {f :: * -> *}.
    Functor f =>
    (Set (WitVKey 'Witness) -> f (Set (WitVKey 'Witness)))
    -> ShelleyTxWits era -> f (ShelleyTxWits era))
-> (RawType (ShelleyTxWits era)
    -> Set (WitVKey 'Witness) -> RawType (ShelleyTxWits era))
-> forall {f :: * -> *}.
   Functor f =>
   (Set (WitVKey 'Witness) -> f (Set (WitVKey 'Witness)))
   -> ShelleyTxWits era -> f (ShelleyTxWits era)
forall a b. (a -> b) -> a -> b
$ \RawType (ShelleyTxWits era)
witsRaw Set (WitVKey 'Witness)
aw -> RawType (ShelleyTxWits era)
witsRaw {stwrAddrTxWits = aw}
{-# INLINEABLE addrShelleyTxWitsL #-}

-- | Bootstrap Addresses witness setter and getter for `ShelleyTxWits`. The
-- setter does update memoized binary representation.
bootAddrShelleyTxWitsL ::
  EraScript era =>
  Lens' (ShelleyTxWits era) (Set BootstrapWitness)
bootAddrShelleyTxWitsL :: forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Set BootstrapWitness)
bootAddrShelleyTxWitsL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ShelleyEra RawType (ShelleyTxWits era) -> Set BootstrapWitness
ShelleyTxWitsRaw era -> Set BootstrapWitness
forall era. ShelleyTxWitsRaw era -> Set BootstrapWitness
stwrBootAddrTxWits ((RawType (ShelleyTxWits era)
  -> Set BootstrapWitness -> RawType (ShelleyTxWits era))
 -> forall {f :: * -> *}.
    Functor f =>
    (Set BootstrapWitness -> f (Set BootstrapWitness))
    -> ShelleyTxWits era -> f (ShelleyTxWits era))
-> (RawType (ShelleyTxWits era)
    -> Set BootstrapWitness -> RawType (ShelleyTxWits era))
-> forall {f :: * -> *}.
   Functor f =>
   (Set BootstrapWitness -> f (Set BootstrapWitness))
   -> ShelleyTxWits era -> f (ShelleyTxWits era)
forall a b. (a -> b) -> a -> b
$ \RawType (ShelleyTxWits era)
witsRaw Set BootstrapWitness
bw -> RawType (ShelleyTxWits era)
witsRaw {stwrBootAddrTxWits = bw}
{-# INLINEABLE bootAddrShelleyTxWitsL #-}

-- | Script witness setter and getter for `ShelleyTxWits`. The
-- setter does update memoized binary representation.
scriptShelleyTxWitsL ::
  EraScript era =>
  Lens' (ShelleyTxWits era) (Map ScriptHash (Script era))
scriptShelleyTxWitsL :: forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Map ScriptHash (Script era))
scriptShelleyTxWitsL =
  forall era t a b.
(Era era, EncCBOR (RawType t), Memoized t) =>
(RawType t -> a) -> (RawType t -> b -> RawType t) -> Lens t t a b
lensMemoRawType @ShelleyEra RawType (ShelleyTxWits era) -> Map ScriptHash (Script era)
ShelleyTxWitsRaw era -> Map ScriptHash (Script era)
forall era. ShelleyTxWitsRaw era -> Map ScriptHash (Script era)
stwrScriptTxWits ((RawType (ShelleyTxWits era)
  -> Map ScriptHash (Script era) -> RawType (ShelleyTxWits era))
 -> forall {f :: * -> *}.
    Functor f =>
    (Map ScriptHash (Script era) -> f (Map ScriptHash (Script era)))
    -> ShelleyTxWits era -> f (ShelleyTxWits era))
-> (RawType (ShelleyTxWits era)
    -> Map ScriptHash (Script era) -> RawType (ShelleyTxWits era))
-> forall {f :: * -> *}.
   Functor f =>
   (Map ScriptHash (Script era) -> f (Map ScriptHash (Script era)))
   -> ShelleyTxWits era -> f (ShelleyTxWits era)
forall a b. (a -> b) -> a -> b
$
    \RawType (ShelleyTxWits era)
witsRaw Map ScriptHash (Script era)
sw -> RawType (ShelleyTxWits era)
witsRaw {stwrScriptTxWits = sw}
{-# INLINEABLE scriptShelleyTxWitsL #-}

instance EraTxWits ShelleyEra where
  type TxWits ShelleyEra = ShelleyTxWits ShelleyEra

  mkBasicTxWits :: TxWits ShelleyEra
mkBasicTxWits = TxWits ShelleyEra
ShelleyTxWits ShelleyEra
forall a. Monoid a => a
mempty

  addrTxWitsL :: Lens' (TxWits ShelleyEra) (Set (WitVKey 'Witness))
addrTxWitsL = (Set (WitVKey 'Witness) -> f (Set (WitVKey 'Witness)))
-> TxWits ShelleyEra -> f (TxWits ShelleyEra)
(Set (WitVKey 'Witness) -> f (Set (WitVKey 'Witness)))
-> ShelleyTxWits ShelleyEra -> f (ShelleyTxWits ShelleyEra)
forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Set (WitVKey 'Witness))
Lens' (ShelleyTxWits ShelleyEra) (Set (WitVKey 'Witness))
addrShelleyTxWitsL
  {-# INLINE addrTxWitsL #-}

  bootAddrTxWitsL :: Lens' (TxWits ShelleyEra) (Set BootstrapWitness)
bootAddrTxWitsL = (Set BootstrapWitness -> f (Set BootstrapWitness))
-> TxWits ShelleyEra -> f (TxWits ShelleyEra)
(Set BootstrapWitness -> f (Set BootstrapWitness))
-> ShelleyTxWits ShelleyEra -> f (ShelleyTxWits ShelleyEra)
forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Set BootstrapWitness)
Lens' (ShelleyTxWits ShelleyEra) (Set BootstrapWitness)
bootAddrShelleyTxWitsL
  {-# INLINE bootAddrTxWitsL #-}

  scriptTxWitsL :: Lens' (TxWits ShelleyEra) (Map ScriptHash (Script ShelleyEra))
scriptTxWitsL = (Map ScriptHash (Script ShelleyEra)
 -> f (Map ScriptHash (Script ShelleyEra)))
-> TxWits ShelleyEra -> f (TxWits ShelleyEra)
(Map ScriptHash (Script ShelleyEra)
 -> f (Map ScriptHash (Script ShelleyEra)))
-> ShelleyTxWits ShelleyEra -> f (ShelleyTxWits ShelleyEra)
forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Map ScriptHash (Script era))
Lens'
  (ShelleyTxWits ShelleyEra) (Map ScriptHash (Script ShelleyEra))
scriptShelleyTxWitsL
  {-# INLINE scriptTxWitsL #-}

  upgradeTxWits :: EraTxWits (PreviousEra ShelleyEra) =>
TxWits (PreviousEra ShelleyEra) -> TxWits ShelleyEra
upgradeTxWits =
    String -> TxWits ByronEra -> ShelleyTxWits ShelleyEra
forall a. HasCallStack => String -> a
error
      String
"Calling this function will cause a compilation error, since there is no TxWits instance for ByronEra"

instance (TxWits era ~ ShelleyTxWits era, EraTxWits era) => EqRaw (ShelleyTxWits era) where
  eqRaw :: ShelleyTxWits era -> ShelleyTxWits era -> Bool
eqRaw = forall era. EraTxWits era => TxWits era -> TxWits era -> Bool
shelleyEqTxWitsRaw @era

instance (Era era, EncCBOR (Script era)) => EncCBOR (ShelleyTxWitsRaw era) where
  encCBOR :: ShelleyTxWitsRaw era -> Encoding
encCBOR (ShelleyTxWitsRaw Set (WitVKey 'Witness)
vkeys Map ScriptHash (Script era)
scripts Set BootstrapWitness
boots) =
    Encode ('Closed 'Sparse) (ShelleyTxWitsRaw era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Sparse) (ShelleyTxWitsRaw era) -> Encoding)
-> Encode ('Closed 'Sparse) (ShelleyTxWitsRaw era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (Set (WitVKey 'Witness)
 -> Map ScriptHash (Script era)
 -> Set BootstrapWitness
 -> ShelleyTxWitsRaw era)
-> Encode
     ('Closed 'Sparse)
     (Set (WitVKey 'Witness)
      -> Map ScriptHash (Script era)
      -> Set BootstrapWitness
      -> ShelleyTxWitsRaw era)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWitsRaw era
forall era.
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWitsRaw era
ShelleyTxWitsRaw
        Encode
  ('Closed 'Sparse)
  (Set (WitVKey 'Witness)
   -> Map ScriptHash (Script era)
   -> Set BootstrapWitness
   -> ShelleyTxWitsRaw era)
-> Encode ('Closed 'Sparse) (Set (WitVKey 'Witness))
-> Encode
     ('Closed 'Sparse)
     (Map ScriptHash (Script era)
      -> Set BootstrapWitness -> ShelleyTxWitsRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Set (WitVKey 'Witness) -> Bool)
-> Encode ('Closed 'Sparse) (Set (WitVKey 'Witness))
-> Encode ('Closed 'Sparse) (Set (WitVKey 'Witness))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Set (WitVKey 'Witness) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Set (WitVKey 'Witness))
-> Encode ('Closed 'Sparse) (Set (WitVKey 'Witness))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 (Encode ('Closed 'Dense) (Set (WitVKey 'Witness))
 -> Encode ('Closed 'Sparse) (Set (WitVKey 'Witness)))
-> Encode ('Closed 'Dense) (Set (WitVKey 'Witness))
-> Encode ('Closed 'Sparse) (Set (WitVKey 'Witness))
forall a b. (a -> b) -> a -> b
$ Set (WitVKey 'Witness)
-> Encode ('Closed 'Dense) (Set (WitVKey 'Witness))
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (WitVKey 'Witness)
vkeys)
        Encode
  ('Closed 'Sparse)
  (Map ScriptHash (Script era)
   -> Set BootstrapWitness -> ShelleyTxWitsRaw era)
-> Encode ('Closed 'Sparse) (Map ScriptHash (Script era))
-> Encode
     ('Closed 'Sparse) (Set BootstrapWitness -> ShelleyTxWitsRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Map ScriptHash (Script era) -> Bool)
-> Encode ('Closed 'Sparse) (Map ScriptHash (Script era))
-> Encode ('Closed 'Sparse) (Map ScriptHash (Script era))
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Map ScriptHash (Script era) -> Bool
forall a. Map ScriptHash a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Map ScriptHash (Script era))
-> Encode ('Closed 'Sparse) (Map ScriptHash (Script era))
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 (Encode ('Closed 'Dense) (Map ScriptHash (Script era))
 -> Encode ('Closed 'Sparse) (Map ScriptHash (Script era)))
-> Encode ('Closed 'Dense) (Map ScriptHash (Script era))
-> Encode ('Closed 'Sparse) (Map ScriptHash (Script era))
forall a b. (a -> b) -> a -> b
$ (Map ScriptHash (Script era) -> Encoding)
-> Map ScriptHash (Script era)
-> Encode ('Closed 'Dense) (Map ScriptHash (Script era))
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ([Script era] -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR ([Script era] -> Encoding)
-> (Map ScriptHash (Script era) -> [Script era])
-> Map ScriptHash (Script era)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ScriptHash (Script era) -> [Script era]
forall k a. Map k a -> [a]
Map.elems) Map ScriptHash (Script era)
scripts)
        Encode
  ('Closed 'Sparse) (Set BootstrapWitness -> ShelleyTxWitsRaw era)
-> Encode ('Closed 'Sparse) (Set BootstrapWitness)
-> Encode ('Closed 'Sparse) (ShelleyTxWitsRaw era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (Set BootstrapWitness -> Bool)
-> Encode ('Closed 'Sparse) (Set BootstrapWitness)
-> Encode ('Closed 'Sparse) (Set BootstrapWitness)
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit Set BootstrapWitness -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Word
-> Encode ('Closed 'Dense) (Set BootstrapWitness)
-> Encode ('Closed 'Sparse) (Set BootstrapWitness)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 (Encode ('Closed 'Dense) (Set BootstrapWitness)
 -> Encode ('Closed 'Sparse) (Set BootstrapWitness))
-> Encode ('Closed 'Dense) (Set BootstrapWitness)
-> Encode ('Closed 'Sparse) (Set BootstrapWitness)
forall a b. (a -> b) -> a -> b
$ Set BootstrapWitness
-> Encode ('Closed 'Dense) (Set BootstrapWitness)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set BootstrapWitness
boots)

-- | Encodes memoized bytes created upon construction.
instance Era era => EncCBOR (ShelleyTxWits era)

instance EraScript era => Semigroup (ShelleyTxWits era) where
  (ShelleyTxWits Set (WitVKey 'Witness)
a Map ScriptHash (Script era)
b Set BootstrapWitness
c) <> :: ShelleyTxWits era -> ShelleyTxWits era -> ShelleyTxWits era
<> ShelleyTxWits era
y | Set (WitVKey 'Witness) -> Bool
forall a. Set a -> Bool
Set.null Set (WitVKey 'Witness)
a Bool -> Bool -> Bool
&& Map ScriptHash (Script era) -> Bool
forall k a. Map k a -> Bool
Map.null Map ScriptHash (Script era)
b Bool -> Bool -> Bool
&& Set BootstrapWitness -> Bool
forall a. Set a -> Bool
Set.null Set BootstrapWitness
c = ShelleyTxWits era
y
  ShelleyTxWits era
y <> (ShelleyTxWits Set (WitVKey 'Witness)
a Map ScriptHash (Script era)
b Set BootstrapWitness
c) | Set (WitVKey 'Witness) -> Bool
forall a. Set a -> Bool
Set.null Set (WitVKey 'Witness)
a Bool -> Bool -> Bool
&& Map ScriptHash (Script era) -> Bool
forall k a. Map k a -> Bool
Map.null Map ScriptHash (Script era)
b Bool -> Bool -> Bool
&& Set BootstrapWitness -> Bool
forall a. Set a -> Bool
Set.null Set BootstrapWitness
c = ShelleyTxWits era
y
  (ShelleyTxWits Set (WitVKey 'Witness)
a Map ScriptHash (Script era)
b Set BootstrapWitness
c) <> (ShelleyTxWits Set (WitVKey 'Witness)
a' Map ScriptHash (Script era)
b' Set BootstrapWitness
c') = Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits (Set (WitVKey 'Witness)
a Set (WitVKey 'Witness)
-> Set (WitVKey 'Witness) -> Set (WitVKey 'Witness)
forall a. Semigroup a => a -> a -> a
<> Set (WitVKey 'Witness)
a') (Map ScriptHash (Script era)
b Map ScriptHash (Script era)
-> Map ScriptHash (Script era) -> Map ScriptHash (Script era)
forall a. Semigroup a => a -> a -> a
<> Map ScriptHash (Script era)
b') (Set BootstrapWitness
c Set BootstrapWitness
-> Set BootstrapWitness -> Set BootstrapWitness
forall a. Semigroup a => a -> a -> a
<> Set BootstrapWitness
c')

instance EraScript era => Monoid (ShelleyTxWits era) where
  mempty :: ShelleyTxWits era
mempty = Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits Set (WitVKey 'Witness)
forall a. Monoid a => a
mempty Map ScriptHash (Script era)
forall a. Monoid a => a
mempty Set BootstrapWitness
forall a. Monoid a => a
mempty

pattern ShelleyTxWits ::
  forall era.
  EraScript era =>
  Set (WitVKey 'Witness) ->
  Map ScriptHash (Script era) ->
  Set BootstrapWitness ->
  ShelleyTxWits era
pattern $mShelleyTxWits :: forall {r} {era}.
EraScript era =>
ShelleyTxWits era
-> (Set (WitVKey 'Witness)
    -> Map ScriptHash (Script era) -> Set BootstrapWitness -> r)
-> ((# #) -> r)
-> r
$bShelleyTxWits :: forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits {forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness)
addrWits, forall era.
EraScript era =>
ShelleyTxWits era -> Map ScriptHash (Script era)
scriptWits, forall era.
EraScript era =>
ShelleyTxWits era -> Set BootstrapWitness
bootWits} <-
  (getMemoRawType -> ShelleyTxWitsRaw addrWits scriptWits bootWits)
  where
    ShelleyTxWits Set (WitVKey 'Witness)
awits Map ScriptHash (Script era)
scriptWitMap Set BootstrapWitness
bootstrapWits =
      forall era t.
(Era era, EncCBOR (RawType t), Memoized t) =>
RawType t -> t
mkMemoizedEra @era (RawType (ShelleyTxWits era) -> ShelleyTxWits era)
-> RawType (ShelleyTxWits era) -> ShelleyTxWits era
forall a b. (a -> b) -> a -> b
$ Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWitsRaw era
forall era.
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWitsRaw era
ShelleyTxWitsRaw Set (WitVKey 'Witness)
awits Map ScriptHash (Script era)
scriptWitMap Set BootstrapWitness
bootstrapWits

{-# COMPLETE ShelleyTxWits #-}

shelleyEqTxWitsRaw :: EraTxWits era => TxWits era -> TxWits era -> Bool
shelleyEqTxWitsRaw :: forall era. EraTxWits era => TxWits era -> TxWits era -> Bool
shelleyEqTxWitsRaw TxWits era
txWits1 TxWits era
txWits2 =
  TxWits era
txWits1 TxWits era
-> Getting
     (Set (WitVKey 'Witness)) (TxWits era) (Set (WitVKey 'Witness))
-> Set (WitVKey 'Witness)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (WitVKey 'Witness)) (TxWits era) (Set (WitVKey 'Witness))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL Set (WitVKey 'Witness) -> Set (WitVKey 'Witness) -> Bool
forall a. Eq a => a -> a -> Bool
== TxWits era
txWits2 TxWits era
-> Getting
     (Set (WitVKey 'Witness)) (TxWits era) (Set (WitVKey 'Witness))
-> Set (WitVKey 'Witness)
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (WitVKey 'Witness)) (TxWits era) (Set (WitVKey 'Witness))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL
    Bool -> Bool -> Bool
&& (Script era -> Script era -> Bool)
-> Map ScriptHash (Script era)
-> Map ScriptHash (Script era)
-> Bool
forall a b.
(a -> b -> Bool) -> Map ScriptHash a -> Map ScriptHash b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq Script era -> Script era -> Bool
forall a. EqRaw a => a -> a -> Bool
eqRaw (TxWits era
txWits1 TxWits era
-> Getting
     (Map ScriptHash (Script era))
     (TxWits era)
     (Map ScriptHash (Script era))
-> Map ScriptHash (Script era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map ScriptHash (Script era))
  (TxWits era)
  (Map ScriptHash (Script era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL) (TxWits era
txWits2 TxWits era
-> Getting
     (Map ScriptHash (Script era))
     (TxWits era)
     (Map ScriptHash (Script era))
-> Map ScriptHash (Script era)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map ScriptHash (Script era))
  (TxWits era)
  (Map ScriptHash (Script era))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL)
    Bool -> Bool -> Bool
&& TxWits era
txWits1 TxWits era
-> Getting
     (Set BootstrapWitness) (TxWits era) (Set BootstrapWitness)
-> Set BootstrapWitness
forall s a. s -> Getting a s a -> a
^. Getting (Set BootstrapWitness) (TxWits era) (Set BootstrapWitness)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits era) (Set BootstrapWitness)
bootAddrTxWitsL Set BootstrapWitness -> Set BootstrapWitness -> Bool
forall a. Eq a => a -> a -> Bool
== TxWits era
txWits2 TxWits era
-> Getting
     (Set BootstrapWitness) (TxWits era) (Set BootstrapWitness)
-> Set BootstrapWitness
forall s a. s -> Getting a s a -> a
^. Getting (Set BootstrapWitness) (TxWits era) (Set BootstrapWitness)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits era) (Set BootstrapWitness)
bootAddrTxWitsL

instance EraScript era => DecCBOR (ShelleyTxWitsRaw era) where
  decCBOR :: forall s. Decoder s (ShelleyTxWitsRaw era)
decCBOR =
    Decode ('Closed 'Dense) (ShelleyTxWitsRaw era)
-> Decoder s (ShelleyTxWitsRaw era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (ShelleyTxWitsRaw era)
 -> Decoder s (ShelleyTxWitsRaw era))
-> Decode ('Closed 'Dense) (ShelleyTxWitsRaw era)
-> Decoder s (ShelleyTxWitsRaw era)
forall a b. (a -> b) -> a -> b
$
      String
-> ShelleyTxWitsRaw era
-> (Word -> Field (ShelleyTxWitsRaw era))
-> [(Word, String)]
-> Decode ('Closed 'Dense) (ShelleyTxWitsRaw era)
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
        String
"ShelleyTxWits"
        (Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWitsRaw era
forall era.
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWitsRaw era
ShelleyTxWitsRaw Set (WitVKey 'Witness)
forall a. Monoid a => a
mempty Map ScriptHash (Script era)
forall a. Monoid a => a
mempty Set BootstrapWitness
forall a. Monoid a => a
mempty)
        Word -> Field (ShelleyTxWitsRaw era)
witField
        []
    where
      witField :: Word -> Field (ShelleyTxWitsRaw era)
      witField :: Word -> Field (ShelleyTxWitsRaw era)
witField Word
0 = (Set (WitVKey 'Witness)
 -> ShelleyTxWitsRaw era -> ShelleyTxWitsRaw era)
-> Decode ('Closed Any) (Set (WitVKey 'Witness))
-> Field (ShelleyTxWitsRaw era)
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set (WitVKey 'Witness)
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {stwrAddrTxWits = x}) Decode ('Closed Any) (Set (WitVKey 'Witness))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      witField Word
1 =
        (Map ScriptHash (Script era)
 -> ShelleyTxWitsRaw era -> ShelleyTxWitsRaw era)
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
-> Field (ShelleyTxWitsRaw era)
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field
          (\Map ScriptHash (Script era)
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {stwrScriptTxWits = x})
          ((forall s. Decoder s (Map ScriptHash (Script era)))
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D ((forall s. Decoder s (Map ScriptHash (Script era)))
 -> Decode ('Closed 'Dense) (Map ScriptHash (Script era)))
-> (forall s. Decoder s (Map ScriptHash (Script era)))
-> Decode ('Closed 'Dense) (Map ScriptHash (Script era))
forall a b. (a -> b) -> a -> b
$ (Script era -> ScriptHash)
-> [Script era] -> Map ScriptHash (Script era)
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k v
Map.fromElems (forall era. EraScript era => Script era -> ScriptHash
hashScript @era) ([Script era] -> Map ScriptHash (Script era))
-> Decoder s [Script era]
-> Decoder s (Map ScriptHash (Script era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Script era) -> Decoder s [Script era]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Script era)
forall s. Decoder s (Script era)
forall a s. DecCBOR a => Decoder s a
decCBOR)
      witField Word
2 = (Set BootstrapWitness
 -> ShelleyTxWitsRaw era -> ShelleyTxWitsRaw era)
-> Decode ('Closed Any) (Set BootstrapWitness)
-> Field (ShelleyTxWitsRaw era)
forall x t (d :: Density).
Typeable x =>
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Set BootstrapWitness
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {stwrBootAddrTxWits = x}) Decode ('Closed Any) (Set BootstrapWitness)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
      witField Word
n = Word -> Field (ShelleyTxWitsRaw era)
forall t. Word -> Field t
invalidField Word
n