{-# 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 (EraCrypto),
  EraScript (Script),
  EraTxWits (..),
  ScriptHash,
  hashScript,
 )
import Cardano.Ledger.Crypto (Crypto, StandardCrypto)
import Cardano.Ledger.Keys (KeyRole (Witness))
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness)
import Cardano.Ledger.Keys.WitVKey (WitVKey (..), witVKeyHash)
import Cardano.Ledger.MemoBytes (
  EqRaw (..),
  Mem,
  MemoBytes,
  Memoized (..),
  getMemoRawType,
  lensMemoRawType,
  mkMemoized,
 )
import Cardano.Ledger.SafeHash (SafeToHash (..))
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 (EraCrypto era))
addrWits' :: !(Set (WitVKey 'Witness (EraCrypto era)))
  , forall era.
ShelleyTxWitsRaw era
-> Map (ScriptHash (EraCrypto era)) (Script era)
scriptWits' :: !(Map (ScriptHash (EraCrypto era)) (Script era))
  , forall era.
ShelleyTxWitsRaw era -> Set (BootstrapWitness (EraCrypto era))
bootWits' :: !(Set (BootstrapWitness (EraCrypto era)))
  }
  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 (EraCrypto era))
  , NFData (BootstrapWitness (EraCrypto era))
  ) =>
  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 era. ShelleyTxWits era -> Int
forall era. ShelleyTxWits era -> ByteString
forall t.
(t -> ByteString)
-> (t -> Int)
-> (forall c index.
    HashAlgorithm (HASH c) =>
    Proxy c -> Proxy index -> t -> SafeHash c index)
-> SafeToHash t
forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTxWits era -> SafeHash c index
forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTxWits era -> SafeHash c index
makeHashWithExplicitProxys :: forall c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTxWits era -> SafeHash c index
$cmakeHashWithExplicitProxys :: forall era c index.
HashAlgorithm (HASH c) =>
Proxy c -> Proxy index -> ShelleyTxWits era -> SafeHash c index
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 (EraCrypto era))
  , NFData (BootstrapWitness (EraCrypto era))
  ) =>
  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 (EraCrypto era)))
addrShelleyTxWitsL :: forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
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 (EraCrypto era))
addrWits' forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxWits era
witsRaw Set (WitVKey 'Witness (EraCrypto era))
aw -> RawType ShelleyTxWits era
witsRaw {addrWits' :: Set (WitVKey 'Witness (EraCrypto era))
addrWits' = Set (WitVKey 'Witness (EraCrypto era))
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 (EraCrypto era)))
bootAddrShelleyTxWitsL :: forall era.
EraScript era =>
Lens' (ShelleyTxWits era) (Set (BootstrapWitness (EraCrypto era)))
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 (EraCrypto era))
bootWits' forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxWits era
witsRaw Set (BootstrapWitness (EraCrypto era))
bw -> RawType ShelleyTxWits era
witsRaw {bootWits' :: Set (BootstrapWitness (EraCrypto era))
bootWits' = Set (BootstrapWitness (EraCrypto era))
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 (EraCrypto era)) (Script era))
scriptShelleyTxWitsL :: forall era.
EraScript era =>
Lens'
  (ShelleyTxWits era) (Map (ScriptHash (EraCrypto era)) (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 (EraCrypto era)) (Script era)
scriptWits' forall a b. (a -> b) -> a -> b
$ \RawType ShelleyTxWits era
witsRaw Map (ScriptHash (EraCrypto era)) (Script era)
sw -> RawType ShelleyTxWits era
witsRaw {scriptWits' :: Map (ScriptHash (EraCrypto era)) (Script era)
scriptWits' = Map (ScriptHash (EraCrypto era)) (Script era)
sw}
{-# INLINEABLE scriptShelleyTxWitsL #-}

instance Crypto c => EraTxWits (ShelleyEra c) where
  {-# SPECIALIZE instance EraTxWits (ShelleyEra StandardCrypto) #-}

  type TxWits (ShelleyEra c) = ShelleyTxWits (ShelleyEra c)

  mkBasicTxWits :: TxWits (ShelleyEra c)
mkBasicTxWits = forall a. Monoid a => a
mempty

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

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

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

  upgradeTxWits :: EraTxWits (PreviousEra (ShelleyEra c)) =>
TxWits (PreviousEra (ShelleyEra c)) -> TxWits (ShelleyEra c)
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 (EraCrypto era))
vkeys Map (ScriptHash (EraCrypto era)) (Script era)
scripts Set (BootstrapWitness (EraCrypto era))
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 (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Set (BootstrapWitness (EraCrypto era))
-> 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 (EraCrypto era))
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 (EraCrypto era)) (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 (EraCrypto era))
boots)

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

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

instance EraScript era => Monoid (ShelleyTxWits era) where
  mempty :: ShelleyTxWits era
mempty = forall era.
EraScript era =>
Set (WitVKey 'Witness (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Set (BootstrapWitness (EraCrypto era))
-> 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 (EraCrypto era)) ->
  Map (ScriptHash (EraCrypto era)) (Script era) ->
  Set (BootstrapWitness (EraCrypto era)) ->
  ShelleyTxWits era
