{-# 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,
  shelleyEqTxWitsRaw,
  mapTraverseableDecoderA,
) where

import Cardano.Ledger.Binary (
  Annotator (..),
  DecCBOR (decCBOR),
  Decoder,
  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 (..),
  Mem,
  MemoBytes,
  Memoized (..),
  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 Data.Void (Void)
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)

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 via
  Mem (ShelleyTxWitsRaw era)
  instance
    ( EraScript era
    , DecCBOR (Annotator (Script era))
    ) =>
    DecCBOR (Annotator (ShelleyTxWits 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)

-- =======================================================
-- 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))
 -> Lens
      (ShelleyTxWits era)
      (ShelleyTxWits era)
      (Set (WitVKey Witness))
      (Set (WitVKey Witness)))
-> (RawType (ShelleyTxWits era)
    -> Set (WitVKey Witness) -> RawType (ShelleyTxWits era))
-> Lens
     (ShelleyTxWits era)
     (ShelleyTxWits era)
     (Set (WitVKey Witness))
     (Set (WitVKey Witness))
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))
 -> Lens
      (ShelleyTxWits era)
      (ShelleyTxWits era)
      (Set BootstrapWitness)
      (Set BootstrapWitness))
-> (RawType (ShelleyTxWits era)
    -> Set BootstrapWitness -> RawType (ShelleyTxWits era))
-> Lens
     (ShelleyTxWits era)
     (ShelleyTxWits era)
     (Set BootstrapWitness)
     (Set BootstrapWitness)
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))
 -> Lens
      (ShelleyTxWits era)
      (ShelleyTxWits era)
      (Map ScriptHash (Script era))
      (Map ScriptHash (Script era)))
-> (RawType (ShelleyTxWits era)
    -> Map ScriptHash (Script era) -> RawType (ShelleyTxWits era))
-> Lens
     (ShelleyTxWits era)
     (ShelleyTxWits era)
     (Map ScriptHash (Script era))
     (Map ScriptHash (Script 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 #-}

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 (Annotator (Script era))
  ) =>
  DecCBOR (Annotator (ShelleyTxWitsRaw era))
  where
  decCBOR :: forall s. Decoder s (Annotator (ShelleyTxWitsRaw era))
decCBOR =
    Decode (Closed Dense) (Annotator (ShelleyTxWitsRaw era))
-> Decoder s (Annotator (ShelleyTxWitsRaw era))
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (Annotator (ShelleyTxWitsRaw era))
 -> Decoder s (Annotator (ShelleyTxWitsRaw era)))
-> Decode (Closed Dense) (Annotator (ShelleyTxWitsRaw era))
-> Decoder s (Annotator (ShelleyTxWitsRaw era))
forall a b. (a -> b) -> a -> b
$
      String
-> Annotator (ShelleyTxWitsRaw era)
-> (Word -> Field (Annotator (ShelleyTxWitsRaw era)))
-> [(Word, String)]
-> Decode (Closed Dense) (Annotator (ShelleyTxWitsRaw era))
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode (Closed Dense) t
SparseKeyed
        String
"ShelleyTxWitsRaw"
        (ShelleyTxWitsRaw era -> Annotator (ShelleyTxWitsRaw era)
forall a. a -> Annotator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShelleyTxWitsRaw era
forall {era}. ShelleyTxWitsRaw era
emptyWitnessSet)
        Word -> Field (Annotator (ShelleyTxWitsRaw era))
witField
        []
    where
      emptyWitnessSet :: ShelleyTxWitsRaw era
emptyWitnessSet = 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
      witField :: Word -> Field (Annotator (ShelleyTxWitsRaw era))
      witField :: Word -> Field (Annotator (ShelleyTxWitsRaw era))
witField Word
0 =
        (Set (WitVKey Witness)
 -> ShelleyTxWitsRaw era -> ShelleyTxWitsRaw era)
