{-# 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 (
  decodeWits,
  ShelleyTxWits (
    ShelleyTxWits,
    addrWits,
    bootWits,
    scriptWits
  ),
  ShelleyTxWitsRaw,
  scriptShelleyTxWitsL,
  addrShelleyTxWitsL,
  bootAddrShelleyTxWitsL,
  addrWits',
  shelleyEqTxWitsRaw,
  mapTraverseableDecoderA,

  -- * Re-exports
  WitVKey (..),
)
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 (..), witVKeyHash)
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  Mem,
  MemoBytes,
  Memoized (..),
  getMemoRawType,
  lensMemoRawType,
  mkMemoized,
 )
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.Typeable (Typeable)
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)
addrWits' :: !(Set (WitVKey 'Witness))
  , forall era. ShelleyTxWitsRaw era -> Map ScriptHash (Script era)
scriptWits' :: !(Map ScriptHash (Script era))
  , forall era. ShelleyTxWitsRaw era -> Set BootstrapWitness
bootWits' :: !(Set BootstrapWitness)
  }
  deriving (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
$cto :: forall era x. Rep (ShelleyTxWitsRaw era) x -> ShelleyTxWitsRaw era
$cfrom :: forall era x. ShelleyTxWitsRaw era -> Rep (ShelleyTxWitsRaw era) x
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 = ShelleyTxWitsConstr (MemoBytes ShelleyTxWitsRaw era)
  deriving (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
$cto :: forall era x. Rep (ShelleyTxWits era) x -> ShelleyTxWits era
$cfrom :: forall era x. ShelleyTxWits era -> Rep (ShelleyTxWits era) x
Generic)
  deriving newtype (ShelleyTxWits era -> Int
ShelleyTxWits era -> ByteString
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
makeHashWithExplicitProxys :: forall i. Proxy i -> ShelleyTxWits era -> SafeHash i
$cmakeHashWithExplicitProxys :: forall era i. Proxy i -> ShelleyTxWits era -> SafeHash i
originalBytesSize :: ShelleyTxWits era -> Int
$coriginalBytesSize :: forall era. ShelleyTxWits era -> Int
originalBytes :: ShelleyTxWits era -> ByteString
$coriginalBytes :: forall era. ShelleyTxWits era -> ByteString
SafeToHash, 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
encodedListSizeExpr :: (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
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTxWits era) -> Size
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (ShelleyTxWits era) -> Size
toCBOR :: ShelleyTxWits era -> Encoding
$ctoCBOR :: forall era. Typeable era => ShelleyTxWits era -> Encoding
Plain.ToCBOR)

instance Memoized ShelleyTxWits where
  type RawType ShelleyTxWits = ShelleyTxWitsRaw

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 era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxWitsRaw era -> Set (WitVKey 'Witness)
addrWits' forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxWits era
witsRaw Set (WitVKey 'Witness)
aw -> RawType ShelleyTxWits era
witsRaw {addrWits' :: Set (WitVKey 'Witness)
addrWits' = Set (WitVKey 'Witness)
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 era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxWitsRaw era -> Set BootstrapWitness
bootWits' forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxWits era
witsRaw Set BootstrapWitness
bw -> RawType ShelleyTxWits era
witsRaw {bootWits' :: Set BootstrapWitness
bootWits' = Set BootstrapWitness
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 era), Memoized t) =>
(RawType t era -> a)
-> (RawType t era -> b -> RawType t era)
-> Lens (t era) (t era) a b
lensMemoRawType forall era. ShelleyTxWitsRaw era -> Map ScriptHash (Script era)
scriptWits' forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxWits era
witsRaw Map ScriptHash (Script era)
sw -> RawType ShelleyTxWits era
witsRaw {scriptWits' :: Map ScriptHash (Script era)
scriptWits' = Map ScriptHash (Script era)
sw}
{-# INLINEABLE scriptShelleyTxWitsL #-}

instance EraTxWits ShelleyEra where
  type TxWits ShelleyEra = ShelleyTxWits ShelleyEra

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

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

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

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

  upgradeTxWits :: EraTxWits (PreviousEra ShelleyEra) =>
TxWits (PreviousEra ShelleyEra) -> TxWits ShelleyEra
upgradeTxWits =
    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

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) =
    forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$
      forall t. t -> Encode ('Closed 'Sparse) t
Keyed forall era.
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWitsRaw era
ShelleyTxWitsRaw
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
0 forall a b. (a -> b) -> a -> b
$ forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (WitVKey 'Witness)
vkeys)
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
1 forall a b. (a -> b) -> a -> b
$ forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (forall a. EncCBOR a => a -> Encoding
encCBOR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems) Map ScriptHash (Script era)
scripts)
        forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
