{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Test.Cardano.Chain.Block.CBOR (
  tests,
  exampleBlockSignature,
  exampleBody,
  exampleHeader,
  exampleProof,
  exampleToSign,
)
where

import Cardano.Chain.Block (
  ABlockSignature (..),
  ABoundaryBlock (boundaryBlockLength),
  Block,
  BlockSignature,
  Body,
  Header,
  HeaderHash,
  Proof (..),
  ToSign (..),
  decCBORABOBBlock,
  decCBORABoundaryBlock,
  decCBORABoundaryHeader,
  decCBORBoundaryConsensusData,
  decCBORHeader,
  decCBORHeaderToHash,
  dropBoundaryBody,
  encCBORABOBBlock,
  encCBORABoundaryBlock,
  encCBORHeader,
  encCBORHeaderToHash,
  mkHeaderExplicit,
  pattern Body,
 )
import qualified Cardano.Chain.Delegation as Delegation
import Cardano.Chain.Slotting (
  EpochNumber (..),
  EpochSlots (EpochSlots),
  WithEpochSlots (WithEpochSlots),
  unWithEpochSlots,
 )
import Cardano.Chain.Ssc (SscPayload (..), SscProof (..))
import Cardano.Crypto (
  ProtocolMagicId (..),
  SignTag (..),
  abstractHash,
  noPassSafeSigner,
  serializeCborHash,
  sign,
  toVerification,
 )
import Cardano.Ledger.Binary (byronProtVer, decodeFullDecoder, dropBytes, serialize)
import Cardano.Prelude
import Data.Coerce (coerce)
import Data.Maybe (fromJust)
import GetDataFileName ((<:<))
import Hedgehog (Property)
import qualified Hedgehog as H
import Test.Cardano.Chain.Block.Gen
import Test.Cardano.Chain.Common.Example (exampleChainDifficulty)
import Test.Cardano.Chain.Delegation.Example (exampleCertificates)
import Test.Cardano.Chain.Slotting.Example (exampleEpochAndSlotCount, exampleSlotNumber)
import Test.Cardano.Chain.Slotting.Gen (feedPMEpochSlots, genWithEpochSlots)
import Test.Cardano.Chain.UTxO.Example (exampleTxPayload, exampleTxProof)
import qualified Test.Cardano.Chain.Update.Example as Update
import Test.Cardano.Crypto.Example (exampleSigningKeys)
import Test.Cardano.Crypto.Gen (feedPM)
import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (
  deprecatedGoldenDecode,
  goldenTestCBOR,
  goldenTestCBORExplicit,
  roundTripsCBORBuildable,
  roundTripsCBORShow,
 )
import Test.Cardano.Prelude
import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS)

--------------------------------------------------------------------------------
-- Header
--------------------------------------------------------------------------------

-- | Number of slots-per-epoch to be used throughout the examples in this
-- module.
exampleEs :: EpochSlots
exampleEs :: EpochSlots
exampleEs = Word64 -> EpochSlots
EpochSlots Word64
50

goldenHeader :: Property
goldenHeader :: Property
goldenHeader =
  forall a.
(Eq a, Show a, HasCallStack) =>
Text
-> (a -> Encoding)
-> (forall s. Decoder s a)
-> a
-> FilePath
-> Property
goldenTestCBORExplicit
    Text
"Header"
    (EpochSlots -> Header -> Encoding
encCBORHeader EpochSlots
exampleEs)
    (forall s. EpochSlots -> Decoder s Header
decCBORHeader EpochSlots
exampleEs)
    Header
exampleHeader
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/Header"

-- | Round-trip test the backwards compatible header encoding/decoding functions
ts_roundTripHeaderCompat :: TSProperty
ts_roundTripHeaderCompat :: TSProperty
ts_roundTripHeaderCompat =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS
    TestLimit
300
    (forall a. (ProtocolMagicId -> EpochSlots -> Gen a) -> Gen a
feedPMEpochSlots forall a b. (a -> b) -> a -> b
$ forall a.
(ProtocolMagicId -> EpochSlots -> Gen a)
-> ProtocolMagicId -> EpochSlots -> Gen (WithEpochSlots a)
genWithEpochSlots ProtocolMagicId -> EpochSlots -> Gen Header
genHeader)
    WithEpochSlots Header -> PropertyT IO ()
roundTripsHeaderCompat
  where
    roundTripsHeaderCompat :: WithEpochSlots Header -> H.PropertyT IO ()
    roundTripsHeaderCompat :: WithEpochSlots Header -> PropertyT IO ()
roundTripsHeaderCompat esh :: WithEpochSlots Header
esh@(WithEpochSlots EpochSlots
es Header
_) =
      forall (f :: * -> *) a b (m :: * -> *).