-> Decode (Closed Dense) (Annotator (Set (WitVKey Witness)))
-> Field (Annotator (ShelleyTxWitsRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode (Closed d) (ann x) -> Field (ann t)
fieldAA
          (\Set (WitVKey Witness)
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {stwrAddrTxWits = x})
          ((forall s. Decoder s (Annotator (Set (WitVKey Witness))))
-> Decode (Closed Dense) (Annotator (Set (WitVKey Witness)))
forall t. (forall s. Decoder s t) -> Decode (Closed Dense) t
D ((forall s. Decoder s (Annotator (Set (WitVKey Witness))))
 -> Decode (Closed Dense) (Annotator (Set (WitVKey Witness))))
-> (forall s. Decoder s (Annotator (Set (WitVKey Witness))))
-> Decode (Closed Dense) (Annotator (Set (WitVKey Witness)))
forall a b. (a -> b) -> a -> b
$ Decoder s [Annotator (WitVKey Witness)]
-> ([WitVKey Witness] -> Set (WitVKey Witness))
-> Decoder s (Annotator (Set (WitVKey Witness)))
forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (Decoder s (Annotator (WitVKey Witness))
-> Decoder s [Annotator (WitVKey Witness)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (WitVKey Witness))
forall s. Decoder s (Annotator (WitVKey Witness))
forall a s. DecCBOR a => Decoder s a
decCBOR) [WitVKey Witness] -> Set (WitVKey Witness)
forall a. Ord a => [a] -> Set a
Set.fromList)
      witField Word
1 =
        (Map ScriptHash (Script era)
 -> ShelleyTxWitsRaw era -> ShelleyTxWitsRaw era)
-> Decode (Closed Dense) (Annotator (Map ScriptHash (Script era)))
-> Field (Annotator (ShelleyTxWitsRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode (Closed d) (ann x) -> Field (ann t)
fieldAA
          (\Map ScriptHash (Script era)
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {stwrScriptTxWits = x})
          ( (forall s. Decoder s (Annotator (Map ScriptHash (Script era))))
-> Decode (Closed Dense) (Annotator (Map ScriptHash (Script era)))
forall t. (forall s. Decoder s t) -> Decode (Closed Dense) t
D ((forall s. Decoder s (Annotator (Map ScriptHash (Script era))))
 -> Decode (Closed Dense) (Annotator (Map ScriptHash (Script era))))
-> (forall s. Decoder s (Annotator (Map ScriptHash (Script era))))
-> Decode (Closed Dense) (Annotator (Map ScriptHash (Script era)))
forall a b. (a -> b) -> a -> b
$
              Decoder s [Annotator (Script era)]
-> ([Script era] -> Map ScriptHash (Script era))
-> Decoder s (Annotator (Map ScriptHash (Script era)))
forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
                (Decoder s (Annotator (Script era))
-> Decoder s [Annotator (Script era)]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator (Script era))
forall s. Decoder s (Annotator (Script era))
forall a s. DecCBOR a => Decoder s a
decCBOR)
                ((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))
          )
      witField Word
2 =
        (Set BootstrapWitness
 -> ShelleyTxWitsRaw era -> ShelleyTxWitsRaw era)
-> Decode (Closed Dense) (Annotator (Set BootstrapWitness))
-> Field (Annotator (ShelleyTxWitsRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode (Closed d) (ann x) -> Field (ann t)
fieldAA
          (\Set BootstrapWitness
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {stwrBootAddrTxWits = x})
          ((forall s. Decoder s (Annotator (Set BootstrapWitness)))
-> Decode (Closed Dense) (Annotator (Set BootstrapWitness))
forall t. (forall s. Decoder s t) -> Decode (Closed Dense) t
D ((forall s. Decoder s (Annotator (Set BootstrapWitness)))
 -> Decode (Closed Dense) (Annotator (Set BootstrapWitness)))
-> (forall s. Decoder s (Annotator (Set BootstrapWitness)))
-> Decode (Closed Dense) (Annotator (Set BootstrapWitness))
forall a b. (a -> b) -> a -> b
$ Decoder s [Annotator BootstrapWitness]
-> ([BootstrapWitness] -> Set BootstrapWitness)
-> Decoder s (Annotator (Set BootstrapWitness))
forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (Decoder s (Annotator BootstrapWitness)
-> Decoder s [Annotator BootstrapWitness]
forall s a. Decoder s a -> Decoder s [a]
decodeList Decoder s (Annotator BootstrapWitness)
forall s. Decoder s (Annotator BootstrapWitness)
forall a s. DecCBOR a => Decoder s a
decCBOR) [BootstrapWitness] -> Set BootstrapWitness
forall a. Ord a => [a] -> Set a
Set.fromList)
      witField Word
n = (Void -> ShelleyTxWitsRaw era -> ShelleyTxWitsRaw era)
-> Decode (Closed (ZonkAny 0)) (Annotator Void)
-> Field (Annotator (ShelleyTxWitsRaw era))
forall x (ann :: * -> *) t (d :: Density).
(Typeable x, Typeable ann, Applicative ann) =>
(x -> t -> t) -> Decode (Closed d) (ann x) -> Field (ann t)
fieldAA (\(Void
_ :: Void) ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits) (Word -> Decode (Closed (ZonkAny 0)) (Annotator Void)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n)

mapTraverseableDecoderA ::
  Traversable f =>
  Decoder s (f (Annotator a)) ->
  (f a -> m b) ->
  Decoder s (Annotator (m b))
mapTraverseableDecoderA :: forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA Decoder s (f (Annotator a))
decList f a -> m b
transformList = (f a -> m b) -> Annotator (f a) -> Annotator (m b)
forall a b. (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> m b
transformList (Annotator (f a) -> Annotator (m b))
-> (f (Annotator a) -> Annotator (f a))
-> f (Annotator a)
-> Annotator (m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Annotator a) -> Annotator (f a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => f (m a) -> m (f a)
sequence (f (Annotator a) -> Annotator (m b))
-> Decoder s (f (Annotator a)) -> Decoder s (Annotator (m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (f (Annotator a))
decList