{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Chain.Block.ValidationMode (
  tests,
) where

import qualified Byron.Spec.Chain.STS.Block as Abstract
import Byron.Spec.Chain.STS.Rule.Chain (CHAIN)
import qualified Byron.Spec.Chain.STS.Rule.Chain as Abstract
import qualified Byron.Spec.Ledger.Core as Abstract
import Byron.Spec.Ledger.Delegation (
  ADELEGS,
  DELEG,
  DIState (..),
  DState (..),
 )
import Byron.Spec.Ledger.GlobalParams (lovelaceCap)
import Byron.Spec.Ledger.STS.UTXO (UTxOEnv (..), UTxOState (..))
import Byron.Spec.Ledger.STS.UTXOWS (UTXOWS)
import qualified Byron.Spec.Ledger.UTxO as Abstract
import Cardano.Chain.Block (
  ABlock (..),
  AHeader (..),
  BlockValidationMode (..),
  Proof (..),
  blockProof,
  initialChainValidationState,
  updateBlock,
 )
import Cardano.Chain.Delegation as Delegation
import Cardano.Chain.UTxO (TxProof)
import Cardano.Chain.ValidationMode (
  ValidationMode (..),
  fromBlockValidationMode,
 )
import Cardano.Crypto (Hash)
import Cardano.Ledger.Binary (Annotated (..))
import Cardano.Prelude hiding (State, trace)
import Control.State.Transition
import qualified Data.Bimap as BM
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Lens.Micro ((^.))
import qualified Test.Cardano.Chain.Delegation.Gen as Delegation
import Test.Cardano.Chain.Elaboration.Block (
  abEnvToCfg,
  elaborateBS,
  rcDCert,
  transactionIds,
 )
import Test.Cardano.Chain.UTxO.Gen (genTxProof)
import Test.Cardano.Chain.UTxO.Model (elaborateInitialUTxO)
import qualified Test.Cardano.Chain.Update.Gen as Update
import Test.Cardano.Crypto.Gen (feedPM, genAbstractHash)
import Test.Cardano.Prelude
import Test.Control.State.Transition.Generator (trace)
import qualified Test.Control.State.Transition.Trace as Trace
import Test.Options (TSGroup, TSProperty, withTestsTS)

--------------------------------------------------------------------------------
-- BlockValidationMode Properties
--------------------------------------------------------------------------------

-- | Property: When calling 'updateBlock' given a valid 'Block', validation
-- should pass in all 'BlockValidationMode's.
ts_prop_updateBlock_Valid :: TSProperty
ts_prop_updateBlock_Valid :: TSProperty
ts_prop_updateBlock_Valid =
  TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100
    (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property
    (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
      let traceLength :: Word64
traceLength = Word64
10 :: Word64 -- TODO: check that the @k@ value is not important
      -- in this test, in that case we can get away with
      -- generating small traces.
      sampleTrace <- Gen (Trace CHAIN) -> PropertyT IO (Trace CHAIN)
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen (Trace CHAIN) -> PropertyT IO (Trace CHAIN))
-> Gen (Trace CHAIN) -> PropertyT IO (Trace CHAIN)
forall a b. (a -> b) -> a -> b
$ forall s. HasTrace s => BaseEnv s -> Word64 -> Gen (Trace s)
trace @CHAIN () Word64
traceLength
      let lastState = Trace CHAIN -> State CHAIN
forall s. Trace s -> State s
Trace.lastState Trace CHAIN
sampleTrace
          chainEnv@( _currentSlot
                     , abstractInitialUTxO
                     , _allowedDelegators
                     , _protocolParamaters
                     , stableAfter
                     ) = Trace._traceEnv sampleTrace
      abstractBlock <-
        forAll
          $ Abstract.sigGenChain
            Abstract.NoGenDelegation
            Abstract.NoGenUTxO
            Abstract.NoGenUpdate
            chainEnv
            lastState
      let config = Environment CHAIN -> Config
abEnvToCfg (Slot, UTxO, Set VKeyGenesis, PParams, BlockCount)
Environment CHAIN
chainEnv
          cvs = (Error -> ChainValidationState)
-> (ChainValidationState -> ChainValidationState)
-> Either Error ChainValidationState
-> ChainValidationState
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> ChainValidationState
forall a. HasCallStack => Text -> a
panic (Text -> ChainValidationState)
-> (Error -> Text) -> Error -> ChainValidationState
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Error -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show) (\ChainValidationState
a -> ChainValidationState
a) (Config -> Either Error ChainValidationState
forall (m :: * -> *).
MonadError Error m =>
Config -> m ChainValidationState
initialChainValidationState Config
config)
          (_, txIdMap) = elaborateInitialUTxO abstractInitialUTxO
          dCert =
            HasCallStack => VKey -> BlockCount -> State CHAIN -> DCert
VKey -> BlockCount -> State CHAIN -> DCert
rcDCert
              (Block
abstractBlock Block -> Getting VKey Block VKey -> VKey
forall s a. s -> Getting a s a -> a
^. (BlockHeader -> Const VKey BlockHeader)
-> Block -> Const VKey Block
Lens' Block BlockHeader
Abstract.bHeader ((BlockHeader -> Const VKey BlockHeader)
 -> Block -> Const VKey Block)
-> ((VKey -> Const VKey VKey)
    -> BlockHeader -> Const VKey BlockHeader)
-> Getting VKey Block VKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VKey -> Const VKey VKey) -> BlockHeader -> Const VKey BlockHeader
Lens' BlockHeader VKey
Abstract.bhIssuer)
              BlockCount