(HasCallStack, Buildable (f a), Eq (f a), Show b, Applicative f,
 MonadTest m) =>
a -> (a -> b) -> (b -> f a) -> m ()
trippingBuildable
        WithEpochSlots Header
esh
        (forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EpochSlots -> Header -> Encoding
encCBORHeaderToHash EpochSlots
es forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. WithEpochSlots a -> a
unWithEpochSlots)
        ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. EpochSlots -> a -> WithEpochSlots a
WithEpochSlots EpochSlots
es forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. HasCallStack => Maybe a -> a
fromJust)
            forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
byronProtVer Text
"Header" (forall s. EpochSlots -> Decoder s (Maybe Header)
decCBORHeaderToHash EpochSlots
es)
        )

--------------------------------------------------------------------------------
-- Block
--------------------------------------------------------------------------------

-- | Round-trip test the backwards compatible block encoding/decoding functions
ts_roundTripBlockCompat :: TSProperty
ts_roundTripBlockCompat :: TSProperty
ts_roundTripBlockCompat =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS
    TestLimit
300
    (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen (WithEpochSlots Block)
genBlockWithEpochSlots)
    WithEpochSlots Block -> PropertyT IO ()
roundTripsBlockCompat
  where
    roundTripsBlockCompat :: WithEpochSlots Block -> H.PropertyT IO ()
    roundTripsBlockCompat :: WithEpochSlots Block -> PropertyT IO ()
roundTripsBlockCompat esb :: WithEpochSlots Block
esb@(WithEpochSlots EpochSlots
es Block
_) =
      forall (f :: * -> *) a b (m :: * -> *).
(HasCallStack, Buildable (f a), Eq (f a), Show b, Applicative f,
 MonadTest m) =>
a -> (a -> b) -> (b -> f a) -> m ()
trippingBuildable
        WithEpochSlots Block
esb
        (forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. EpochSlots -> ABlock a -> Encoding
encCBORABOBBlock EpochSlots
es forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. WithEpochSlots a -> a
unWithEpochSlots)
        ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. EpochSlots -> a -> WithEpochSlots a
WithEpochSlots EpochSlots
es forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. HasCallStack => Maybe a -> a
fromJust)
            forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
byronProtVer Text
"Block" (forall s. EpochSlots -> Decoder s (Maybe Block)
decCBORABOBBlock EpochSlots
es)
        )

--------------------------------------------------------------------------------
-- BlockSignature
--------------------------------------------------------------------------------

goldenBlockSignature :: Property
goldenBlockSignature :: Property
goldenBlockSignature =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR BlockSignature
exampleBlockSignature (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/BlockSignature"

ts_roundTripBlockSignatureCBOR :: TSProperty
ts_roundTripBlockSignatureCBOR :: TSProperty
ts_roundTripBlockSignatureCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
300 (forall a. (ProtocolMagicId -> EpochSlots -> Gen a) -> Gen a
feedPMEpochSlots ProtocolMagicId -> EpochSlots -> Gen BlockSignature
genBlockSignature) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- BoundaryBlockHeader
--------------------------------------------------------------------------------

goldenDeprecatedBoundaryBlockHeader :: Property
goldenDeprecatedBoundaryBlockHeader :: Property
goldenDeprecatedBoundaryBlockHeader =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"BoundaryBlockHeader"
    (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall s. Decoder s (ABoundaryHeader ByteSpan)
decCBORABoundaryHeader)
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/BoundaryBlockHeader"

ts_roundTripBoundaryBlock :: TSProperty
ts_roundTripBoundaryBlock :: TSProperty
ts_roundTripBoundaryBlock =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS
    TestLimit
300
    (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen (ProtocolMagicId, ABoundaryBlock ())
genBVDWithPM)
    (ProtocolMagicId, ABoundaryBlock ()) -> PropertyT IO ()
roundTripsBVD
  where
    -- We ignore the size of the BVD here, since calculating it is annoying.
    roundTripsBVD :: (ProtocolMagicId, ABoundaryBlock ()) -> H.PropertyT IO ()
    roundTripsBVD :: (ProtocolMagicId, ABoundaryBlock ()) -> PropertyT IO ()
roundTripsBVD (ProtocolMagicId
pm, ABoundaryBlock ()
bvd) =
      forall (f :: * -> *) a b (m :: * -> *).
(HasCallStack, Buildable (f a), Eq (f a), Show b, Applicative f,
 MonadTest m) =>
a -> (a -> b) -> (b -> f a) -> m ()
trippingBuildable
        ABoundaryBlock ()
bvd
        (forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ProtocolMagicId -> ABoundaryBlock a -> Encoding
encCBORABoundaryBlock ProtocolMagicId
pm)
        ( forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. ABoundaryBlock a -> ABoundaryBlock a
dropSize forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const ()))
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Version
-> Text
-> (forall s. Decoder s a)
-> ByteString
-> Either DecoderError a
decodeFullDecoder Version
byronProtVer Text
"BoundaryBlock" forall s. Decoder s (ABoundaryBlock ByteSpan)
decCBORABoundaryBlock
        )

    genBVDWithPM :: ProtocolMagicId -> H.Gen (ProtocolMagicId, ABoundaryBlock ())
    genBVDWithPM :: ProtocolMagicId -> Gen (ProtocolMagicId, ABoundaryBlock ())