2 forall a b. (a -> b) -> a -> b
$ 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 | forall a. Set a -> Bool
Set.null Set (WitVKey 'Witness)
a Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map ScriptHash (Script era)
b Bool -> Bool -> 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) | forall a. Set a -> Bool
Set.null Set (WitVKey 'Witness)
a Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map ScriptHash (Script era)
b Bool -> Bool -> 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') = forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
ShelleyTxWits (Set (WitVKey 'Witness)
a forall a. Semigroup a => a -> a -> a
<> Set (WitVKey 'Witness)
a') (Map ScriptHash (Script era)
b forall a. Semigroup a => a -> a -> a
<> Map ScriptHash (Script era)
b') (Set BootstrapWitness
c forall a. Semigroup a => a -> a -> a
<> Set BootstrapWitness
c')

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

pattern ShelleyTxWits ::
  forall era.
  EraScript era =>
  Set (WitVKey 'Witness) ->
  Map ScriptHash (Script era) ->
  Set BootstrapWitness ->
  ShelleyTxWits era
pattern $bShelleyTxWits :: forall era.
EraScript era =>
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWits era
$mShelleyTxWits :: forall {r} {era}.
EraScript era =>
ShelleyTxWits era
-> (Set (WitVKey 'Witness)
    -> Map ScriptHash (Script era) -> Set BootstrapWitness -> r)
-> ((# #) -> r)
-> r
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 era), Memoized t) =>
RawType t era -> t era
mkMemoized forall a b. (a -> b) -> a -> b
$ 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 =
  forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq forall a. EqRaw a => a -> a -> Bool
eqRaw (TxWits era
txWits1 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL) (TxWits era
txWits2 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL)
    Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq forall a. EqRaw a => a -> a -> Bool
eqRaw (TxWits era
txWits1 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL) (TxWits era
txWits2 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL)
    Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq forall a. EqRaw a => a -> a -> Bool
eqRaw (TxWits era
txWits1 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
bootAddrTxWitsL) (TxWits era
txWits2 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
bootAddrTxWitsL)

instance EraScript era => DecCBOR (Annotator (ShelleyTxWitsRaw era)) where
  decCBOR :: forall s. Decoder s (Annotator (ShelleyTxWitsRaw era))
decCBOR = forall era s.
EraScript era =>
Decoder s (Annotator (ShelleyTxWitsRaw era))
decodeWits

deriving via
  (Mem ShelleyTxWitsRaw era)
  instance
    EraScript era => DecCBOR (Annotator (ShelleyTxWits era))

-- | This type is only used to preserve the old buggy behavior where signature
-- was ignored in the `Ord` instance for `WitVKey`s.
newtype IgnoreSigOrd kr = IgnoreSigOrd {forall (kr :: KeyRole). IgnoreSigOrd kr -> WitVKey kr
unIgnoreSigOrd :: WitVKey kr}
  deriving (IgnoreSigOrd kr -> IgnoreSigOrd kr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kr :: KeyRole). IgnoreSigOrd kr -> IgnoreSigOrd kr -> Bool
/= :: IgnoreSigOrd kr -> IgnoreSigOrd kr -> Bool
$c/= :: forall (kr :: KeyRole). IgnoreSigOrd kr -> IgnoreSigOrd kr -> Bool
== :: IgnoreSigOrd kr -> IgnoreSigOrd kr -> Bool
$c== :: forall (kr :: KeyRole). IgnoreSigOrd kr -> IgnoreSigOrd kr -> Bool
Eq)

instance Typeable kr => Ord (IgnoreSigOrd kr) where
  compare :: IgnoreSigOrd kr -> IgnoreSigOrd kr -> Ordering
compare (IgnoreSigOrd WitVKey kr
w1) (IgnoreSigOrd WitVKey kr
w2) = forall a. Ord a => a -> a -> Ordering
compare (forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
witVKeyHash WitVKey kr
w1) (forall (kr :: KeyRole). WitVKey kr -> KeyHash 'Witness
witVKeyHash WitVKey kr
w2)

decodeWits ::
  forall era s.
  EraScript era =>
  Decoder s (Annotator (ShelleyTxWitsRaw era))
decodeWits :: forall era s.
EraScript era =>
Decoder s (Annotator (ShelleyTxWitsRaw era))
decodeWits =
  forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$
    forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed
      String
"ShelleyTxWitsRaw"
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {era}. ShelleyTxWitsRaw era
emptyWitnessSet)
      Word -> Field (Annotator (ShelleyTxWitsRaw era))
witField
      []
  where
    emptyWitnessSet :: ShelleyTxWitsRaw era
emptyWitnessSet = forall era.
Set (WitVKey 'Witness)
-> Map ScriptHash (Script era)
-> Set BootstrapWitness
-> ShelleyTxWitsRaw era
ShelleyTxWitsRaw forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
    witField :: Word -> Field (Annotator (ShelleyTxWitsRaw era))
    witField :: Word -> Field (Annotator (ShelleyTxWitsRaw era))
witField Word
0 =
      forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
        (\Set (WitVKey 'Witness)
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {addrWits' :: Set (WitVKey 'Witness)
addrWits' = Set (WitVKey 'Witness)
x})
        ( forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
              (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR)
              (forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall (kr :: KeyRole). IgnoreSigOrd kr -> WitVKey kr
unIgnoreSigOrd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (kr :: KeyRole). WitVKey kr -> IgnoreSigOrd kr
IgnoreSigOrd)
        )
    witField Word
1 =
      forall (ann :: * -> *) x t (d :: Density).
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 {scriptWits' :: Map ScriptHash (Script era)
scriptWits' = Map ScriptHash (Script era)
x})
        ( forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA
              (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR)
              (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 =
      forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA
        (\Set BootstrapWitness
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {bootWits' :: Set BootstrapWitness
bootWits' = Set BootstrapWitness
x})
        (forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) s a (m :: * -> *) b.
Traversable f =>
Decoder s (f (Annotator a))
-> (f a -> m b) -> Decoder s (Annotator (m b))
mapTraverseableDecoderA (forall s a. Decoder s a -> Decoder s [a]
decodeList forall a s. DecCBOR a => Decoder s a
decCBOR) forall a. Ord a => [a] -> Set a
Set.fromList)
    witField Word
n = forall (ann :: * -> *) x t (d :: Density).
Applicative ann =>
(x -> t -> t) -> Decode ('Closed d) (ann x) -> Field (ann t)
fieldAA (\Any
_ ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits) (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> m b
transformList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (f (Annotator a))
decList