{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Shelley.Binary.Annotator (
  mapTraverseableDecoderA,
  module Test.Cardano.Ledger.Core.Binary.Annotator,
) where

import Cardano.Ledger.BaseTypes (maybeToStrictMaybe)
import Cardano.Ledger.Binary
import Cardano.Ledger.Binary.Coders
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.BlockChain
import Cardano.Ledger.Shelley.Scripts
import Cardano.Ledger.Shelley.Tx.Internal (
  ShelleyTx (MkShelleyTx),
  ShelleyTxRaw (..),
  unsafeConstructTxWithBytes,
 )
import Cardano.Ledger.Shelley.TxAuxData
import Cardano.Ledger.Shelley.TxBody
import Cardano.Ledger.Shelley.TxWits
import Data.MapExtras (fromElems)
import qualified Data.Sequence as Seq
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.Void
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Binary.Annotator
import Test.Cardano.Ledger.Shelley.Arbitrary ()

deriving via
  Mem (MultiSigRaw era)
  instance
    Era era => DecCBOR (Annotator (MultiSig era))

instance Era era => DecCBOR (Annotator (MultiSigRaw era)) where
  decCBOR :: forall s. Decoder s (Annotator (MultiSigRaw era))
decCBOR = Text
-> (Word -> Decoder s (Int, Annotator (MultiSigRaw era)))
-> Decoder s (Annotator (MultiSigRaw era))
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"MultiSig" ((Word -> Decoder s (Int, Annotator (MultiSigRaw era)))
 -> Decoder s (Annotator (MultiSigRaw era)))
-> (Word -> Decoder s (Int, Annotator (MultiSigRaw era)))
-> Decoder s (Annotator (MultiSigRaw era))
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> (,) Int
2 (Annotator (MultiSigRaw era) -> (Int, Annotator (MultiSigRaw era)))
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN)
    -> Annotator (MultiSigRaw era))
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> (Int, Annotator (MultiSigRaw era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiSigRaw era -> Annotator (MultiSigRaw era)
forall a. a -> Annotator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MultiSigRaw era -> Annotator (MultiSigRaw era))
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> MultiSigRaw era)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> Annotator (MultiSigRaw era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash 'Witness -> MultiSigRaw era
forall era. KeyHash 'Witness -> MultiSigRaw era
MultiSigSignature (KeyHash 'Witness -> MultiSigRaw era)
-> (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Witness)
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
-> MultiSigRaw era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Witness
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (Hash ADDRHASH (VerKeyDSIGN DSIGN)
 -> (Int, Annotator (MultiSigRaw era)))
-> Decoder s (Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> Decoder s (Int, Annotator (MultiSigRaw era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall s. Decoder s (Hash ADDRHASH (VerKeyDSIGN DSIGN))
forall a s. DecCBOR a => Decoder s a
decCBOR
      Word
1 -> do
        Annotator (StrictSeq (MultiSig era))
multiSigs <- StrictSeq (Annotator (MultiSig era))
-> Annotator (StrictSeq (MultiSig era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
StrictSeq (m a) -> m (StrictSeq a)
sequence (StrictSeq (Annotator (MultiSig era))
 -> Annotator (StrictSeq (MultiSig era)))
-> Decoder s (StrictSeq (Annotator (MultiSig era)))
-> Decoder s (Annotator (StrictSeq (MultiSig era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (StrictSeq (Annotator (MultiSig era)))
forall s. Decoder s (StrictSeq (Annotator (MultiSig era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
        (Int, Annotator (MultiSigRaw era))
-> Decoder s (Int, Annotator (MultiSigRaw era))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, StrictSeq (MultiSig era) -> MultiSigRaw era
forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigAllOf (StrictSeq (MultiSig era) -> MultiSigRaw era)
-> Annotator (StrictSeq (MultiSig era))
-> Annotator (MultiSigRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (MultiSig era))
multiSigs)
      Word
2 -> do
        Annotator (StrictSeq (MultiSig era))
multiSigs <- StrictSeq (Annotator (MultiSig era))
-> Annotator (StrictSeq (MultiSig era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
StrictSeq (m a) -> m (StrictSeq a)
sequence (StrictSeq (Annotator (MultiSig era))
 -> Annotator (StrictSeq (MultiSig era)))
-> Decoder s (StrictSeq (Annotator (MultiSig era)))
-> Decoder s (Annotator (StrictSeq (MultiSig era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (StrictSeq (Annotator (MultiSig era)))
forall s. Decoder s (StrictSeq (Annotator (MultiSig era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
        (Int, Annotator (MultiSigRaw era))
-> Decoder s (Int, Annotator (MultiSigRaw era))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
2, StrictSeq (MultiSig era) -> MultiSigRaw era
forall era. StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigAnyOf (StrictSeq (MultiSig era) -> MultiSigRaw era)
-> Annotator (StrictSeq (MultiSig era))
-> Annotator (MultiSigRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (MultiSig era))
multiSigs)
      Word
3 -> do
        Int
m <- Decoder s Int
forall s. Decoder s Int
forall a s. DecCBOR a => Decoder s a
decCBOR
        Annotator (StrictSeq (MultiSig era))
multiSigs <- StrictSeq (Annotator (MultiSig era))
-> Annotator (StrictSeq (MultiSig era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
StrictSeq (m a) -> m (StrictSeq a)
sequence (StrictSeq (Annotator (MultiSig era))
 -> Annotator (StrictSeq (MultiSig era)))
-> Decoder s (StrictSeq (Annotator (MultiSig era)))
-> Decoder s (Annotator (StrictSeq (MultiSig era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (StrictSeq (Annotator (MultiSig era)))
forall s. Decoder s (StrictSeq (Annotator (MultiSig era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
        (Int, Annotator (MultiSigRaw era))
-> Decoder s (Int, Annotator (MultiSigRaw era))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
3, Int -> StrictSeq (MultiSig era) -> MultiSigRaw era
forall era. Int -> StrictSeq (MultiSig era) -> MultiSigRaw era
MultiSigMOf Int
m (StrictSeq (MultiSig era) -> MultiSigRaw era)
-> Annotator (StrictSeq (MultiSig era))
-> Annotator (MultiSigRaw era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (MultiSig era))
multiSigs)
      Word
k -> Word -> Decoder s (Int, Annotator (MultiSigRaw era))
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k

instance DecCBOR (Annotator ShelleyTxBodyRaw) where
  decCBOR :: forall s. Decoder s (Annotator ShelleyTxBodyRaw)
decCBOR = ShelleyTxBodyRaw -> Annotator ShelleyTxBodyRaw
forall a. a -> Annotator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyTxBodyRaw -> Annotator ShelleyTxBodyRaw)
-> Decoder s ShelleyTxBodyRaw
-> Decoder s (Annotator ShelleyTxBodyRaw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s ShelleyTxBodyRaw
forall s. Decoder s ShelleyTxBodyRaw
forall a s. DecCBOR a => Decoder s a
decCBOR

deriving via Mem ShelleyTxBodyRaw instance DecCBOR (Annotator (TxBody ShelleyEra))

instance Era era => DecCBOR (Annotator (ShelleyTxAuxDataRaw era)) where
  decCBOR :: forall s. Decoder s (Annotator (ShelleyTxAuxDataRaw era))
decCBOR = ShelleyTxAuxDataRaw era -> Annotator (ShelleyTxAuxDataRaw era)
forall a. a -> Annotator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyTxAuxDataRaw era -> Annotator (ShelleyTxAuxDataRaw era))
-> Decoder s (ShelleyTxAuxDataRaw era)
-> Decoder s (Annotator (ShelleyTxAuxDataRaw era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ShelleyTxAuxDataRaw era)
forall s. Decoder s (ShelleyTxAuxDataRaw era)
forall a s. DecCBOR a => Decoder s a
decCBOR

deriving via
  Mem (ShelleyTxAuxDataRaw era)
  instance
    Era era => DecCBOR (Annotator (ShelleyTxAuxData era))

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

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

decodeWits ::
  forall era s.
  (EraScript era, DecCBOR (Annotator (Script era))) =>
  Decoder s (Annotator (ShelleyTxWitsRaw era))
decodeWits :: forall era s.
(EraScript era, DecCBOR (Annotator (Script era))) =>
Decoder s (Annotator (ShelleyTxWitsRaw era))
decodeWits =
  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
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 Any) (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 Any) (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

deriving via
  Mem (ShelleyTxRaw era)
  instance
    ( EraTx era
    , DecCBOR (Annotator (TxBody era))
    , DecCBOR (Annotator (TxWits era))
    , DecCBOR (Annotator (TxAuxData era))
    ) =>
    DecCBOR (Annotator (ShelleyTx era))

instance
  ( EraTx era
  , DecCBOR (Annotator (TxBody era))
  , DecCBOR (Annotator (TxWits era))
  , DecCBOR (Annotator (TxAuxData era))
  ) =>
  DecCBOR (Annotator (ShelleyTxRaw era))
  where
  decCBOR :: forall s. Decoder s (Annotator (ShelleyTxRaw era))
decCBOR =
    Decode ('Closed 'Dense) (Annotator (ShelleyTxRaw era))
-> Decoder s (Annotator (ShelleyTxRaw era))
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (Annotator (ShelleyTxRaw era))
 -> Decoder s (Annotator (ShelleyTxRaw era)))
-> Decode ('Closed 'Dense) (Annotator (ShelleyTxRaw era))
-> Decoder s (Annotator (ShelleyTxRaw era))
forall a b. (a -> b) -> a -> b
$
      Decode
  ('Closed 'Dense)
  (TxBody era
   -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Decode
     ('Closed 'Dense)
     (Annotator
        (TxBody era
         -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era))
forall t1 (w :: Wrapped).
Typeable t1 =>
Decode w t1 -> Decode w (Annotator t1)
Ann ((TxBody era
 -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
-> Decode
     ('Closed 'Dense)
     (TxBody era
      -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era)
forall t. t -> Decode ('Closed 'Dense) t
RecD TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
forall era.
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era
ShelleyTxRaw)
        Decode
  ('Closed 'Dense)
  (Annotator
     (TxBody era
      -> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era))
-> Decode ('Closed Any) (Annotator (TxBody era))
-> Decode
     ('Closed 'Dense)
     (Annotator
        (TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Annotator (TxBody era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Annotator
     (TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTxRaw era))
-> Decode ('Closed Any) (Annotator (TxWits era))
-> Decode
     ('Closed 'Dense)
     (Annotator (StrictMaybe (TxAuxData era) -> ShelleyTxRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! Decode ('Closed Any) (Annotator (TxWits era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
        Decode
  ('Closed 'Dense)
  (Annotator (StrictMaybe (TxAuxData era) -> ShelleyTxRaw era))
-> Decode
     ('Closed 'Dense) (Annotator (StrictMaybe (TxAuxData era)))
-> Decode ('Closed 'Dense) (Annotator (ShelleyTxRaw era))
forall a t (w1 :: Wrapped) (d :: Density).
(Typeable a, Typeable t) =>
Decode w1 (Annotator (a -> t))
-> Decode ('Closed d) (Annotator a) -> Decode w1 (Annotator t)
<*! (forall s. Decoder s (Annotator (StrictMaybe (TxAuxData era))))
-> Decode
     ('Closed 'Dense) (Annotator (StrictMaybe (TxAuxData era)))
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D
          ( StrictMaybe (Annotator (TxAuxData era))
-> Annotator (StrictMaybe (TxAuxData era))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
StrictMaybe (m a) -> m (StrictMaybe a)
sequence (StrictMaybe (Annotator (TxAuxData era))
 -> Annotator (StrictMaybe (TxAuxData era)))
-> (Maybe (Annotator (TxAuxData era))
    -> StrictMaybe (Annotator (TxAuxData era)))
-> Maybe (Annotator (TxAuxData era))
-> Annotator (StrictMaybe (TxAuxData era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Annotator (TxAuxData era))
-> StrictMaybe (Annotator (TxAuxData era))
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
              (Maybe (Annotator (TxAuxData era))
 -> Annotator (StrictMaybe (TxAuxData era)))
-> Decoder s (Maybe (Annotator (TxAuxData era)))
-> Decoder s (Annotator (StrictMaybe (TxAuxData era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (TxAuxData era))
-> Decoder s (Maybe (Annotator (TxAuxData era)))
forall s a. Decoder s a -> Decoder s (Maybe a)
decodeNullMaybe Decoder s (Annotator (TxAuxData era))
forall s. Decoder s (Annotator (TxAuxData era))
forall a s. DecCBOR a => Decoder s a
decCBOR
          )

segWitAnnTx ::
  forall era.
  EraTx era =>
  Annotator (TxBody era) ->
  Annotator (TxWits era) ->
  Maybe (Annotator (TxAuxData era)) ->
  Annotator (ShelleyTx era)
segWitAnnTx :: forall era.
EraTx era =>
Annotator (TxBody era)
-> Annotator (TxWits era)
-> Maybe (Annotator (TxAuxData era))
-> Annotator (ShelleyTx era)
segWitAnnTx Annotator (TxBody era)
bodyAnn Annotator (TxWits era)
witsAnn Maybe (Annotator (TxAuxData era))
metaAnn = (FullByteString -> ShelleyTx era) -> Annotator (ShelleyTx era)
forall a. (FullByteString -> a) -> Annotator a
Annotator ((FullByteString -> ShelleyTx era) -> Annotator (ShelleyTx era))
-> (FullByteString -> ShelleyTx era) -> Annotator (ShelleyTx era)
forall a b. (a -> b) -> a -> b
$ \FullByteString
bytes ->
  let body' :: TxBody era
body' = Annotator (TxBody era) -> FullByteString -> TxBody era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxBody era)
bodyAnn FullByteString
bytes
      witnessSet :: TxWits era
witnessSet = Annotator (TxWits era) -> FullByteString -> TxWits era
forall a. Annotator a -> FullByteString -> a
runAnnotator Annotator (TxWits era)
witsAnn FullByteString
bytes
      metadata :: Maybe (TxAuxData era)
metadata = (Annotator (TxAuxData era) -> FullByteString -> TxAuxData era)
-> FullByteString -> Annotator (TxAuxData era) -> TxAuxData era
forall a b c. (a -> b -> c) -> b -> a -> c
flip Annotator (TxAuxData era) -> FullByteString -> TxAuxData era
forall a. Annotator a -> FullByteString -> a
runAnnotator FullByteString
bytes (Annotator (TxAuxData era) -> TxAuxData era)
-> Maybe (Annotator (TxAuxData era)) -> Maybe (TxAuxData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Annotator (TxAuxData era))
metaAnn
      wrappedMetadataBytes :: ByteString
wrappedMetadataBytes = case Maybe (TxAuxData era)
metadata of
        Maybe (TxAuxData era)
Nothing -> Encoding -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize Encoding
Plain.encodeNull
        Just TxAuxData era
b -> TxAuxData era -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize TxAuxData era
b
      fullBytes :: ByteString
fullBytes =
        Encoding -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize (Word -> Encoding
Plain.encodeListLen Word
3)
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TxBody era -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize TxBody era
body'
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> TxWits era -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize TxWits era
witnessSet
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
wrappedMetadataBytes
   in TxBody era
-> TxWits era
-> StrictMaybe (TxAuxData era)
-> ByteString
-> ShelleyTx era
forall era.
TxBody era
-> TxWits era
-> StrictMaybe (TxAuxData era)
-> ByteString
-> ShelleyTx era
unsafeConstructTxWithBytes
        TxBody era
body'
        TxWits era
witnessSet
        (Maybe (TxAuxData era) -> StrictMaybe (TxAuxData era)
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (TxAuxData era)
metadata)
        ByteString
fullBytes

-- | The parts of the Tx in Blocks that have to have DecCBOR(Annotator x) instances.
--   These are exactly the parts that are SafeToHash.
-- | Decode a TxSeq, used in decoding a Block.
txSeqDecoder ::
  ( EraTx era
  , DecCBOR (Annotator (TxAuxData era))
  , DecCBOR (Annotator (TxBody era))
  , DecCBOR (Annotator (TxWits era))
  ) =>
  Bool ->
  Decoder s (Annotator (ShelleyTxSeq era))
txSeqDecoder :: forall era s.
(EraTx era, DecCBOR (Annotator (TxAuxData era)),
 DecCBOR (Annotator (TxBody era)),
 DecCBOR (Annotator (TxWits era))) =>
Bool -> Decoder s (Annotator (ShelleyTxSeq era))
txSeqDecoder Bool
lax = do
  (Seq (Annotator (TxBody era))
bodies, Annotator ByteString
bodiesAnn) <- Decoder s (Seq (Annotator (TxBody era)))
-> Decoder s (Seq (Annotator (TxBody era)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s (Seq (Annotator (TxBody era)))
forall s. Decoder s (Seq (Annotator (TxBody era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
  (Seq (Annotator (TxWits era))
wits, Annotator ByteString
witsAnn) <- Decoder s (Seq (Annotator (TxWits era)))
-> Decoder s (Seq (Annotator (TxWits era)), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice Decoder s (Seq (Annotator (TxWits era)))
forall s. Decoder s (Seq (Annotator (TxWits era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
  let bodiesLength :: Int
bodiesLength = Seq (Annotator (TxBody era)) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxBody era))
bodies
      witsLength :: Int
witsLength = Seq (Annotator (TxWits era)) -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq (Annotator (TxWits era))
wits
  (Seq (Maybe (Annotator (TxAuxData era)))
metadata, Annotator ByteString
metadataAnn) <- Decoder s (Seq (Maybe (Annotator (TxAuxData era))))
-> Decoder
     s (Seq (Maybe (Annotator (TxAuxData era))), Annotator ByteString)
forall s a. Decoder s a -> Decoder s (a, Annotator ByteString)
withSlice (Decoder s (Seq (Maybe (Annotator (TxAuxData era))))
 -> Decoder
      s (Seq (Maybe (Annotator (TxAuxData era))), Annotator ByteString))
-> Decoder s (Seq (Maybe (Annotator (TxAuxData era))))
-> Decoder
     s (Seq (Maybe (Annotator (TxAuxData era))), Annotator ByteString)
forall a b. (a -> b) -> a -> b
$ do
    IntMap (Annotator (TxAuxData era))
auxDataMap <- Decoder s (IntMap (Annotator (TxAuxData era)))
forall s. Decoder s (IntMap (Annotator (TxAuxData era)))
forall a s. DecCBOR a => Decoder s a
decCBOR
    Int
-> IntMap (Annotator (TxAuxData era))
-> Bool
-> Decoder s (Seq (Maybe (Annotator (TxAuxData era))))
forall a s. Int -> IntMap a -> Bool -> Decoder s (Seq (Maybe a))
auxDataSeqDecoder Int
bodiesLength IntMap (Annotator (TxAuxData era))
auxDataMap Bool
lax

  Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (Bool
lax Bool -> Bool -> Bool
|| Int
bodiesLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
witsLength)
    ( String -> Decoder s ()
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s ()) -> String -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
        String
"different number of transaction bodies ("
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
bodiesLength
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
") and witness sets ("
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
witsLength
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
    )

  let txns :: Annotator (StrictSeq (ShelleyTx era))
txns =
        StrictSeq (Annotator (ShelleyTx era))
-> Annotator (StrictSeq (ShelleyTx era))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
StrictSeq (f a) -> f (StrictSeq a)
sequenceA (StrictSeq (Annotator (ShelleyTx era))
 -> Annotator (StrictSeq (ShelleyTx era)))
-> StrictSeq (Annotator (ShelleyTx era))
-> Annotator (StrictSeq (ShelleyTx era))
forall a b. (a -> b) -> a -> b
$
          Seq (Annotator (ShelleyTx era))
-> StrictSeq (Annotator (ShelleyTx era))
forall a. Seq a -> StrictSeq a
StrictSeq.forceToStrict (Seq (Annotator (ShelleyTx era))
 -> StrictSeq (Annotator (ShelleyTx era)))
-> Seq (Annotator (ShelleyTx era))
-> StrictSeq (Annotator (ShelleyTx era))
forall a b. (a -> b) -> a -> b
$
            (Annotator (TxBody era)
 -> Annotator (TxWits era)
 -> Maybe (Annotator (TxAuxData era))
 -> Annotator (ShelleyTx era))
-> Seq (Annotator (TxBody era))
-> Seq (Annotator (TxWits era))
-> Seq (Maybe (Annotator (TxAuxData era)))
-> Seq (Annotator (ShelleyTx era))
forall a b c d.
(a -> b -> c -> d) -> Seq a -> Seq b -> Seq c -> Seq d
Seq.zipWith3 Annotator (TxBody era)
-> Annotator (TxWits era)
-> Maybe (Annotator (TxAuxData era))
-> Annotator (ShelleyTx era)
forall era.
EraTx era =>
Annotator (TxBody era)
-> Annotator (TxWits era)
-> Maybe (Annotator (TxAuxData era))
-> Annotator (ShelleyTx era)
segWitAnnTx Seq (Annotator (TxBody era))
bodies Seq (Annotator (TxWits era))
wits Seq (Maybe (Annotator (TxAuxData era)))
metadata
  Annotator (ShelleyTxSeq era)
-> Decoder s (Annotator (ShelleyTxSeq era))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Annotator (ShelleyTxSeq era)
 -> Decoder s (Annotator (ShelleyTxSeq era)))
-> Annotator (ShelleyTxSeq era)
-> Decoder s (Annotator (ShelleyTxSeq era))
forall a b. (a -> b) -> a -> b
$ StrictSeq (ShelleyTx era)
-> ByteString -> ByteString -> ByteString -> ShelleyTxSeq era
forall era.
StrictSeq (ShelleyTx era)
-> ByteString -> ByteString -> ByteString -> ShelleyTxSeq era
TxSeq' (StrictSeq (ShelleyTx era)
 -> ByteString -> ByteString -> ByteString -> ShelleyTxSeq era)
-> Annotator (StrictSeq (ShelleyTx era))
-> Annotator
     (ByteString -> ByteString -> ByteString -> ShelleyTxSeq era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Annotator (StrictSeq (ShelleyTx era))
txns Annotator
  (ByteString -> ByteString -> ByteString -> ShelleyTxSeq era)
-> Annotator ByteString
-> Annotator (ByteString -> ByteString -> ShelleyTxSeq era)
forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
bodiesAnn Annotator (ByteString -> ByteString -> ShelleyTxSeq era)
-> Annotator ByteString
-> Annotator (ByteString -> ShelleyTxSeq era)
forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
witsAnn Annotator (ByteString -> ShelleyTxSeq era)
-> Annotator ByteString -> Annotator (ShelleyTxSeq era)
forall a b. Annotator (a -> b) -> Annotator a -> Annotator b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Annotator ByteString
metadataAnn

instance
  ( EraTx era
  , DecCBOR (Annotator (TxAuxData era))
  , DecCBOR (Annotator (TxBody era))
  , DecCBOR (Annotator (TxWits era))
  ) =>
  DecCBOR (Annotator (ShelleyTxSeq era))
  where
  decCBOR :: forall s. Decoder s (Annotator (ShelleyTxSeq era))
decCBOR = Bool -> Decoder s (Annotator (ShelleyTxSeq era))
forall era s.
(EraTx era, DecCBOR (Annotator (TxAuxData era)),
 DecCBOR (Annotator (TxBody era)),
 DecCBOR (Annotator (TxWits era))) =>
Bool -> Decoder s (Annotator (ShelleyTxSeq era))
txSeqDecoder Bool
False