genBVDWithPM ProtocolMagicId
pm = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure ProtocolMagicId
pm forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (ABoundaryBlock ())
genBoundaryBlock

    dropSize :: ABoundaryBlock a -> ABoundaryBlock a
    dropSize :: forall a. ABoundaryBlock a -> ABoundaryBlock a
dropSize ABoundaryBlock a
bvd = ABoundaryBlock a
bvd {boundaryBlockLength :: Int64
boundaryBlockLength = Int64
0}

--------------------------------------------------------------------------------
-- BoundaryBody
--------------------------------------------------------------------------------

goldenDeprecatedBoundaryBody :: Property
goldenDeprecatedBoundaryBody :: Property
goldenDeprecatedBoundaryBody =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"BoundaryBody"
    forall s. Decoder s ()
dropBoundaryBody
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/BoundaryBody"

--------------------------------------------------------------------------------
-- BoundaryConsensusData
--------------------------------------------------------------------------------

goldenDeprecatedBoundaryConsensusData :: Property
goldenDeprecatedBoundaryConsensusData :: Property
goldenDeprecatedBoundaryConsensusData =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"BoundaryConsensusData"
    (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall s. Decoder s (Word64, ChainDifficulty)
decCBORBoundaryConsensusData)
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/BoundaryConsensusData"

--------------------------------------------------------------------------------
-- HeaderHash
--------------------------------------------------------------------------------

goldenHeaderHash :: Property
goldenHeaderHash :: Property
goldenHeaderHash =
  forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR HeaderHash