stableAfter
              (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
State CHAIN
lastState
      vMode <- forAll $ fromBlockValidationMode <$> genBlockValidationMode
      let (concreteBlock, _txIdMap') =
            elaborateBS
              mempty {transactionIds = txIdMap}
              config
              dCert
              cvs
              abstractBlock
      annotateShow concreteBlock
      updateRes <-
        (`runReaderT` vMode)
          . runExceptT
          $ updateBlock config cvs concreteBlock
      case updateRes of
        Left ChainValidationError
_ -> PropertyT IO ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
failure
        Right ChainValidationState
_ -> PropertyT IO ()
forall (m :: * -> *). MonadTest m => m ()
success

-- | Property: When calling 'updateBlock' given a 'Block' with an invalid
-- 'Proof', 'Block' validation should only pass in the 'NoBlockValidation' mode.
-- This is because this mode does not perform any validation on the 'Block'.
ts_prop_updateBlock_InvalidProof :: TSProperty
ts_prop_updateBlock_InvalidProof :: TSProperty
ts_prop_updateBlock_InvalidProof =
  TestLimit -> Property -> TSProperty
withTestsTS TestLimit
100
    (Property -> TSProperty)
-> (PropertyT IO () -> Property) -> PropertyT IO () -> TSProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property
    (PropertyT IO () -> TSProperty) -> PropertyT IO () -> TSProperty
forall a b. (a -> b) -> a -> b
$ do
      let traceLength :: Word64
traceLength = Word64
10 :: Word64
      sampleTrace <- Gen (Trace CHAIN) -> PropertyT IO (Trace CHAIN)
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (Gen (Trace CHAIN) -> PropertyT IO (Trace CHAIN))
-> Gen (Trace CHAIN) -> PropertyT IO (Trace CHAIN)
forall a b. (a -> b) -> a -> b
$ forall s. HasTrace s => BaseEnv s -> Word64 -> Gen (Trace s)
trace @CHAIN () Word64
traceLength
      let chainEnv@(_, abstractInitialUTxO, _, _, stableAfter) = Trace._traceEnv sampleTrace
          lastState = Trace CHAIN -> State CHAIN
forall s. Trace s -> State s
Trace.lastState Trace CHAIN
sampleTrace
      abstractBlock <-
        forAll
          $ Abstract.sigGenChain
            Abstract.NoGenDelegation
            Abstract.NoGenUTxO
            Abstract.NoGenUpdate
            chainEnv
            lastState
      let config = Environment CHAIN -> Config
abEnvToCfg (Slot, UTxO, Set VKeyGenesis, PParams, BlockCount)
Environment CHAIN
chainEnv
          cvs = (Error -> ChainValidationState)
-> (ChainValidationState -> ChainValidationState)
-> Either Error ChainValidationState
-> ChainValidationState
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Text -> ChainValidationState
forall a. HasCallStack => Text -> a
panic (Text -> ChainValidationState)
-> (Error -> Text) -> Error -> ChainValidationState
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Error -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show) (\ChainValidationState
a -> ChainValidationState
a) (Config -> Either Error ChainValidationState
forall (m :: * -> *).
MonadError Error m =>
Config -> m ChainValidationState
initialChainValidationState Config
config)
          (_, txIdMap) = elaborateInitialUTxO abstractInitialUTxO
          dCert = HasCallStack => VKey -> BlockCount -> State CHAIN -> DCert
VKey -> BlockCount -> State CHAIN -> DCert
rcDCert (Block
abstractBlock Block -> Getting VKey Block VKey -> VKey
forall s a. s -> Getting a s a -> a
^. (BlockHeader -> Const VKey BlockHeader)
-> Block -> Const VKey Block
Lens' Block BlockHeader
Abstract.bHeader ((BlockHeader -> Const VKey BlockHeader)
 -> Block -> Const VKey Block)
-> ((VKey -> Const VKey VKey)
    -> BlockHeader -> Const VKey BlockHeader)
-> Getting VKey Block VKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VKey -> Const VKey VKey) -> BlockHeader -> Const VKey BlockHeader
Lens' BlockHeader VKey
Abstract.bhIssuer) BlockCount
stableAfter (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
State CHAIN
lastState
      vMode <- forAll $ fromBlockValidationMode <$> genBlockValidationMode
      let (concreteBlock, _abstractToConcreteIdMaps') =
            elaborateBS
              initialAbstractToConcreteIdMaps
              config
              dCert
              cvs
              abstractBlock
          initialAbstractToConcreteIdMaps = AbstractToConcreteIdMaps
forall a. Monoid a => a
mempty {transactionIds = txIdMap}
      annotateShow concreteBlock
      invalidBlock <- forAll $ invalidateABlockProof concreteBlock
      updateRes <-
        (`runReaderT` vMode)
          . runExceptT
          $ updateBlock config cvs invalidBlock
      case updateRes of
        Left ChainValidationError
_ ->
          if (ValidationMode -> BlockValidationMode
blockValidationMode ValidationMode
vMode) BlockValidationMode -> BlockValidationMode -> Bool
forall a. Eq a => a -> a -> Bool
== BlockValidationMode
BlockValidation
            then PropertyT IO ()
forall (m :: * -> *). MonadTest m => m ()
success
            else PropertyT IO ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
failure
        Right ChainValidationState
_ ->
          if (ValidationMode -> BlockValidationMode
blockValidationMode ValidationMode
vMode) BlockValidationMode -> BlockValidationMode -> Bool
forall a. Eq a => a -> a -> Bool
== BlockValidationMode
NoBlockValidation
            then PropertyT IO ()
forall (m :: * -> *). MonadTest m => m ()
success
            else PropertyT IO ()
forall (m :: * -> *) a. (MonadTest m, HasCallStack) => m a
failure

--------------------------------------------------------------------------------
-- Generators
--------------------------------------------------------------------------------

genHash :: Gen Abstract.Hash
genHash :: Gen Hash
genHash = Maybe Int -> Hash
Abstract.Hash (Maybe Int -> Hash) -> (Int -> Maybe Int) -> Int -> Hash
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Hash) -> GenT Identity Int -> Gen Hash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Int -> GenT Identity Int
forall (m :: * -> *). MonadGen m => Range Int -> m Int
Gen.int Range Int
forall a. (Bounded a, Num a) => Range a
Range.constantBounded

genBlockValidationMode :: Gen BlockValidationMode
genBlockValidationMode :: GenT Identity BlockValidationMode
genBlockValidationMode = [BlockValidationMode] -> GenT Identity BlockValidationMode
forall (f :: * -> *) (m :: * -> *) a.
(HasCallStack, Foldable f, MonadGen m) =>
f a -> m a
Gen.element [BlockValidationMode
BlockValidation, BlockValidationMode
NoBlockValidation]

--------------------------------------------------------------------------------
-- Helpers
--------------------------------------------------------------------------------

createInitialUTxOState ::
  Environment UTXOWS ->
  State UTXOWS
createInitialUTxOState :: Environment UTXOWS -> State UTXOWS
createInitialUTxOState Environment UTXOWS
utxoEnv =
  UTxOState {utxo :: UTxO
utxo = UTxO
utxo0, reserves :: Lovelace
reserves = Lovelace
lovelaceCap Lovelace -> Lovelace -> Lovelace
forall a. Num a => a -> a -> a
- UTxO -> Lovelace
Abstract.balance UTxO
utxo0}
  where
    UTxOEnv
      { UTxO
utxo0 :: UTxO
utxo0 :: UTxOEnv -> UTxO
utxo0
      } = Environment UTXOWS
utxoEnv

createInitialDState ::
  Environment ADELEGS ->
  State ADELEGS
createInitialDState :: Environment ADELEGS -> State ADELEGS
createInitialDState Environment ADELEGS
env =
  DState
    { _dStateDelegationMap :: Bimap VKeyGenesis VKey
_dStateDelegationMap =
        [(VKeyGenesis, VKey)] -> Bimap VKeyGenesis VKey
forall a b. (Ord a, Ord b) => [(a, b)] -> Bimap a b
BM.fromList
          ([(VKeyGenesis, VKey)] -> Bimap VKeyGenesis VKey)
-> [(VKeyGenesis, VKey)] -> Bimap VKeyGenesis VKey
forall a b. (a -> b) -> a -> b
$ (VKeyGenesis -> (VKeyGenesis, VKey))
-> [VKeyGenesis] -> [(VKeyGenesis, VKey)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map
            (\vkg :: VKeyGenesis
vkg@(Abstract.VKeyGenesis VKey
key) -> (VKeyGenesis
vkg, VKey
key))
            (Set VKeyGenesis -> [VKeyGenesis]
forall a. Set a -> [a]
S.toList Set VKeyGenesis
Environment ADELEGS
env)
    , _dStateLastDelegation :: Map VKeyGenesis Slot
_dStateLastDelegation = (VKeyGenesis -> Slot) -> Set VKeyGenesis -> Map VKeyGenesis Slot
forall k a. (k -> a) -> Set k -> Map k a
M.fromSet (Slot -> VKeyGenesis -> Slot
forall a b. a -> b -> a
const (Word64 -> Slot
Abstract.Slot Word64
0)) Set VKeyGenesis
Environment ADELEGS
env
    }

createInitialDIState ::
  State ADELEGS ->
  State DELEG
createInitialDIState :: State ADELEGS -> State DELEG
createInitialDIState State ADELEGS
dState =
  DIState
    { _dIStateDelegationMap :: Bimap VKeyGenesis VKey
_dIStateDelegationMap = DState -> Bimap VKeyGenesis VKey
_dStateDelegationMap DState
State ADELEGS
dState
    , _dIStateLastDelegation :: Map VKeyGenesis Slot
_dIStateLastDelegation = DState -> Map VKeyGenesis Slot
_dStateLastDelegation DState
State ADELEGS
dState
    , _dIStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dIStateScheduledDelegations = []
    , _dIStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
_dIStateKeyEpochDelegations = Set (Epoch, VKeyGenesis)
forall a. Set a
S.empty
    }

modifyAHeader ::
  (AHeader ByteString -> AHeader ByteString) ->
  ABlock ByteString ->
  ABlock ByteString
modifyAHeader :: (AHeader ByteString -> AHeader ByteString)
-> ABlock ByteString -> ABlock ByteString
modifyAHeader AHeader ByteString -> AHeader ByteString
ahModifier ABlock ByteString
ab =
  ABlock ByteString
ab {blockHeader = ahModifier (blockHeader ab)}

modifyAProof ::
  (Annotated Proof ByteString -> Annotated Proof ByteString) ->
  ABlock ByteString ->
  ABlock ByteString
modifyAProof :: (Annotated Proof ByteString -> Annotated Proof ByteString)
-> ABlock ByteString -> ABlock ByteString
modifyAProof Annotated Proof ByteString -> Annotated Proof ByteString
apModifier ABlock ByteString
ab =
  (AHeader ByteString -> AHeader ByteString)
-> ABlock ByteString -> ABlock ByteString
modifyAHeader AHeader ByteString -> AHeader ByteString
ahModifier ABlock ByteString
ab
  where
    ahModifier :: AHeader ByteString -> AHeader ByteString
    ahModifier :: AHeader ByteString -> AHeader ByteString
ahModifier AHeader ByteString
ah = AHeader ByteString
ah {aHeaderProof = apModifier (aHeaderProof ah)}

modifyDelegationProof ::
  (Hash Delegation.Payload -> Hash Delegation.Payload) ->
  ABlock ByteString ->
  ABlock ByteString
modifyDelegationProof :: (Hash Payload -> Hash Payload)
-> ABlock ByteString -> ABlock ByteString
modifyDelegationProof Hash Payload -> Hash Payload
dpModifier ABlock ByteString
ab =
  (Annotated Proof ByteString -> Annotated Proof ByteString)
-> ABlock ByteString -> ABlock ByteString
modifyAProof Annotated Proof ByteString -> Annotated Proof ByteString
apModifier ABlock ByteString
ab
  where
    apModifier :: Annotated Proof ByteString -> Annotated Proof ByteString
    apModifier :: Annotated Proof ByteString -> Annotated Proof ByteString
apModifier (Annotated Proof
p ByteString
bs) =
      Proof -> ByteString -> Annotated Proof ByteString
forall b a. b -> a -> Annotated b a
Annotated
        Proof
p {proofDelegation = dpModifier (proofDelegation p)}
        ByteString
bs

modifyTxProof ::
  (TxProof -> TxProof) ->
  ABlock ByteString ->
  ABlock ByteString
modifyTxProof :: (TxProof -> TxProof) -> ABlock ByteString -> ABlock ByteString
modifyTxProof TxProof -> TxProof
tpModifier ABlock ByteString
ab =
  (Annotated Proof ByteString -> Annotated Proof ByteString)
-> ABlock ByteString -> ABlock ByteString
modifyAProof Annotated Proof ByteString -> Annotated Proof ByteString
apModifier ABlock ByteString
ab
  where
    apModifier :: Annotated Proof ByteString -> Annotated Proof ByteString
    apModifier :: Annotated Proof ByteString -> Annotated Proof ByteString
apModifier (Annotated Proof
p ByteString
bs) =
      Proof -> ByteString -> Annotated Proof ByteString
forall b a. b -> a -> Annotated b a
Annotated
        Proof
p {proofUTxO = tpModifier (proofUTxO p)}
        ByteString
bs

invalidateABlockProof ::
  ABlock ByteString ->
  Gen (ABlock ByteString)
invalidateABlockProof :: ABlock ByteString -> Gen (ABlock ByteString)
invalidateABlockProof ABlock ByteString
ab =
  -- 'Gen.filter' to ensure we don't generate a valid proof
  (ABlock ByteString -> Bool)
-> Gen (ABlock ByteString) -> Gen (ABlock ByteString)
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (\ABlock ByteString
x -> ABlock ByteString -> Proof
forall a. ABlock a -> Proof
blockProof ABlock ByteString
x Proof -> Proof -> Bool
forall a. Eq a => a -> a -> Bool
/= ABlock ByteString -> Proof
forall a. ABlock a -> Proof
blockProof ABlock ByteString
ab) (Gen (ABlock ByteString) -> Gen (ABlock ByteString))
-> Gen (ABlock ByteString) -> Gen (ABlock ByteString)
forall a b. (a -> b) -> a -> b
$ do
    txProof <-
      [GenT Identity TxProof] -> GenT Identity TxProof
forall (m :: * -> *) a. (HasCallStack, MonadGen m) => [m a] -> m a
Gen.choice
        [ TxProof -> GenT Identity TxProof
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxProof -> GenT Identity TxProof)
-> TxProof -> GenT Identity TxProof
forall a b. (a -> b) -> a -> b
$ (Proof -> TxProof
proofUTxO (Proof -> TxProof)
-> (ABlock ByteString -> Proof) -> ABlock ByteString -> TxProof
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ABlock ByteString -> Proof
forall a. ABlock a -> Proof
blockProof) ABlock ByteString
ab
        , (ProtocolMagicId -> GenT Identity TxProof) -> GenT Identity TxProof
forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> GenT Identity TxProof
genTxProof
        ]
    dlgProof <-
      Gen.choice
        [ pure $ (proofDelegation . blockProof) ab
        , genAbstractHash (feedPM Delegation.genPayload)
        ]
    updProof <-
      Gen.choice
        [ pure $ proofUpdate (blockProof ab)
        , feedPM Update.genProof
        ]
    pure
      $ modifyAProof
        ( \(Annotated Proof
p ByteString
bs) ->
            Proof -> ByteString -> Annotated Proof ByteString
forall b a. b -> a -> Annotated b a
Annotated
              ( Proof
p
                  { proofUTxO = txProof
                  , proofDelegation = dlgProof
                  , proofUpdate = updProof
                  }
              )
              ByteString
bs
        )
        ab

--------------------------------------------------------------------------------
-- Main Test Export
--------------------------------------------------------------------------------

tests :: TSGroup
tests :: TSGroup
tests = $$discoverPropArg