pattern $bShelleyTxWits :: forall era.
EraScript era =>
Set (WitVKey 'Witness (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Set (BootstrapWitness (EraCrypto era))
-> ShelleyTxWits era
$mShelleyTxWits :: forall {r} {era}.
EraScript era =>
ShelleyTxWits era
-> (Set (WitVKey 'Witness (EraCrypto era))
    -> Map (ScriptHash (EraCrypto era)) (Script era)
    -> Set (BootstrapWitness (EraCrypto era))
    -> r)
-> ((# #) -> r)
-> r
ShelleyTxWits {forall era.
EraScript era =>
ShelleyTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
addrWits, forall era.
EraScript era =>
ShelleyTxWits era -> Map (ScriptHash (EraCrypto era)) (Script era)
scriptWits, forall era.
EraScript era =>
ShelleyTxWits era -> Set (BootstrapWitness (EraCrypto era))
bootWits} <-
  (getMemoRawType -> ShelleyTxWitsRaw addrWits scriptWits bootWits)
  where
    ShelleyTxWits Set (WitVKey 'Witness (EraCrypto era))
awits Map (ScriptHash (EraCrypto era)) (Script era)
scriptWitMap Set (BootstrapWitness (EraCrypto era))
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 (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Set (BootstrapWitness (EraCrypto era))
-> ShelleyTxWitsRaw era
ShelleyTxWitsRaw Set (WitVKey 'Witness (EraCrypto era))
awits Map (ScriptHash (EraCrypto era)) (Script era)
scriptWitMap Set (BootstrapWitness (EraCrypto era))
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 (EraCrypto era)))
addrTxWitsL) (TxWits era
txWits2 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
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 (EraCrypto era)) (Script era))
scriptTxWitsL) (TxWits era
txWits2 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (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 (EraCrypto era)))
bootAddrTxWitsL) (TxWits era
txWits2 forall s a. s -> Getting a s a -> a
^. forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (BootstrapWitness (EraCrypto era)))
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 c = IgnoreSigOrd {forall (kr :: KeyRole) c. IgnoreSigOrd kr c -> WitVKey kr c
unIgnoreSigOrd :: WitVKey kr c}
  deriving (IgnoreSigOrd kr c -> IgnoreSigOrd kr c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kr :: KeyRole) c.
Crypto c =>
IgnoreSigOrd kr c -> IgnoreSigOrd kr c -> Bool
/= :: IgnoreSigOrd kr c -> IgnoreSigOrd kr c -> Bool
$c/= :: forall (kr :: KeyRole) c.
Crypto c =>
IgnoreSigOrd kr c -> IgnoreSigOrd kr c -> Bool
== :: IgnoreSigOrd kr c -> IgnoreSigOrd kr c -> Bool
$c== :: forall (kr :: KeyRole) c.
Crypto c =>
IgnoreSigOrd kr c -> IgnoreSigOrd kr c -> Bool
Eq)

instance (Typeable kr, Crypto c) => Ord (IgnoreSigOrd kr c) where
  compare :: IgnoreSigOrd kr c -> IgnoreSigOrd kr c -> Ordering
compare (IgnoreSigOrd WitVKey kr c
w1) (IgnoreSigOrd WitVKey kr c
w2) = forall a. Ord a => a -> a -> Ordering
compare (forall (kr :: KeyRole) c. WitVKey kr c -> KeyHash 'Witness c
witVKeyHash WitVKey kr c
w1) (forall (kr :: KeyRole) c. WitVKey kr c -> KeyHash 'Witness c
witVKeyHash WitVKey kr c
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 ShelleyTxWitsRaw era
emptyWitnessSet)
      Word -> Field (Annotator (ShelleyTxWitsRaw era))
witField
      []
  where
    emptyWitnessSet :: ShelleyTxWitsRaw era
emptyWitnessSet = forall era.
Set (WitVKey 'Witness (EraCrypto era))
-> Map (ScriptHash (EraCrypto era)) (Script era)
-> Set (BootstrapWitness (EraCrypto era))
-> 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 (EraCrypto era))
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {addrWits' :: Set (WitVKey 'Witness (EraCrypto era))
addrWits' = Set (WitVKey 'Witness (EraCrypto 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 b a. Ord b => (a -> b) -> Set a -> Set b
Set.map forall (kr :: KeyRole) c. IgnoreSigOrd kr c -> WitVKey kr c
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) c. WitVKey kr c -> IgnoreSigOrd kr c
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 (EraCrypto era)) (Script era)
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {scriptWits' :: Map (ScriptHash (EraCrypto era)) (Script era)
scriptWits' = Map (ScriptHash (EraCrypto era)) (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 (EraCrypto era)
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 (EraCrypto era))
x ShelleyTxWitsRaw era
wits -> ShelleyTxWitsRaw era
wits {bootWits' :: Set (BootstrapWitness (EraCrypto era))
bootWits' = Set (BootstrapWitness (EraCrypto 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 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