exampleHeaderHash (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/HeaderHash"

ts_roundTripHeaderHashCBOR :: TSProperty
ts_roundTripHeaderHashCBOR :: TSProperty
ts_roundTripHeaderHashCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
1000 Gen HeaderHash
genHeaderHash forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- BoundaryProof
--------------------------------------------------------------------------------

goldenDeprecatedBoundaryProof :: Property
goldenDeprecatedBoundaryProof :: Property
goldenDeprecatedBoundaryProof =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"BoundaryProof"
    forall s. Decoder s ()
dropBytes
    (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/BoundaryProof"

--------------------------------------------------------------------------------
-- Body
--------------------------------------------------------------------------------

goldenBody :: Property
goldenBody :: Property
goldenBody = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Body
exampleBody (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/Body"

ts_roundTripBodyCBOR :: TSProperty
ts_roundTripBodyCBOR :: TSProperty
ts_roundTripBodyCBOR = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Body
genBody) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- Proof
--------------------------------------------------------------------------------

goldenProof :: Property
goldenProof :: Property
goldenProof = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Proof
exampleProof (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/Proof"

ts_roundTripProofCBOR :: TSProperty
ts_roundTripProofCBOR :: TSProperty
ts_roundTripProofCBOR = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM ProtocolMagicId -> Gen Proof
genProof) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- ToSign
--------------------------------------------------------------------------------

goldenToSign :: Property
goldenToSign :: Property
goldenToSign = forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR ToSign
exampleToSign (FilePath -> Property) -> FilePath -> Property
<:< FilePath
"golden/cbor/block/ToSign"

ts_roundTripToSignCBOR :: TSProperty
ts_roundTripToSignCBOR :: TSProperty
ts_roundTripToSignCBOR =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> TSProperty
eachOfTS TestLimit
20 (forall a. (ProtocolMagicId -> EpochSlots -> Gen a) -> Gen a
feedPMEpochSlots ProtocolMagicId -> EpochSlots -> Gen ToSign
genToSign) forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- Example golden datatypes
--------------------------------------------------------------------------------

exampleHeader :: Header
exampleHeader :: Header
exampleHeader =
  ProtocolMagicId
-> HeaderHash
-> ChainDifficulty
-> EpochSlots
-> SlotNumber
-> SigningKey
-> Certificate
-> Body
-> ProtocolVersion
-> SoftwareVersion
-> Header
mkHeaderExplicit
    (Word32 -> ProtocolMagicId
ProtocolMagicId Word32
7)
    HeaderHash
exampleHeaderHash
    ChainDifficulty
exampleChainDifficulty
    EpochSlots
exampleEs
    (EpochSlots -> SlotNumber
exampleSlotNumber EpochSlots
exampleEs)
    SigningKey
delegateSk
    Certificate
certificate
    Body
exampleBody
    ProtocolVersion
Update.exampleProtocolVersion
    SoftwareVersion
Update.exampleSoftwareVersion
  where
    pm :: ProtocolMagicId
pm = Word32 -> ProtocolMagicId
ProtocolMagicId Word32
7
    [SigningKey
delegateSk, SigningKey
issuerSk] = Int -> Int -> [SigningKey]
exampleSigningKeys Int
5 Int
2
    certificate :: Certificate
certificate =
      ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
Delegation.signCertificate
        ProtocolMagicId
pm
        (SigningKey -> VerificationKey
toVerification SigningKey
delegateSk)
        (Word64 -> EpochNumber
EpochNumber Word64
5)
        (SigningKey -> SafeSigner
noPassSafeSigner SigningKey
issuerSk)

exampleBlockSignature :: BlockSignature
exampleBlockSignature :: BlockSignature
exampleBlockSignature = forall a. ACertificate a -> Signature ToSign -> ABlockSignature a
ABlockSignature Certificate
cert Signature ToSign
sig
  where
    cert :: Certificate
cert =
      ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
Delegation.signCertificate
        ProtocolMagicId
pm
        (SigningKey -> VerificationKey
toVerification SigningKey
delegateSK)
        (Word64 -> EpochNumber
EpochNumber Word64
5)
        (SigningKey -> SafeSigner
noPassSafeSigner SigningKey
issuerSK)

    sig :: Signature ToSign
sig = forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign ProtocolMagicId
pm (VerificationKey -> SignTag
SignBlock (SigningKey -> VerificationKey
toVerification SigningKey
issuerSK)) SigningKey
delegateSK ToSign
exampleToSign

    [SigningKey
delegateSK, SigningKey
issuerSK] = Int -> Int -> [SigningKey]
exampleSigningKeys Int
5 Int
2
    pm :: ProtocolMagicId
pm = Word32 -> ProtocolMagicId
ProtocolMagicId Word32
7

exampleProof :: Proof
exampleProof :: Proof
exampleProof =
  TxProof -> SscProof -> Hash Payload -> Proof -> Proof
Proof
    TxProof
exampleTxProof
    SscProof
SscProof
    (forall algo a.
(HashAlgorithm algo, EncCBOR a) =>
a -> AbstractHash algo a
abstractHash Payload
dp)
    Proof
Update.exampleProof
  where
    dp :: Payload
dp = [Certificate] -> Payload
Delegation.unsafePayload (forall a. Int -> [a] -> [a]
take Int
4 [Certificate]
exampleCertificates)

exampleHeaderHash :: HeaderHash
exampleHeaderHash :: HeaderHash
exampleHeaderHash = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall a. EncCBOR a => a -> Hash a
serializeCborHash (Text
"HeaderHash" :: Text)

exampleBody :: Body
exampleBody :: Body
exampleBody = TxPayload -> SscPayload -> Payload -> Payload -> Body
Body TxPayload
exampleTxPayload SscPayload
SscPayload Payload
dp Payload
Update.examplePayload
  where
    dp :: Payload
dp = [Certificate] -> Payload
Delegation.unsafePayload (forall a. Int -> [a] -> [a]
take Int
4 [Certificate]
exampleCertificates)

exampleToSign :: ToSign
exampleToSign :: ToSign
exampleToSign =
  HeaderHash
-> Proof
-> EpochAndSlotCount
-> ChainDifficulty
-> ProtocolVersion
-> SoftwareVersion
-> ToSign
ToSign
    HeaderHash
exampleHeaderHash
    Proof
exampleProof
    EpochAndSlotCount
exampleEpochAndSlotCount
    ChainDifficulty
exampleChainDifficulty
    ProtocolVersion
Update.exampleProtocolVersion
    SoftwareVersion
Update.exampleSoftwareVersion

-----------------------------------------------------------------------
-- Main test export
-----------------------------------------------------------------------

tests :: TSGroup
tests :: TSGroup
tests = [TSGroup] -> TSGroup
concatTSGroups [forall a b. a -> b -> a
const $$FilePath
[(PropertyName, Property)]
Property
FilePath -> PropertyName
FilePath -> GroupName
GroupName -> [(PropertyName, Property)] -> Group
goldenToSign :: Property
goldenProof :: Property
goldenBody :: Property
goldenDeprecatedBoundaryProof :: Property
goldenHeaderHash :: Property
goldenDeprecatedBoundaryConsensusData :: Property
goldenDeprecatedBoundaryBody :: Property
goldenDeprecatedBoundaryBlockHeader :: Property
goldenBlockSignature :: Property
goldenHeader :: Property
discoverGolden, $$discoverRoundTripArg]