{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

-- | The purpose of these tests are to ensure that when in the Byron era, nodes
--  using @CardanoBlock@ can still communicate with older nodes using
--  @ByronBlock@. This is tested by running roundtrip tests using the encoders
--  of @ByronBlock@ and the decoders of @CardanoBlock@ and vice versa. By
--  introducing a newtype wrapper for each direction, we are able to reuse the
--  existing roundtrip test functions.
module Test.Consensus.Cardano.ByronCompatibility (tests) where

import qualified Cardano.Chain.Byron.API as CC
import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding)
import qualified Data.ByteString.Lazy as Lazy
import           Data.Coerce (Coercible, coerce)
import           Data.SOP.BasicFunctors
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Byron.Ledger
import           Ouroboros.Consensus.Byron.Node ()
import           Ouroboros.Consensus.Cardano.Block
import           Ouroboros.Consensus.Cardano.Node
import           Ouroboros.Consensus.HardFork.Combinator (NestedCtxt_ (..))
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Node.NetworkProtocolVersion
import           Ouroboros.Consensus.Node.Run
import           Ouroboros.Consensus.Node.Serialisation
import           Ouroboros.Consensus.Shelley.Ledger.Config (CodecConfig (..))
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Network.Block (Serialised (..))
import           Test.Consensus.Byron.Generators ()
import           Test.Consensus.Cardano.Generators (epochSlots)
import           Test.Consensus.Cardano.MockCrypto (MockCryptoCompatByron)
import           Test.QuickCheck
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.Util.Orphans.Arbitrary ()
import           Test.Util.Serialisation.Roundtrip
import           Test.Util.Serialisation.SomeResult (SomeResult (..))
import           Test.Util.TestEnv (adjustQuickCheckTests)

tests :: TestTree
tests :: TestTree
tests =
  -- | We're not trying to find edge cases in the roundtrip tests, we just
  -- want to check compatibility. In case of incompatibility, the first test
  -- will probably fail already.
  (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
    TestName -> [TestTree] -> TestTree
testGroup TestName
"Byron compatibility" [
        TestName -> [TestTree] -> TestTree
testGroup TestName
"Byron to Cardano" [
              TestName -> (ByronToCardano -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtrip block" ((ByronToCardano -> Property) -> TestTree)
-> (ByronToCardano -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                forall a.
(Eq a, Show a) =>
(a -> Encoding)
-> (forall s. Decoder s (ByteString -> a)) -> a -> Property
roundtrip' @ByronToCardano
                  (CodecConfig ByronToCardano -> ByronToCardano -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig ByronToCardano
byronToCardanoCodeConfig)
                  (CodecConfig ByronToCardano
-> forall s. Decoder s (ByteString -> ByronToCardano)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig ByronToCardano
byronToCardanoCodeConfig)
            , TestName -> [TestTree] -> TestTree
testGroup TestName
"SerialiseNodeToNode" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
                CodecConfig ByronToCardano -> [TestTree]
forall blk.
(SerialiseNodeToNodeConstraints blk,
 Show (BlockNodeToNodeVersion blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) blk,
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (Header blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (GenTx blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (GenTxId blk),
 EncodeDisk blk blk, DecodeDisk blk (ByteString -> blk),
 HasNestedContent Header blk, EncodeDiskDep (NestedCtxt Header) blk,
 DecodeDiskDep (NestedCtxt Header) blk) =>
CodecConfig blk -> [TestTree]
roundtrip_SerialiseNodeToNode   CodecConfig ByronToCardano
byronToCardanoCodeConfig
            , TestName -> [TestTree] -> TestTree
testGroup TestName
"SerialiseNodeToClient" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
                (TestName -> ShouldCheckCBORValidity)
-> CodecConfig ByronToCardano -> [TestTree]
forall blk.
(SerialiseNodeToClientConstraints blk,
 Show (BlockNodeToClientVersion blk),
 ArbitraryWithVersion (BlockNodeToClientVersion blk) blk,
 ArbitraryWithVersion (BlockNodeToClientVersion blk) (GenTx blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (ApplyTxErr blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (SomeSecond BlockQuery blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (SomeResult blk),
 ArbitraryWithVersion
   (QueryVersion, BlockNodeToClientVersion blk)
   (SomeSecond Query blk),
 EncodeDisk blk blk, DecodeDisk blk (ByteString -> blk)) =>
(TestName -> ShouldCheckCBORValidity)
-> CodecConfig blk -> [TestTree]
roundtrip_SerialiseNodeToClient (ShouldCheckCBORValidity -> TestName -> ShouldCheckCBORValidity
forall a b. a -> b -> a
const ShouldCheckCBORValidity
CheckCBORValidity) CodecConfig ByronToCardano
byronToCardanoCodeConfig
            ]
      , TestName -> [TestTree] -> TestTree
testGroup TestName
"Cardano to Byron" [
              TestName -> (CardanoToByron -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"roundtrip block" ((CardanoToByron -> Property) -> TestTree)
-> (CardanoToByron -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$
                forall a.
(Eq a, Show a) =>
(a -> Encoding)
-> (forall s. Decoder s (ByteString -> a)) -> a -> Property
roundtrip' @CardanoToByron
                  (CodecConfig CardanoToByron -> CardanoToByron -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig CardanoToByron
cardanoToByronCodeConfig)
                  (CodecConfig CardanoToByron
-> forall s. Decoder s (ByteString -> CardanoToByron)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig CardanoToByron
cardanoToByronCodeConfig)
            , TestName -> [TestTree] -> TestTree
testGroup TestName
"SerialiseNodeToNode" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
                CodecConfig CardanoToByron -> [TestTree]
forall blk.
(SerialiseNodeToNodeConstraints blk,
 Show (BlockNodeToNodeVersion blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) blk,
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (Header blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (GenTx blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (GenTxId blk),
 EncodeDisk blk blk, DecodeDisk blk (ByteString -> blk),
 HasNestedContent Header blk, EncodeDiskDep (NestedCtxt Header) blk,
 DecodeDiskDep (NestedCtxt Header) blk) =>
CodecConfig blk -> [TestTree]
roundtrip_SerialiseNodeToNode   CodecConfig CardanoToByron
cardanoToByronCodeConfig
            , TestName -> [TestTree] -> TestTree
testGroup TestName
"SerialiseNodeToClient" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
                (TestName -> ShouldCheckCBORValidity)
-> CodecConfig CardanoToByron -> [TestTree]
forall blk.
(SerialiseNodeToClientConstraints blk,
 Show (BlockNodeToClientVersion blk),
 ArbitraryWithVersion (BlockNodeToClientVersion blk) blk,
 ArbitraryWithVersion (BlockNodeToClientVersion blk) (GenTx blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (ApplyTxErr blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (SomeSecond BlockQuery blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (SomeResult blk),
 ArbitraryWithVersion
   (QueryVersion, BlockNodeToClientVersion blk)
   (SomeSecond Query blk),
 EncodeDisk blk blk, DecodeDisk blk (ByteString -> blk)) =>
(TestName -> ShouldCheckCBORValidity)
-> CodecConfig blk -> [TestTree]
roundtrip_SerialiseNodeToClient (ShouldCheckCBORValidity -> TestName -> ShouldCheckCBORValidity
forall a b. a -> b -> a
const ShouldCheckCBORValidity
CheckCBORValidity) CodecConfig CardanoToByron
cardanoToByronCodeConfig
            ]
      ]

byronCodecConfig :: CodecConfig ByronBlock
byronCodecConfig :: CodecConfig ByronBlock
byronCodecConfig = EpochSlots -> CodecConfig ByronBlock
ByronCodecConfig EpochSlots
epochSlots

byronToCardanoCodeConfig :: CodecConfig ByronToCardano
byronToCardanoCodeConfig :: CodecConfig ByronToCardano
byronToCardanoCodeConfig = CodecConfig ByronBlock -> CodecConfig ByronToCardano
CodecConfigB2C CodecConfig ByronBlock
byronCodecConfig

cardanoToByronCodeConfig :: CodecConfig CardanoToByron
cardanoToByronCodeConfig :: CodecConfig CardanoToByron
cardanoToByronCodeConfig = CodecConfig ByronBlock -> CodecConfig CardanoToByron
CodecConfigC2B CodecConfig ByronBlock
byronCodecConfig

{------------------------------------------------------------------------------
  Common setup
------------------------------------------------------------------------------}

-- | We don't use Shelley at all in this module, so we just pick some crypto
-- and use that everywhere.
type Crypto = MockCryptoCompatByron

byronNodeToNodeVersion :: BlockNodeToNodeVersion ByronBlock
byronNodeToNodeVersion :: BlockNodeToNodeVersion ByronBlock
byronNodeToNodeVersion = BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
ByronNodeToNodeVersion1

byronNodeToClientVersion :: BlockNodeToClientVersion ByronBlock
byronNodeToClientVersion :: BlockNodeToClientVersion ByronBlock
byronNodeToClientVersion = BlockNodeToClientVersion ByronBlock
ByronNodeToClientVersion
ByronNodeToClientVersion1

cardanoNodeToNodeVersion :: BlockNodeToNodeVersion (CardanoBlock Crypto)
cardanoNodeToNodeVersion :: BlockNodeToNodeVersion (CardanoBlock Crypto)
cardanoNodeToNodeVersion = BlockNodeToNodeVersion (CardanoBlock Crypto)
forall c. BlockNodeToNodeVersion (CardanoBlock c)
CardanoNodeToNodeVersion1

cardanoNodeToClientVersion :: BlockNodeToClientVersion (CardanoBlock Crypto)
cardanoNodeToClientVersion :: BlockNodeToClientVersion (CardanoBlock Crypto)
cardanoNodeToClientVersion = BlockNodeToClientVersion (CardanoBlock Crypto)
forall c. BlockNodeToClientVersion (CardanoBlock c)
CardanoNodeToClientVersion1

pb :: Proxy ByronBlock
pb :: Proxy ByronBlock
pb = Proxy ByronBlock
forall {k} (t :: k). Proxy t
Proxy

toCardanoCodecConfig ::
     CodecConfig ByronBlock
  -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig :: CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
codecConfigByron =
    CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
-> CodecConfig (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
-> CodecConfig (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
-> CodecConfig (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
-> CodecConfig (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
-> CodecConfig (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
-> CodecConfig (CardanoBlock Crypto)
forall c.
CodecConfig ByronBlock
-> CodecConfig (ShelleyBlock (TPraos c) (ShelleyEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (AllegraEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (MaryEra c))
-> CodecConfig (ShelleyBlock (TPraos c) (AlonzoEra c))
-> CodecConfig (ShelleyBlock (Praos c) (BabbageEra c))
-> CodecConfig (ShelleyBlock (Praos c) (ConwayEra c))
-> CardanoCodecConfig c
CardanoCodecConfig
      CodecConfig ByronBlock
codecConfigByron
      CodecConfig (ShelleyBlock (TPraos Crypto) (ShelleyEra Crypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
      CodecConfig (ShelleyBlock (TPraos Crypto) (AllegraEra Crypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
      CodecConfig (ShelleyBlock (TPraos Crypto) (MaryEra Crypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
      CodecConfig (ShelleyBlock (TPraos Crypto) (AlonzoEra Crypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
      CodecConfig (ShelleyBlock (Praos Crypto) (BabbageEra Crypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig
      CodecConfig (ShelleyBlock (Praos Crypto) (ConwayEra Crypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig

{------------------------------------------------------------------------------
  Byron to Cardano
------------------------------------------------------------------------------}

-- | Encoded Byron values can be decoded as Cardano values in the following
-- cases:
--
-- * The @HardForkNodeTo(Node|Client)Disabled@ version is used
-- * Blocks and headers stored on disk
--
-- Note that ledger state and all other types stored as part of the ledger
-- snapshot are __not__ forwards compatible.
newtype ByronToCardano                       = B2C        { ByronToCardano -> ByronBlock
unB2C        ::            ByronBlock   } deriving (ByronToCardano -> ByronToCardano -> Bool
(ByronToCardano -> ByronToCardano -> Bool)
-> (ByronToCardano -> ByronToCardano -> Bool) -> Eq ByronToCardano
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByronToCardano -> ByronToCardano -> Bool
== :: ByronToCardano -> ByronToCardano -> Bool
$c/= :: ByronToCardano -> ByronToCardano -> Bool
/= :: ByronToCardano -> ByronToCardano -> Bool
Eq, Int -> ByronToCardano -> ShowS
[ByronToCardano] -> ShowS
ByronToCardano -> TestName
(Int -> ByronToCardano -> ShowS)
-> (ByronToCardano -> TestName)
-> ([ByronToCardano] -> ShowS)
-> Show ByronToCardano
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronToCardano -> ShowS
showsPrec :: Int -> ByronToCardano -> ShowS
$cshow :: ByronToCardano -> TestName
show :: ByronToCardano -> TestName
$cshowList :: [ByronToCardano] -> ShowS
showList :: [ByronToCardano] -> ShowS
Show)
newtype instance Header ByronToCardano       = HeaderB2C  { Header ByronToCardano -> Header ByronBlock
unHeaderB2C  :: Header     ByronBlock   } deriving (Header ByronToCardano -> Header ByronToCardano -> Bool
(Header ByronToCardano -> Header ByronToCardano -> Bool)
-> (Header ByronToCardano -> Header ByronToCardano -> Bool)
-> Eq (Header ByronToCardano)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header ByronToCardano -> Header ByronToCardano -> Bool
== :: Header ByronToCardano -> Header ByronToCardano -> Bool
$c/= :: Header ByronToCardano -> Header ByronToCardano -> Bool
/= :: Header ByronToCardano -> Header ByronToCardano -> Bool
Eq, Int -> Header ByronToCardano -> ShowS
[Header ByronToCardano] -> ShowS
Header ByronToCardano -> TestName
(Int -> Header ByronToCardano -> ShowS)
-> (Header ByronToCardano -> TestName)
-> ([Header ByronToCardano] -> ShowS)
-> Show (Header ByronToCardano)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header ByronToCardano -> ShowS
showsPrec :: Int -> Header ByronToCardano -> ShowS
$cshow :: Header ByronToCardano -> TestName
show :: Header ByronToCardano -> TestName
$cshowList :: [Header ByronToCardano] -> ShowS
showList :: [Header ByronToCardano] -> ShowS
Show)
newtype instance GenTx ByronToCardano        = GenTxB2C   { GenTx ByronToCardano -> GenTx ByronBlock
unGenTxB2C   :: GenTx      ByronBlock   } deriving (GenTx ByronToCardano -> GenTx ByronToCardano -> Bool
(GenTx ByronToCardano -> GenTx ByronToCardano -> Bool)
-> (GenTx ByronToCardano -> GenTx ByronToCardano -> Bool)
-> Eq (GenTx ByronToCardano)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenTx ByronToCardano -> GenTx ByronToCardano -> Bool
== :: GenTx ByronToCardano -> GenTx ByronToCardano -> Bool
$c/= :: GenTx ByronToCardano -> GenTx ByronToCardano -> Bool
/= :: GenTx ByronToCardano -> GenTx ByronToCardano -> Bool
Eq, Int -> GenTx ByronToCardano -> ShowS
[GenTx ByronToCardano] -> ShowS
GenTx ByronToCardano -> TestName
(Int -> GenTx ByronToCardano -> ShowS)
-> (GenTx ByronToCardano -> TestName)
-> ([GenTx ByronToCardano] -> ShowS)
-> Show (GenTx ByronToCardano)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenTx ByronToCardano -> ShowS
showsPrec :: Int -> GenTx ByronToCardano -> ShowS
$cshow :: GenTx ByronToCardano -> TestName
show :: GenTx ByronToCardano -> TestName
$cshowList :: [GenTx ByronToCardano] -> ShowS
showList :: [GenTx ByronToCardano] -> ShowS
Show)
newtype instance TxId (GenTx ByronToCardano) = GenTxIdB2C { GenTxId ByronToCardano -> GenTxId ByronBlock
unGenTxIdB2C :: GenTxId    ByronBlock   } deriving (GenTxId ByronToCardano -> GenTxId ByronToCardano -> Bool
(GenTxId ByronToCardano -> GenTxId ByronToCardano -> Bool)
-> (GenTxId ByronToCardano -> GenTxId ByronToCardano -> Bool)
-> Eq (GenTxId ByronToCardano)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenTxId ByronToCardano -> GenTxId ByronToCardano -> Bool
== :: GenTxId ByronToCardano -> GenTxId ByronToCardano -> Bool
$c/= :: GenTxId ByronToCardano -> GenTxId ByronToCardano -> Bool
/= :: GenTxId ByronToCardano -> GenTxId ByronToCardano -> Bool
Eq, Int -> GenTxId ByronToCardano -> ShowS
[GenTxId ByronToCardano] -> ShowS
GenTxId ByronToCardano -> TestName
(Int -> GenTxId ByronToCardano -> ShowS)
-> (GenTxId ByronToCardano -> TestName)
-> ([GenTxId ByronToCardano] -> ShowS)
-> Show (GenTxId ByronToCardano)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenTxId ByronToCardano -> ShowS
showsPrec :: Int -> GenTxId ByronToCardano -> ShowS
$cshow :: GenTxId ByronToCardano -> TestName
show :: GenTxId ByronToCardano -> TestName
$cshowList :: [GenTxId ByronToCardano] -> ShowS
showList :: [GenTxId ByronToCardano] -> ShowS
Show)
newtype instance BlockQuery ByronToCardano a = QueryB2C   { forall a. BlockQuery ByronToCardano a -> BlockQuery ByronBlock a
unQueryB2C   :: BlockQuery ByronBlock a } deriving (BlockQuery ByronToCardano a -> BlockQuery ByronToCardano a -> Bool
(BlockQuery ByronToCardano a
 -> BlockQuery ByronToCardano a -> Bool)
-> (BlockQuery ByronToCardano a
    -> BlockQuery ByronToCardano a -> Bool)
-> Eq (BlockQuery ByronToCardano a)
forall a.
BlockQuery ByronToCardano a -> BlockQuery ByronToCardano a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
BlockQuery ByronToCardano a -> BlockQuery ByronToCardano a -> Bool
== :: BlockQuery ByronToCardano a -> BlockQuery ByronToCardano a -> Bool
$c/= :: forall a.
BlockQuery ByronToCardano a -> BlockQuery ByronToCardano a -> Bool
/= :: BlockQuery ByronToCardano a -> BlockQuery ByronToCardano a -> Bool
Eq, Int -> BlockQuery ByronToCardano a -> ShowS
[BlockQuery ByronToCardano a] -> ShowS
BlockQuery ByronToCardano a -> TestName
(Int -> BlockQuery ByronToCardano a -> ShowS)
-> (BlockQuery ByronToCardano a -> TestName)
-> ([BlockQuery ByronToCardano a] -> ShowS)
-> Show (BlockQuery ByronToCardano a)
forall a. Int -> BlockQuery ByronToCardano a -> ShowS
forall a. [BlockQuery ByronToCardano a] -> ShowS
forall a. BlockQuery ByronToCardano a -> TestName
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> BlockQuery ByronToCardano a -> ShowS
showsPrec :: Int -> BlockQuery ByronToCardano a -> ShowS
$cshow :: forall a. BlockQuery ByronToCardano a -> TestName
show :: BlockQuery ByronToCardano a -> TestName
$cshowList :: forall a. [BlockQuery ByronToCardano a] -> ShowS
showList :: [BlockQuery ByronToCardano a] -> ShowS
Show)

newtype instance NestedCtxt_ ByronToCardano f a where
  NestedCtxt_B2C :: NestedCtxt_ ByronBlock     f a
                 -> NestedCtxt_ ByronToCardano f a

deriving instance Show (NestedCtxt_ ByronToCardano Header a)

unNestedCtxt_B2C :: NestedCtxt_ ByronToCardano f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_B2C :: forall (f :: * -> *) a.
NestedCtxt_ ByronToCardano f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_B2C (NestedCtxt_B2C NestedCtxt_ ByronBlock f a
ctxt) = NestedCtxt_ ByronBlock f a
ctxt

type instance HeaderHash ByronToCardano = HeaderHash ByronBlock
type instance ApplyTxErr ByronToCardano = ApplyTxErr ByronBlock

instance HasNetworkProtocolVersion ByronToCardano

instance ConvertRawHash ByronToCardano where
  toShortRawHash :: forall (proxy :: * -> *).
proxy ByronToCardano
-> HeaderHash ByronToCardano -> ShortByteString
toShortRawHash   proxy ByronToCardano
_ = Proxy ByronBlock -> HeaderHash ByronBlock -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy ByronBlock -> HeaderHash ByronBlock -> ShortByteString
toShortRawHash   Proxy ByronBlock
pb
  fromShortRawHash :: forall (proxy :: * -> *).
proxy ByronToCardano
-> ShortByteString -> HeaderHash ByronToCardano
fromShortRawHash proxy ByronToCardano
_ = Proxy ByronBlock -> ShortByteString -> HeaderHash ByronBlock
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
forall (proxy :: * -> *).
proxy ByronBlock -> ShortByteString -> HeaderHash ByronBlock
fromShortRawHash Proxy ByronBlock
pb
  hashSize :: forall (proxy :: * -> *). proxy ByronToCardano -> Word32
hashSize         proxy ByronToCardano
_ = Proxy ByronBlock -> Word32
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> Word32
forall (proxy :: * -> *). proxy ByronBlock -> Word32
hashSize         Proxy ByronBlock
pb

data instance CodecConfig ByronToCardano = CodecConfigB2C (CodecConfig ByronBlock)

instance SameDepIndex (NestedCtxt_ ByronToCardano Header) where
  sameDepIndex :: forall a b.
NestedCtxt_ ByronToCardano Header a
-> NestedCtxt_ ByronToCardano Header b -> Maybe (a :~: b)
sameDepIndex (NestedCtxt_B2C NestedCtxt_ ByronBlock Header a
ctxt1) (NestedCtxt_B2C NestedCtxt_ ByronBlock Header b
ctxt2) =
      NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronBlock Header b -> Maybe (a :~: b)
forall a b.
NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronBlock Header b -> Maybe (a :~: b)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex NestedCtxt_ ByronBlock Header a
ctxt1 NestedCtxt_ ByronBlock Header b
ctxt2

instance HasNestedContent Header ByronToCardano where
  unnest :: Header ByronToCardano -> DepPair (NestedCtxt Header ByronToCardano)
unnest Header ByronToCardano
hdr = case Header ByronBlock -> DepPair (NestedCtxt Header ByronBlock)
forall (f :: * -> *) blk.
HasNestedContent f blk =>
f blk -> DepPair (NestedCtxt f blk)
unnest (Header ByronToCardano -> Header ByronBlock
unHeaderB2C Header ByronToCardano
hdr) of
      DepPair NestedCtxt Header ByronBlock a
ctxt a
a -> NestedCtxt Header ByronToCardano a
-> a -> DepPair (NestedCtxt Header ByronToCardano)
forall (f :: * -> *) a. f a -> a -> DepPair f
DepPair ((NestedCtxt_ ByronBlock Header a
 -> NestedCtxt_ ByronToCardano Header a)
-> NestedCtxt Header ByronBlock a
-> NestedCtxt Header ByronToCardano a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronToCardano Header a
forall (f :: * -> *) a.
NestedCtxt_ ByronBlock f a -> NestedCtxt_ ByronToCardano f a
NestedCtxt_B2C NestedCtxt Header ByronBlock a
ctxt) a
a
  nest :: DepPair (NestedCtxt Header ByronToCardano) -> Header ByronToCardano
nest (DepPair NestedCtxt Header ByronToCardano a
ctxt a
a) =
      Header ByronBlock -> Header ByronToCardano
HeaderB2C (Header ByronBlock -> Header ByronToCardano)
-> Header ByronBlock -> Header ByronToCardano
forall a b. (a -> b) -> a -> b
$ DepPair (NestedCtxt Header ByronBlock) -> Header ByronBlock
forall (f :: * -> *) blk.
HasNestedContent f blk =>
DepPair (NestedCtxt f blk) -> f blk
nest (NestedCtxt Header ByronBlock a
-> a -> DepPair (NestedCtxt Header ByronBlock)
forall (f :: * -> *) a. f a -> a -> DepPair f
DepPair ((NestedCtxt_ ByronToCardano Header a
 -> NestedCtxt_ ByronBlock Header a)
-> NestedCtxt Header ByronToCardano a
-> NestedCtxt Header ByronBlock a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ ByronToCardano Header a
-> NestedCtxt_ ByronBlock Header a
forall (f :: * -> *) a.
NestedCtxt_ ByronToCardano f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_B2C NestedCtxt Header ByronToCardano a
ctxt) a
a)

instance ShowQuery (BlockQuery ByronToCardano) where
  showResult :: forall result.
BlockQuery ByronToCardano result -> result -> TestName
showResult (QueryB2C BlockQuery ByronBlock result
query) = BlockQuery ByronBlock result -> result -> TestName
forall result. BlockQuery ByronBlock result -> result -> TestName
forall (query :: * -> *) result.
ShowQuery query =>
query result -> result -> TestName
showResult BlockQuery ByronBlock result
query

instance SameDepIndex (BlockQuery ByronToCardano) where
  sameDepIndex :: forall a b.
BlockQuery ByronToCardano a
-> BlockQuery ByronToCardano b -> Maybe (a :~: b)
sameDepIndex (QueryB2C BlockQuery ByronBlock a
q1) (QueryB2C BlockQuery ByronBlock b
q2) = BlockQuery ByronBlock a
-> BlockQuery ByronBlock b -> Maybe (a :~: b)
forall a b.
BlockQuery ByronBlock a
-> BlockQuery ByronBlock b -> Maybe (a :~: b)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex BlockQuery ByronBlock a
q1 BlockQuery ByronBlock b
q2

{------------------------------------------------------------------------------
  Byron to Cardano: Disk
------------------------------------------------------------------------------}

encodeDiskB2C ::
     forall f byron b2c.
     ( EncodeDisk ByronBlock (f ByronBlock)
     , Coercible byron (f ByronBlock)
     )
  => Proxy f
  -> (b2c -> byron)
  -> CodecConfig ByronToCardano
  -> b2c
  -> Encoding
encodeDiskB2C :: forall (f :: * -> *) byron b2c.
(EncodeDisk ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron) -> CodecConfig ByronToCardano -> b2c -> Encoding
encodeDiskB2C Proxy f
_ b2c -> byron
toByron (CodecConfigB2C CodecConfig ByronBlock
ccfg) b2c
x =
    CodecConfig ByronBlock -> f ByronBlock -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk CodecConfig ByronBlock
ccfg (b2c -> f ByronBlock
toByron' b2c
x)
  where
    toByron' :: b2c -> f ByronBlock
    toByron' :: b2c -> f ByronBlock
toByron' = byron -> f ByronBlock
forall a b. Coercible a b => a -> b
coerce (byron -> f ByronBlock) -> (b2c -> byron) -> b2c -> f ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b2c -> byron
toByron

decodeDiskB2C ::
     forall f cardano b2c.
     ( DecodeDisk (CardanoBlock Crypto) (f (CardanoBlock Crypto))
     , Coercible cardano (f (CardanoBlock Crypto))
     )
  => Proxy f
  -> (cardano -> b2c)
  -> CodecConfig ByronToCardano
  -> forall s. Decoder s b2c
decodeDiskB2C :: forall (f :: * -> *) cardano b2c.
(DecodeDisk (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> forall s. Decoder s b2c
decodeDiskB2C Proxy f
_ cardano -> b2c
fromCardano (CodecConfigB2C CodecConfig ByronBlock
ccfg) =
    f (CardanoBlock Crypto) -> b2c
fromCardano' (f (CardanoBlock Crypto) -> b2c)
-> Decoder s (f (CardanoBlock Crypto)) -> Decoder s b2c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig (CardanoBlock Crypto)
-> forall s. Decoder s (f (CardanoBlock Crypto))
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg)
  where
    fromCardano' :: f (CardanoBlock Crypto) -> b2c
    fromCardano' :: f (CardanoBlock Crypto) -> b2c
fromCardano' = cardano -> b2c
fromCardano (cardano -> b2c)
-> (f (CardanoBlock Crypto) -> cardano)
-> f (CardanoBlock Crypto)
-> b2c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (CardanoBlock Crypto) -> cardano
forall a b. Coercible a b => a -> b
coerce

instance EncodeDisk ByronToCardano ByronToCardano where
  encodeDisk :: CodecConfig ByronToCardano -> ByronToCardano -> Encoding
encodeDisk = Proxy I
-> (ByronToCardano -> ByronBlock)
-> CodecConfig ByronToCardano
-> ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(EncodeDisk ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron) -> CodecConfig ByronToCardano -> b2c -> Encoding
encodeDiskB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) ByronToCardano -> ByronBlock
unB2C

instance DecodeDisk ByronToCardano (Lazy.ByteString -> ByronToCardano) where
  decodeDisk :: CodecConfig ByronToCardano
-> forall s. Decoder s (ByteString -> ByronToCardano)
decodeDisk = Proxy ((->) ByteString)
-> ((ByteString -> CardanoBlock Crypto)
    -> ByteString -> ByronToCardano)
-> CodecConfig ByronToCardano
-> forall s. Decoder s (ByteString -> ByronToCardano)
forall (f :: * -> *) cardano b2c.
(DecodeDisk (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> forall s. Decoder s b2c
decodeDiskB2C
                 (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @((->) Lazy.ByteString))
                 ((CardanoBlock Crypto -> ByronToCardano)
-> (ByteString -> CardanoBlock Crypto)
-> ByteString
-> ByronToCardano
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(BlockByron ByronBlock
blk) -> ByronBlock -> ByronToCardano
B2C ByronBlock
blk))

instance EncodeDiskDep (NestedCtxt Header) ByronToCardano where
  encodeDiskDep :: forall a.
CodecConfig ByronToCardano
-> NestedCtxt Header ByronToCardano a -> a -> Encoding
encodeDiskDep (CodecConfigB2C CodecConfig ByronBlock
ccfg) =
      CodecConfig ByronBlock
-> NestedCtxt Header ByronBlock a -> a -> Encoding
forall a.
CodecConfig ByronBlock
-> NestedCtxt Header ByronBlock a -> a -> Encoding
forall (f :: * -> * -> *) blk a.
EncodeDiskDep f blk =>
CodecConfig blk -> f blk a -> a -> Encoding
encodeDiskDep CodecConfig ByronBlock
ccfg (NestedCtxt Header ByronBlock a -> a -> Encoding)
-> (NestedCtxt Header ByronToCardano a
    -> NestedCtxt Header ByronBlock a)
-> NestedCtxt Header ByronToCardano a
-> a
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NestedCtxt_ ByronToCardano Header a
 -> NestedCtxt_ ByronBlock Header a)
-> NestedCtxt Header ByronToCardano a
-> NestedCtxt Header ByronBlock a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ ByronToCardano Header a
-> NestedCtxt_ ByronBlock Header a
forall (f :: * -> *) a.
NestedCtxt_ ByronToCardano f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_B2C

instance DecodeDiskDep (NestedCtxt Header) ByronToCardano where
  decodeDiskDep :: forall a.
CodecConfig ByronToCardano
-> NestedCtxt Header ByronToCardano a
-> forall s. Decoder s (ByteString -> a)
decodeDiskDep (CodecConfigB2C CodecConfig ByronBlock
ccfg) =
      CodecConfig (CardanoBlock Crypto)
-> NestedCtxt Header (CardanoBlock Crypto) a
-> forall s. Decoder s (ByteString -> a)
forall a.
CodecConfig (CardanoBlock Crypto)
-> NestedCtxt Header (CardanoBlock Crypto) a
-> forall s. Decoder s (ByteString -> a)
forall (f :: * -> * -> *) blk a.
DecodeDiskDep f blk =>
CodecConfig blk -> f blk a -> forall s. Decoder s (ByteString -> a)
decodeDiskDep (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg) (NestedCtxt Header (CardanoBlock Crypto) a
 -> Decoder s (ByteString -> a))
-> (NestedCtxt Header ByronToCardano a
    -> NestedCtxt Header (CardanoBlock Crypto) a)
-> NestedCtxt Header ByronToCardano a
-> Decoder s (ByteString -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NestedCtxt_ ByronToCardano Header a
 -> NestedCtxt_ (CardanoBlock Crypto) Header a)
-> NestedCtxt Header ByronToCardano a
-> NestedCtxt Header (CardanoBlock Crypto) a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt (NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ (CardanoBlock Crypto) Header a
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ (NestedCtxt_ ByronBlock Header a
 -> NestedCtxt_ (CardanoBlock Crypto) Header a)
-> (NestedCtxt_ ByronToCardano Header a
    -> NestedCtxt_ ByronBlock Header a)
-> NestedCtxt_ ByronToCardano Header a
-> NestedCtxt_ (CardanoBlock Crypto) Header a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt_ ByronToCardano Header a
-> NestedCtxt_ ByronBlock Header a
forall (f :: * -> *) a.
NestedCtxt_ ByronToCardano f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_B2C)

{------------------------------------------------------------------------------
  Byron to Cardano: NodeToNode
------------------------------------------------------------------------------}

encodeNodeToNodeB2C ::
     forall f byron b2c.
     ( SerialiseNodeToNode ByronBlock (f ByronBlock)
     , Coercible byron (f ByronBlock)
     )
  => Proxy f
  -> (b2c -> byron)
  -> CodecConfig ByronToCardano
  -> BlockNodeToNodeVersion ByronToCardano
  -> b2c
  -> Encoding
encodeNodeToNodeB2C :: forall (f :: * -> *) byron b2c.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToNodeB2C Proxy f
_ b2c -> byron
toByron (CodecConfigB2C CodecConfig ByronBlock
ccfg) () b2c
x =
    CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock -> f ByronBlock -> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode CodecConfig ByronBlock
ccfg BlockNodeToNodeVersion ByronBlock
byronNodeToNodeVersion (b2c -> f ByronBlock
toByron' b2c
x)
  where
    toByron' :: b2c -> f ByronBlock
    toByron' :: b2c -> f ByronBlock
toByron' = byron -> f ByronBlock
forall a b. Coercible a b => a -> b
coerce (byron -> f ByronBlock) -> (b2c -> byron) -> b2c -> f ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b2c -> byron
toByron

decodeNodeToNodeB2C ::
     forall f cardano b2c.
     ( SerialiseNodeToNode (CardanoBlock Crypto) (f (CardanoBlock Crypto))
     , Coercible cardano (f (CardanoBlock Crypto))
     )
  => Proxy f
  -> (cardano -> b2c)
  -> CodecConfig ByronToCardano
  -> BlockNodeToNodeVersion ByronToCardano
  -> forall s. Decoder s b2c
decodeNodeToNodeB2C :: forall (f :: * -> *) cardano b2c.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToNodeB2C Proxy f
_ cardano -> b2c
fromCardano (CodecConfigB2C CodecConfig ByronBlock
ccfg) () =
    f (CardanoBlock Crypto) -> b2c
fromCardano' (f (CardanoBlock Crypto) -> b2c)
-> Decoder s (f (CardanoBlock Crypto)) -> Decoder s b2c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      CodecConfig (CardanoBlock Crypto)
-> BlockNodeToNodeVersion (CardanoBlock Crypto)
-> forall s. Decoder s (f (CardanoBlock Crypto))
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg) BlockNodeToNodeVersion (CardanoBlock Crypto)
cardanoNodeToNodeVersion
  where
    fromCardano' :: f (CardanoBlock Crypto) -> b2c
    fromCardano' :: f (CardanoBlock Crypto) -> b2c
fromCardano' = cardano -> b2c
fromCardano (cardano -> b2c)
-> (f (CardanoBlock Crypto) -> cardano)
-> f (CardanoBlock Crypto)
-> b2c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (CardanoBlock Crypto) -> cardano
forall a b. Coercible a b => a -> b
coerce

instance SerialiseNodeToNode ByronToCardano ByronToCardano where
  encodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> ByronToCardano
-> Encoding
encodeNodeToNode = Proxy I
-> (ByronToCardano -> ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) ByronToCardano -> ByronBlock
unB2C
  decodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s ByronToCardano
decodeNodeToNode = Proxy I
-> (CardanoBlock Crypto -> ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s ByronToCardano
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) (\(BlockByron ByronBlock
blk) -> ByronBlock -> ByronToCardano
B2C ByronBlock
blk)

instance SerialiseNodeToNode ByronToCardano (Serialised ByronToCardano) where
  encodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> Serialised ByronToCardano
-> Encoding
encodeNodeToNode = Proxy Serialised
-> (Serialised ByronToCardano -> Serialised ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> Serialised ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised) Serialised ByronToCardano -> Serialised ByronToCardano
forall a. a -> a
id
  decodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (Serialised ByronToCardano)
decodeNodeToNode = Proxy Serialised
-> (Serialised ByronToCardano -> Serialised ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (Serialised ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised) Serialised ByronToCardano -> Serialised ByronToCardano
forall a. a -> a
id

instance SerialiseNodeToNode ByronToCardano (SerialisedHeader ByronToCardano) where
  encodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> SerialisedHeader ByronToCardano
-> Encoding
encodeNodeToNode = Proxy SerialisedHeader
-> (SerialisedHeader ByronToCardano -> SerialisedHeader ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> SerialisedHeader ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToNodeB2C
                       (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @SerialisedHeader)
                       ((forall a.
 NestedCtxt_ ByronToCardano Header a
 -> NestedCtxt_ ByronBlock Header a)
-> SerialisedHeader ByronToCardano -> SerialisedHeader ByronBlock
forall blk blk'.
(forall a. NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a)
-> SerialisedHeader blk -> SerialisedHeader blk'
castSerialisedHeader NestedCtxt_ ByronToCardano Header a
-> NestedCtxt_ ByronBlock Header a
forall a.
NestedCtxt_ ByronToCardano Header a
-> NestedCtxt_ ByronBlock Header a
forall (f :: * -> *) a.
NestedCtxt_ ByronToCardano f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_B2C)
  decodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (SerialisedHeader ByronToCardano)
decodeNodeToNode = Proxy SerialisedHeader
-> (SerialisedHeader (CardanoBlock Crypto)
    -> SerialisedHeader ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (SerialisedHeader ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToNodeB2C
                       (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @SerialisedHeader)
                       ((forall a.
 NestedCtxt_ (CardanoBlock Crypto) Header a
 -> NestedCtxt_ ByronToCardano Header a)
-> SerialisedHeader (CardanoBlock Crypto)
-> SerialisedHeader ByronToCardano
forall blk blk'.
(forall a. NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a)
-> SerialisedHeader blk -> SerialisedHeader blk'
castSerialisedHeader (\(NCZ NestedCtxt_ x Header a
ctxt) -> NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronToCardano Header a
forall (f :: * -> *) a.
NestedCtxt_ ByronBlock f a -> NestedCtxt_ ByronToCardano f a
NestedCtxt_B2C NestedCtxt_ x Header a
NestedCtxt_ ByronBlock Header a
ctxt))

instance SerialiseNodeToNode ByronToCardano (Header ByronToCardano) where
  encodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> Header ByronToCardano
-> Encoding
encodeNodeToNode = Proxy Header
-> (Header ByronToCardano -> Header ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> Header ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Header) Header ByronToCardano -> Header ByronBlock
unHeaderB2C
  decodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (Header ByronToCardano)
decodeNodeToNode = Proxy Header
-> (Header (CardanoBlock Crypto) -> Header ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (Header ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Header) (\(HeaderByron Header ByronBlock
hdr) -> Header ByronBlock -> Header ByronToCardano
HeaderB2C Header ByronBlock
hdr)

instance SerialiseNodeToNode ByronToCardano (GenTx ByronToCardano) where
  encodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> GenTx ByronToCardano
-> Encoding
encodeNodeToNode = Proxy GenTx
-> (GenTx ByronToCardano -> GenTx ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> GenTx ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) GenTx ByronToCardano -> GenTx ByronBlock
unGenTxB2C
  decodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (GenTx ByronToCardano)
decodeNodeToNode = Proxy GenTx
-> (GenTx (CardanoBlock Crypto) -> GenTx ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (GenTx ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) (\(GenTxByron GenTx ByronBlock
tx) -> GenTx ByronBlock -> GenTx ByronToCardano
GenTxB2C GenTx ByronBlock
tx)

instance SerialiseNodeToNode ByronToCardano (GenTxId ByronToCardano) where
  encodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> GenTxId ByronToCardano
-> Encoding
encodeNodeToNode = Proxy WrapGenTxId
-> (GenTxId ByronToCardano -> GenTxId ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> GenTxId ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId) GenTxId ByronToCardano -> GenTxId ByronBlock
unGenTxIdB2C
  decodeNodeToNode :: CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (GenTxId ByronToCardano)
decodeNodeToNode = Proxy WrapGenTxId
-> (CardanoGenTxId Crypto -> GenTxId ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s (GenTxId ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToNodeVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToNodeB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId) (\(GenTxIdByron GenTxId ByronBlock
txid) -> GenTxId ByronBlock -> GenTxId ByronToCardano
GenTxIdB2C GenTxId ByronBlock
txid)

instance SerialiseNodeToNodeConstraints ByronToCardano where
  estimateBlockSize :: Header ByronToCardano -> SizeInBytes
estimateBlockSize = Header ByronBlock -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize (Header ByronBlock -> SizeInBytes)
-> (Header ByronToCardano -> Header ByronBlock)
-> Header ByronToCardano
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header ByronToCardano -> Header ByronBlock
unHeaderB2C

{------------------------------------------------------------------------------
  Byron to Cardano: NodeToClient
------------------------------------------------------------------------------}

-- | We want to encode byron-to-cardano compatibility types using byron
-- serializations. With that in mind, this is a helper function for implementing
-- @encodeNodeToClient@ for byron-to-cardano compatibility type: @b2c@. This
-- works by projecting to the byron type and encoding that.
encodeNodeToClientB2C ::
     forall f byron b2c.
     ( SerialiseNodeToClient ByronBlock (f ByronBlock)
     , Coercible byron (f ByronBlock)
     )
  => Proxy f
  -- ^ @f@ is an intermediate type, used for its @SerialiseNodeToClient@
  -- instance. @f@ is usually a newtype that wraps a @byron@ value.
  -> (b2c -> byron)
  -- ^ Convert (usually a simple projection) from the byron-to-cardano
  -- compatibility type to the byron type.
  -> CodecConfig ByronToCardano
  -> BlockNodeToClientVersion ByronToCardano
  -> b2c
  -- ^ The value to encode
  -> Encoding
encodeNodeToClientB2C :: forall (f :: * -> *) byron b2c.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToClientB2C Proxy f
_ b2c -> byron
toByron (CodecConfigB2C CodecConfig ByronBlock
ccfg) () b2c
x =
    forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient @ByronBlock CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
byronNodeToClientVersion (b2c -> f ByronBlock
toByron' b2c
x)
  where
    toByron' :: b2c -> f ByronBlock
    toByron' :: b2c -> f ByronBlock
toByron' = byron -> f ByronBlock
forall a b. Coercible a b => a -> b
coerce (byron -> f ByronBlock) -> (b2c -> byron) -> b2c -> f ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b2c -> byron
toByron

-- | We want to decode byron serializations into byron-to-cardano compatibility
-- types. With that in mind, this is a helper function for implementing
-- @decodeNodeToClient@ for byron-to-cardano compatibility type: @b2c@. This
-- works by decoding as the byron type and wrapping that in the byron-to-cardano
-- compatibility type.
decodeNodeToClientB2C ::
     forall f cardano b2c.
     ( SerialiseNodeToClient (CardanoBlock Crypto) (f (CardanoBlock Crypto))
     , Coercible cardano (f (CardanoBlock Crypto))
     )
  => Proxy f
  -- ^ @f@ is an intermediate type, used for its @SerialiseNodeToClient@
  -- instance. @f@ is usually a newtype that wraps a @byron@ value.
  -> (cardano -> b2c)
  -> CodecConfig ByronToCardano
  -> BlockNodeToClientVersion ByronToCardano
  -> forall s. Decoder s b2c
decodeNodeToClientB2C :: forall (f :: * -> *) cardano b2c.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToClientB2C Proxy f
_ cardano -> b2c
fromCardano (CodecConfigB2C CodecConfig ByronBlock
ccfg) () =
    f (CardanoBlock Crypto) -> b2c
fromCardano' (f (CardanoBlock Crypto) -> b2c)
-> Decoder s (f (CardanoBlock Crypto)) -> Decoder s b2c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient
        @(CardanoBlock Crypto)
        (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg)
        BlockNodeToClientVersion (CardanoBlock Crypto)
cardanoNodeToClientVersion
  where
    fromCardano' :: f (CardanoBlock Crypto) -> b2c
    fromCardano' :: f (CardanoBlock Crypto) -> b2c
fromCardano' = cardano -> b2c
fromCardano (cardano -> b2c)
-> (f (CardanoBlock Crypto) -> cardano)
-> f (CardanoBlock Crypto)
-> b2c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (CardanoBlock Crypto) -> cardano
forall a b. Coercible a b => a -> b
coerce

instance SerialiseNodeToClient ByronToCardano ByronToCardano where
  encodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> ByronToCardano
-> Encoding
encodeNodeToClient = Proxy I
-> (ByronToCardano -> ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) ByronToCardano -> ByronBlock
unB2C
  decodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s ByronToCardano
decodeNodeToClient = Proxy I
-> (CardanoBlock Crypto -> ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s ByronToCardano
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) (\(BlockByron ByronBlock
blk) -> ByronBlock -> ByronToCardano
B2C ByronBlock
blk)

instance SerialiseNodeToClient ByronToCardano (Serialised ByronToCardano) where
  encodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> Serialised ByronToCardano
-> Encoding
encodeNodeToClient = Proxy Serialised
-> (Serialised ByronToCardano -> Serialised ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> Serialised ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised) Serialised ByronToCardano -> Serialised ByronToCardano
forall a. a -> a
id
  decodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s (Serialised ByronToCardano)
decodeNodeToClient = Proxy Serialised
-> (Serialised ByronToCardano -> Serialised ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s (Serialised ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised) Serialised ByronToCardano -> Serialised ByronToCardano
forall a. a -> a
id

instance SerialiseNodeToClient ByronToCardano (GenTx ByronToCardano) where
  encodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> GenTx ByronToCardano
-> Encoding
encodeNodeToClient = Proxy GenTx
-> (GenTx ByronToCardano -> GenTx ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> GenTx ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) GenTx ByronToCardano -> GenTx ByronBlock
unGenTxB2C
  decodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s (GenTx ByronToCardano)
decodeNodeToClient = Proxy GenTx
-> (GenTx (CardanoBlock Crypto) -> GenTx ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s (GenTx ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) (\(GenTxByron GenTx ByronBlock
tx) -> GenTx ByronBlock -> GenTx ByronToCardano
GenTxB2C GenTx ByronBlock
tx)

instance SerialiseNodeToClient ByronToCardano (GenTxId ByronToCardano) where
  encodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> GenTxId ByronToCardano
-> Encoding
encodeNodeToClient = Proxy WrapGenTxId
-> (GenTxId ByronToCardano -> GenTxId ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> GenTxId ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId) GenTxId ByronToCardano -> GenTxId ByronBlock
unGenTxIdB2C
  decodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s (GenTxId ByronToCardano)
decodeNodeToClient = Proxy WrapGenTxId
-> (CardanoGenTxId Crypto -> GenTxId ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s (GenTxId ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId) (\(GenTxIdByron GenTxId ByronBlock
txid) -> GenTxId ByronBlock -> GenTxId ByronToCardano
GenTxIdB2C GenTxId ByronBlock
txid)

instance SerialiseNodeToClient ByronToCardano SlotNo

-- | @'ApplyTxErr' 'ByronToCardano'@
instance SerialiseNodeToClient ByronToCardano CC.ApplyMempoolPayloadErr where
  encodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> ApplyMempoolPayloadErr
-> Encoding
encodeNodeToClient = Proxy WrapApplyTxErr
-> (ApplyMempoolPayloadErr -> ApplyMempoolPayloadErr)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> ApplyMempoolPayloadErr
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapApplyTxErr) ApplyMempoolPayloadErr -> ApplyMempoolPayloadErr
forall a. a -> a
id
  decodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s ApplyMempoolPayloadErr
decodeNodeToClient = Proxy WrapApplyTxErr
-> (CardanoApplyTxErr Crypto -> ApplyMempoolPayloadErr)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s ApplyMempoolPayloadErr
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToClientB2C (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapApplyTxErr) (\(ApplyTxErrByron ApplyTxErr ByronBlock
err) -> ApplyMempoolPayloadErr
ApplyTxErr ByronBlock
err)

instance SerialiseNodeToClient ByronToCardano (SomeSecond BlockQuery ByronToCardano) where
  encodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> SomeSecond BlockQuery ByronToCardano
-> Encoding
encodeNodeToClient = Proxy (SomeSecond BlockQuery)
-> (SomeSecond BlockQuery ByronToCardano
    -> SomeSecond BlockQuery ByronBlock)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> SomeSecond BlockQuery ByronToCardano
-> Encoding
forall (f :: * -> *) byron b2c.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (b2c -> byron)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> b2c
-> Encoding
encodeNodeToClientB2C
                         (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(SomeSecond BlockQuery))
                         (\(SomeSecond BlockQuery ByronToCardano b
q) -> BlockQuery ByronBlock b -> SomeSecond BlockQuery ByronBlock
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery ByronToCardano b -> BlockQuery ByronBlock b
forall a. BlockQuery ByronToCardano a -> BlockQuery ByronBlock a
unQueryB2C BlockQuery ByronToCardano b
q))
  decodeNodeToClient :: CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s (SomeSecond BlockQuery ByronToCardano)
decodeNodeToClient = Proxy (SomeSecond BlockQuery)
-> (SomeSecond BlockQuery (CardanoBlock Crypto)
    -> SomeSecond BlockQuery ByronToCardano)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s (SomeSecond BlockQuery ByronToCardano)
forall (f :: * -> *) cardano b2c.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (cardano -> b2c)
-> CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> forall s. Decoder s b2c
decodeNodeToClientB2C
                         (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(SomeSecond BlockQuery))
                         (\(SomeSecond (QueryIfCurrentByron BlockQuery ByronBlock result
q)) -> BlockQuery ByronToCardano result
-> SomeSecond BlockQuery ByronToCardano
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery ByronBlock result -> BlockQuery ByronToCardano result
forall a. BlockQuery ByronBlock a -> BlockQuery ByronToCardano a
QueryB2C BlockQuery ByronBlock result
q))

instance SerialiseResult ByronToCardano (BlockQuery ByronToCardano) where
  encodeResult :: forall result.
CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> BlockQuery ByronToCardano result
-> result
-> Encoding
encodeResult (CodecConfigB2C CodecConfig ByronBlock
ccfg) () (QueryB2C BlockQuery ByronBlock result
q) result
r =
      CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> BlockQuery ByronBlock result
-> result
-> Encoding
forall result.
CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> BlockQuery ByronBlock result
-> result
-> Encoding
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> result
-> Encoding
encodeResult CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
byronNodeToClientVersion BlockQuery ByronBlock result
q result
r
  decodeResult :: forall result.
CodecConfig ByronToCardano
-> BlockNodeToClientVersion ByronToCardano
-> BlockQuery ByronToCardano result
-> forall s. Decoder s result
decodeResult (CodecConfigB2C CodecConfig ByronBlock
ccfg) () (QueryB2C (BlockQuery ByronBlock result
q :: BlockQuery ByronBlock result)) =
      (\(QueryResultSuccess result
r) -> result
r) (CardanoQueryResult Crypto result -> result)
-> Decoder s (CardanoQueryResult Crypto result) -> Decoder s result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        CodecConfig (CardanoBlock Crypto)
-> BlockNodeToClientVersion (CardanoBlock Crypto)
-> BlockQuery
     (CardanoBlock Crypto) (CardanoQueryResult Crypto result)
-> forall s. Decoder s (CardanoQueryResult Crypto result)
forall result.
CodecConfig (CardanoBlock Crypto)
-> BlockNodeToClientVersion (CardanoBlock Crypto)
-> BlockQuery (CardanoBlock Crypto) result
-> forall s. Decoder s result
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> forall s. Decoder s result
decodeResult
          (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg)
          BlockNodeToClientVersion (CardanoBlock Crypto)
cardanoNodeToClientVersion
          (BlockQuery ByronBlock result
-> BlockQuery
     (CardanoBlock Crypto) (CardanoQueryResult Crypto result)
forall c a result.
(CardanoQueryResult c result ~ a) =>
BlockQuery ByronBlock result -> CardanoQuery c a
QueryIfCurrentByron BlockQuery ByronBlock result
q :: CardanoQuery
                                      Crypto
                                      (CardanoQueryResult Crypto result))

instance SerialiseNodeToClientConstraints ByronToCardano

{------------------------------------------------------------------------------
  Byron to Cardano: Arbitrary instances
------------------------------------------------------------------------------}

instance Arbitrary ByronToCardano where
  arbitrary :: Gen ByronToCardano
arbitrary = ByronBlock -> ByronToCardano
B2C (ByronBlock -> ByronToCardano)
-> Gen ByronBlock -> Gen ByronToCardano
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByronBlock
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (Header ByronToCardano) where
  arbitrary :: Gen (Header ByronToCardano)
arbitrary = Header ByronBlock -> Header ByronToCardano
HeaderB2C (Header ByronBlock -> Header ByronToCardano)
-> Gen (Header ByronBlock) -> Gen (Header ByronToCardano)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen (WithVersion ByronNodeToNodeVersion (Header ByronBlock))
forall a. Arbitrary a => Gen a
arbitrary Gen (WithVersion ByronNodeToNodeVersion (Header ByronBlock))
-> (WithVersion ByronNodeToNodeVersion (Header ByronBlock)
    -> Maybe (Header ByronBlock))
-> Gen (Header ByronBlock)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` WithVersion ByronNodeToNodeVersion (Header ByronBlock)
-> Maybe (Header ByronBlock)
isRightVersion)
    where
      isRightVersion ::
           WithVersion ByronNodeToNodeVersion (Header ByronBlock)
        -> Maybe (Header ByronBlock)
      isRightVersion :: WithVersion ByronNodeToNodeVersion (Header ByronBlock)
-> Maybe (Header ByronBlock)
isRightVersion (WithVersion ByronNodeToNodeVersion
version Header ByronBlock
hdr)
        | ByronNodeToNodeVersion
version ByronNodeToNodeVersion -> ByronNodeToNodeVersion -> Bool
forall a. Eq a => a -> a -> Bool
== BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
byronNodeToNodeVersion = Header ByronBlock -> Maybe (Header ByronBlock)
forall a. a -> Maybe a
Just Header ByronBlock
hdr
        | Bool
otherwise                         = Maybe (Header ByronBlock)
forall a. Maybe a
Nothing

instance Arbitrary (GenTx ByronToCardano) where
  arbitrary :: Gen (GenTx ByronToCardano)
arbitrary = GenTx ByronBlock -> GenTx ByronToCardano
GenTxB2C (GenTx ByronBlock -> GenTx ByronToCardano)
-> Gen (GenTx ByronBlock) -> Gen (GenTx ByronToCardano)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (GenTx ByronBlock)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (GenTxId ByronToCardano) where
  arbitrary :: Gen (GenTxId ByronToCardano)
arbitrary = GenTxId ByronBlock -> GenTxId ByronToCardano
GenTxIdB2C (GenTxId ByronBlock -> GenTxId ByronToCardano)
-> Gen (GenTxId ByronBlock) -> Gen (GenTxId ByronToCardano)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (GenTxId ByronBlock)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (SomeSecond BlockQuery ByronToCardano) where
  arbitrary :: Gen (SomeSecond BlockQuery ByronToCardano)
arbitrary = (\(SomeSecond BlockQuery ByronBlock b
q) -> BlockQuery ByronToCardano b -> SomeSecond BlockQuery ByronToCardano
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery ByronBlock b -> BlockQuery ByronToCardano b
forall a. BlockQuery ByronBlock a -> BlockQuery ByronToCardano a
QueryB2C BlockQuery ByronBlock b
q)) (SomeSecond BlockQuery ByronBlock
 -> SomeSecond BlockQuery ByronToCardano)
-> Gen (SomeSecond BlockQuery ByronBlock)
-> Gen (SomeSecond BlockQuery ByronToCardano)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SomeSecond BlockQuery ByronBlock)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (SomeResult ByronToCardano) where
  arbitrary :: Gen (SomeResult ByronToCardano)
arbitrary = (\(SomeResult BlockQuery ByronBlock result
q result
r) -> BlockQuery ByronToCardano result
-> result -> SomeResult ByronToCardano
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (BlockQuery ByronBlock result -> BlockQuery ByronToCardano result
forall a. BlockQuery ByronBlock a -> BlockQuery ByronToCardano a
QueryB2C BlockQuery ByronBlock result
q) result
r) (SomeResult ByronBlock -> SomeResult ByronToCardano)
-> Gen (SomeResult ByronBlock) -> Gen (SomeResult ByronToCardano)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SomeResult ByronBlock)
forall a. Arbitrary a => Gen a
arbitrary

{------------------------------------------------------------------------------
  Cardano to Byron
------------------------------------------------------------------------------}

-- | Encoded Cardano values can be decoded as Byron values in the following
-- cases:
--
-- * The @HardForkNodeTo(Node|Client)Disabled@ version is used
-- * Blocks and headers stored on disk
--
-- Note that ledger state and all other types stored as part of the ledger
-- snapshot are __not__ forwards compatible.
newtype CardanoToByron                       = C2B        { CardanoToByron -> ByronBlock
unC2B        ::            ByronBlock   } deriving (CardanoToByron -> CardanoToByron -> Bool
(CardanoToByron -> CardanoToByron -> Bool)
-> (CardanoToByron -> CardanoToByron -> Bool) -> Eq CardanoToByron
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CardanoToByron -> CardanoToByron -> Bool
== :: CardanoToByron -> CardanoToByron -> Bool
$c/= :: CardanoToByron -> CardanoToByron -> Bool
/= :: CardanoToByron -> CardanoToByron -> Bool
Eq, Int -> CardanoToByron -> ShowS
[CardanoToByron] -> ShowS
CardanoToByron -> TestName
(Int -> CardanoToByron -> ShowS)
-> (CardanoToByron -> TestName)
-> ([CardanoToByron] -> ShowS)
-> Show CardanoToByron
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CardanoToByron -> ShowS
showsPrec :: Int -> CardanoToByron -> ShowS
$cshow :: CardanoToByron -> TestName
show :: CardanoToByron -> TestName
$cshowList :: [CardanoToByron] -> ShowS
showList :: [CardanoToByron] -> ShowS
Show)
newtype instance Header CardanoToByron       = HeaderC2B  { Header CardanoToByron -> Header ByronBlock
unHeaderC2B  :: Header     ByronBlock   } deriving (Header CardanoToByron -> Header CardanoToByron -> Bool
(Header CardanoToByron -> Header CardanoToByron -> Bool)
-> (Header CardanoToByron -> Header CardanoToByron -> Bool)
-> Eq (Header CardanoToByron)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Header CardanoToByron -> Header CardanoToByron -> Bool
== :: Header CardanoToByron -> Header CardanoToByron -> Bool
$c/= :: Header CardanoToByron -> Header CardanoToByron -> Bool
/= :: Header CardanoToByron -> Header CardanoToByron -> Bool
Eq, Int -> Header CardanoToByron -> ShowS
[Header CardanoToByron] -> ShowS
Header CardanoToByron -> TestName
(Int -> Header CardanoToByron -> ShowS)
-> (Header CardanoToByron -> TestName)
-> ([Header CardanoToByron] -> ShowS)
-> Show (Header CardanoToByron)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Header CardanoToByron -> ShowS
showsPrec :: Int -> Header CardanoToByron -> ShowS
$cshow :: Header CardanoToByron -> TestName
show :: Header CardanoToByron -> TestName
$cshowList :: [Header CardanoToByron] -> ShowS
showList :: [Header CardanoToByron] -> ShowS
Show)
newtype instance GenTx CardanoToByron        = GenTxC2B   { GenTx CardanoToByron -> GenTx ByronBlock
unGenTxC2B   :: GenTx      ByronBlock   } deriving (GenTx CardanoToByron -> GenTx CardanoToByron -> Bool
(GenTx CardanoToByron -> GenTx CardanoToByron -> Bool)
-> (GenTx CardanoToByron -> GenTx CardanoToByron -> Bool)
-> Eq (GenTx CardanoToByron)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenTx CardanoToByron -> GenTx CardanoToByron -> Bool
== :: GenTx CardanoToByron -> GenTx CardanoToByron -> Bool
$c/= :: GenTx CardanoToByron -> GenTx CardanoToByron -> Bool
/= :: GenTx CardanoToByron -> GenTx CardanoToByron -> Bool
Eq, Int -> GenTx CardanoToByron -> ShowS
[GenTx CardanoToByron] -> ShowS
GenTx CardanoToByron -> TestName
(Int -> GenTx CardanoToByron -> ShowS)
-> (GenTx CardanoToByron -> TestName)
-> ([GenTx CardanoToByron] -> ShowS)
-> Show (GenTx CardanoToByron)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenTx CardanoToByron -> ShowS
showsPrec :: Int -> GenTx CardanoToByron -> ShowS
$cshow :: GenTx CardanoToByron -> TestName
show :: GenTx CardanoToByron -> TestName
$cshowList :: [GenTx CardanoToByron] -> ShowS
showList :: [GenTx CardanoToByron] -> ShowS
Show)
newtype instance TxId (GenTx CardanoToByron) = GenTxIdC2B { GenTxId CardanoToByron -> GenTxId ByronBlock
unGenTxIdC2B :: GenTxId    ByronBlock   } deriving (GenTxId CardanoToByron -> GenTxId CardanoToByron -> Bool
(GenTxId CardanoToByron -> GenTxId CardanoToByron -> Bool)
-> (GenTxId CardanoToByron -> GenTxId CardanoToByron -> Bool)
-> Eq (GenTxId CardanoToByron)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenTxId CardanoToByron -> GenTxId CardanoToByron -> Bool
== :: GenTxId CardanoToByron -> GenTxId CardanoToByron -> Bool
$c/= :: GenTxId CardanoToByron -> GenTxId CardanoToByron -> Bool
/= :: GenTxId CardanoToByron -> GenTxId CardanoToByron -> Bool
Eq, Int -> GenTxId CardanoToByron -> ShowS
[GenTxId CardanoToByron] -> ShowS
GenTxId CardanoToByron -> TestName
(Int -> GenTxId CardanoToByron -> ShowS)
-> (GenTxId CardanoToByron -> TestName)
-> ([GenTxId CardanoToByron] -> ShowS)
-> Show (GenTxId CardanoToByron)
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenTxId CardanoToByron -> ShowS
showsPrec :: Int -> GenTxId CardanoToByron -> ShowS
$cshow :: GenTxId CardanoToByron -> TestName
show :: GenTxId CardanoToByron -> TestName
$cshowList :: [GenTxId CardanoToByron] -> ShowS
showList :: [GenTxId CardanoToByron] -> ShowS
Show)
newtype instance BlockQuery CardanoToByron a = QueryC2B   { forall a. BlockQuery CardanoToByron a -> BlockQuery ByronBlock a
unQueryC2B   :: BlockQuery ByronBlock a } deriving (BlockQuery CardanoToByron a -> BlockQuery CardanoToByron a -> Bool
(BlockQuery CardanoToByron a
 -> BlockQuery CardanoToByron a -> Bool)
-> (BlockQuery CardanoToByron a
    -> BlockQuery CardanoToByron a -> Bool)
-> Eq (BlockQuery CardanoToByron a)
forall a.
BlockQuery CardanoToByron a -> BlockQuery CardanoToByron a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
BlockQuery CardanoToByron a -> BlockQuery CardanoToByron a -> Bool
== :: BlockQuery CardanoToByron a -> BlockQuery CardanoToByron a -> Bool
$c/= :: forall a.
BlockQuery CardanoToByron a -> BlockQuery CardanoToByron a -> Bool
/= :: BlockQuery CardanoToByron a -> BlockQuery CardanoToByron a -> Bool
Eq, Int -> BlockQuery CardanoToByron a -> ShowS
[BlockQuery CardanoToByron a] -> ShowS
BlockQuery CardanoToByron a -> TestName
(Int -> BlockQuery CardanoToByron a -> ShowS)
-> (BlockQuery CardanoToByron a -> TestName)
-> ([BlockQuery CardanoToByron a] -> ShowS)
-> Show (BlockQuery CardanoToByron a)
forall a. Int -> BlockQuery CardanoToByron a -> ShowS
forall a. [BlockQuery CardanoToByron a] -> ShowS
forall a. BlockQuery CardanoToByron a -> TestName
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> BlockQuery CardanoToByron a -> ShowS
showsPrec :: Int -> BlockQuery CardanoToByron a -> ShowS
$cshow :: forall a. BlockQuery CardanoToByron a -> TestName
show :: BlockQuery CardanoToByron a -> TestName
$cshowList :: forall a. [BlockQuery CardanoToByron a] -> ShowS
showList :: [BlockQuery CardanoToByron a] -> ShowS
Show)

newtype instance NestedCtxt_ CardanoToByron f a where
  NestedCtxt_C2B :: NestedCtxt_ ByronBlock     f a
                 -> NestedCtxt_ CardanoToByron f a

deriving instance Show (NestedCtxt_ CardanoToByron Header a)

unNestedCtxt_C2B :: NestedCtxt_ CardanoToByron f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_C2B :: forall (f :: * -> *) a.
NestedCtxt_ CardanoToByron f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_C2B (NestedCtxt_C2B NestedCtxt_ ByronBlock f a
ctxt) = NestedCtxt_ ByronBlock f a
ctxt

type instance HeaderHash CardanoToByron = HeaderHash ByronBlock
type instance ApplyTxErr CardanoToByron = ApplyTxErr ByronBlock

instance HasNetworkProtocolVersion CardanoToByron

instance ConvertRawHash CardanoToByron where
  toShortRawHash :: forall (proxy :: * -> *).
proxy CardanoToByron
-> HeaderHash CardanoToByron -> ShortByteString
toShortRawHash   proxy CardanoToByron
_ = Proxy ByronBlock -> HeaderHash ByronBlock -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy ByronBlock -> HeaderHash ByronBlock -> ShortByteString
toShortRawHash   Proxy ByronBlock
pb
  fromShortRawHash :: forall (proxy :: * -> *).
proxy CardanoToByron
-> ShortByteString -> HeaderHash CardanoToByron
fromShortRawHash proxy CardanoToByron
_ = Proxy ByronBlock -> ShortByteString -> HeaderHash ByronBlock
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
forall (proxy :: * -> *).
proxy ByronBlock -> ShortByteString -> HeaderHash ByronBlock
fromShortRawHash Proxy ByronBlock
pb
  hashSize :: forall (proxy :: * -> *). proxy CardanoToByron -> Word32
hashSize         proxy CardanoToByron
_ = Proxy ByronBlock -> Word32
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> Word32
forall (proxy :: * -> *). proxy ByronBlock -> Word32
hashSize         Proxy ByronBlock
pb

data instance CodecConfig CardanoToByron = CodecConfigC2B (CodecConfig ByronBlock)

instance SameDepIndex (NestedCtxt_ CardanoToByron Header) where
  sameDepIndex :: forall a b.
NestedCtxt_ CardanoToByron Header a
-> NestedCtxt_ CardanoToByron Header b -> Maybe (a :~: b)
sameDepIndex (NestedCtxt_C2B NestedCtxt_ ByronBlock Header a
ctxt1) (NestedCtxt_C2B NestedCtxt_ ByronBlock Header b
ctxt2) =
      NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronBlock Header b -> Maybe (a :~: b)
forall a b.
NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ ByronBlock Header b -> Maybe (a :~: b)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex NestedCtxt_ ByronBlock Header a
ctxt1 NestedCtxt_ ByronBlock Header b
ctxt2

instance HasNestedContent Header CardanoToByron where
  unnest :: Header CardanoToByron -> DepPair (NestedCtxt Header CardanoToByron)
unnest Header CardanoToByron
hdr = case Header ByronBlock -> DepPair (NestedCtxt Header ByronBlock)
forall (f :: * -> *) blk.
HasNestedContent f blk =>
f blk -> DepPair (NestedCtxt f blk)
unnest (Header CardanoToByron -> Header ByronBlock
unHeaderC2B Header CardanoToByron
hdr) of
      DepPair NestedCtxt Header ByronBlock a
ctxt a
a -> NestedCtxt Header CardanoToByron a
-> a -> DepPair (NestedCtxt Header CardanoToByron)
forall (f :: * -> *) a. f a -> a -> DepPair f
DepPair ((NestedCtxt_ ByronBlock Header a
 -> NestedCtxt_ CardanoToByron Header a)
-> NestedCtxt Header ByronBlock a
-> NestedCtxt Header CardanoToByron a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ CardanoToByron Header a
forall (f :: * -> *) a.
NestedCtxt_ ByronBlock f a -> NestedCtxt_ CardanoToByron f a
NestedCtxt_C2B NestedCtxt Header ByronBlock a
ctxt) a
a
  nest :: DepPair (NestedCtxt Header CardanoToByron) -> Header CardanoToByron
nest (DepPair NestedCtxt Header CardanoToByron a
ctxt a
a) =
      Header ByronBlock -> Header CardanoToByron
HeaderC2B (Header ByronBlock -> Header CardanoToByron)
-> Header ByronBlock -> Header CardanoToByron
forall a b. (a -> b) -> a -> b
$ DepPair (NestedCtxt Header ByronBlock) -> Header ByronBlock
forall (f :: * -> *) blk.
HasNestedContent f blk =>
DepPair (NestedCtxt f blk) -> f blk
nest (NestedCtxt Header ByronBlock a
-> a -> DepPair (NestedCtxt Header ByronBlock)
forall (f :: * -> *) a. f a -> a -> DepPair f
DepPair ((NestedCtxt_ CardanoToByron Header a
 -> NestedCtxt_ ByronBlock Header a)
-> NestedCtxt Header CardanoToByron a
-> NestedCtxt Header ByronBlock a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ CardanoToByron Header a
-> NestedCtxt_ ByronBlock Header a
forall (f :: * -> *) a.
NestedCtxt_ CardanoToByron f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_C2B NestedCtxt Header CardanoToByron a
ctxt) a
a)

instance ShowQuery (BlockQuery CardanoToByron) where
  showResult :: forall result.
BlockQuery CardanoToByron result -> result -> TestName
showResult (QueryC2B BlockQuery ByronBlock result
query) = BlockQuery ByronBlock result -> result -> TestName
forall result. BlockQuery ByronBlock result -> result -> TestName
forall (query :: * -> *) result.
ShowQuery query =>
query result -> result -> TestName
showResult BlockQuery ByronBlock result
query

instance SameDepIndex (BlockQuery CardanoToByron) where
  sameDepIndex :: forall a b.
BlockQuery CardanoToByron a
-> BlockQuery CardanoToByron b -> Maybe (a :~: b)
sameDepIndex (QueryC2B BlockQuery ByronBlock a
q1) (QueryC2B BlockQuery ByronBlock b
q2) = BlockQuery ByronBlock a
-> BlockQuery ByronBlock b -> Maybe (a :~: b)
forall a b.
BlockQuery ByronBlock a
-> BlockQuery ByronBlock b -> Maybe (a :~: b)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex BlockQuery ByronBlock a
q1 BlockQuery ByronBlock b
q2

{------------------------------------------------------------------------------
  Cardano to Byron: Disk
------------------------------------------------------------------------------}

encodeDiskC2B ::
     forall f cardano c2b.
     ( EncodeDisk (CardanoBlock Crypto) (f (CardanoBlock Crypto))
     , Coercible cardano (f (CardanoBlock Crypto))
     )
  => Proxy f
  -> (c2b -> cardano)
  -> CodecConfig CardanoToByron
  -> c2b
  -> Encoding
encodeDiskC2B :: forall (f :: * -> *) cardano c2b.
(EncodeDisk (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> c2b
-> Encoding
encodeDiskC2B Proxy f
_ c2b -> cardano
toCardano (CodecConfigC2B CodecConfig ByronBlock
ccfg) c2b
x =
    CodecConfig (CardanoBlock Crypto)
-> f (CardanoBlock Crypto) -> Encoding
forall blk a. EncodeDisk blk a => CodecConfig blk -> a -> Encoding
encodeDisk (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg) (c2b -> f (CardanoBlock Crypto)
toCardano' c2b
x)
  where
    toCardano' :: c2b -> f (CardanoBlock Crypto)
    toCardano' :: c2b -> f (CardanoBlock Crypto)
toCardano' = cardano -> f (CardanoBlock Crypto)
forall a b. Coercible a b => a -> b
coerce (cardano -> f (CardanoBlock Crypto))
-> (c2b -> cardano) -> c2b -> f (CardanoBlock Crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c2b -> cardano
toCardano

decodeDiskC2B ::
     forall f byron c2b.
     ( DecodeDisk ByronBlock (f ByronBlock)
     , Coercible byron (f ByronBlock)
     )
  => Proxy f
  -> (byron -> c2b)
  -> CodecConfig CardanoToByron
  -> forall s. Decoder s c2b
decodeDiskC2B :: forall (f :: * -> *) byron c2b.
(DecodeDisk ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> forall s. Decoder s c2b
decodeDiskC2B Proxy f
_ byron -> c2b
fromByron (CodecConfigC2B CodecConfig ByronBlock
ccfg) =
    f ByronBlock -> c2b
fromByron' (f ByronBlock -> c2b) -> Decoder s (f ByronBlock) -> Decoder s c2b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig ByronBlock -> forall s. Decoder s (f ByronBlock)
forall blk a.
DecodeDisk blk a =>
CodecConfig blk -> forall s. Decoder s a
decodeDisk CodecConfig ByronBlock
ccfg
  where
    fromByron' :: f ByronBlock -> c2b
    fromByron' :: f ByronBlock -> c2b
fromByron' = byron -> c2b
fromByron (byron -> c2b) -> (f ByronBlock -> byron) -> f ByronBlock -> c2b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ByronBlock -> byron
forall a b. Coercible a b => a -> b
coerce

instance EncodeDisk CardanoToByron CardanoToByron where
  encodeDisk :: CodecConfig CardanoToByron -> CardanoToByron -> Encoding
encodeDisk = Proxy I
-> (CardanoToByron -> CardanoBlock Crypto)
-> CodecConfig CardanoToByron
-> CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(EncodeDisk (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> c2b
-> Encoding
encodeDiskC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) (ByronBlock -> CardanoBlock Crypto
forall c. ByronBlock -> CardanoBlock c
BlockByron (ByronBlock -> CardanoBlock Crypto)
-> (CardanoToByron -> ByronBlock)
-> CardanoToByron
-> CardanoBlock Crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoToByron -> ByronBlock
unC2B)

instance DecodeDisk CardanoToByron (Lazy.ByteString -> CardanoToByron) where
  decodeDisk :: CodecConfig CardanoToByron
-> forall s. Decoder s (ByteString -> CardanoToByron)
decodeDisk = Proxy ((->) ByteString)
-> ((ByteString -> ByronBlock) -> ByteString -> CardanoToByron)
-> CodecConfig CardanoToByron
-> forall s. Decoder s (ByteString -> CardanoToByron)
forall (f :: * -> *) byron c2b.
(DecodeDisk ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> forall s. Decoder s c2b
decodeDiskC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @((->) Lazy.ByteString)) ((ByronBlock -> CardanoToByron)
-> (ByteString -> ByronBlock) -> ByteString -> CardanoToByron
forall a b. (a -> b) -> (ByteString -> a) -> ByteString -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByronBlock -> CardanoToByron
C2B)

instance EncodeDiskDep (NestedCtxt Header) CardanoToByron where
  encodeDiskDep :: forall a.
CodecConfig CardanoToByron
-> NestedCtxt Header CardanoToByron a -> a -> Encoding
encodeDiskDep (CodecConfigC2B CodecConfig ByronBlock
ccfg) =
      CodecConfig (CardanoBlock Crypto)
-> NestedCtxt Header (CardanoBlock Crypto) a -> a -> Encoding
forall a.
CodecConfig (CardanoBlock Crypto)
-> NestedCtxt Header (CardanoBlock Crypto) a -> a -> Encoding
forall (f :: * -> * -> *) blk a.
EncodeDiskDep f blk =>
CodecConfig blk -> f blk a -> a -> Encoding
encodeDiskDep (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg) (NestedCtxt Header (CardanoBlock Crypto) a -> a -> Encoding)
-> (NestedCtxt Header CardanoToByron a
    -> NestedCtxt Header (CardanoBlock Crypto) a)
-> NestedCtxt Header CardanoToByron a
-> a
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NestedCtxt_ CardanoToByron Header a
 -> NestedCtxt_ (CardanoBlock Crypto) Header a)
-> NestedCtxt Header CardanoToByron a
-> NestedCtxt Header (CardanoBlock Crypto) a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt (NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ (CardanoBlock Crypto) Header a
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ (NestedCtxt_ ByronBlock Header a
 -> NestedCtxt_ (CardanoBlock Crypto) Header a)
-> (NestedCtxt_ CardanoToByron Header a
    -> NestedCtxt_ ByronBlock Header a)
-> NestedCtxt_ CardanoToByron Header a
-> NestedCtxt_ (CardanoBlock Crypto) Header a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NestedCtxt_ CardanoToByron Header a
-> NestedCtxt_ ByronBlock Header a
forall (f :: * -> *) a.
NestedCtxt_ CardanoToByron f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_C2B)

instance DecodeDiskDep (NestedCtxt Header) CardanoToByron where
  decodeDiskDep :: forall a.
CodecConfig CardanoToByron
-> NestedCtxt Header CardanoToByron a
-> forall s. Decoder s (ByteString -> a)
decodeDiskDep (CodecConfigC2B CodecConfig ByronBlock
ccfg) =
      CodecConfig ByronBlock
-> NestedCtxt Header ByronBlock a
-> forall s. Decoder s (ByteString -> a)
forall a.
CodecConfig ByronBlock
-> NestedCtxt Header ByronBlock a
-> forall s. Decoder s (ByteString -> a)
forall (f :: * -> * -> *) blk a.
DecodeDiskDep f blk =>
CodecConfig blk -> f blk a -> forall s. Decoder s (ByteString -> a)
decodeDiskDep CodecConfig ByronBlock
ccfg (NestedCtxt Header ByronBlock a -> Decoder s (ByteString -> a))
-> (NestedCtxt Header CardanoToByron a
    -> NestedCtxt Header ByronBlock a)
-> NestedCtxt Header CardanoToByron a
-> Decoder s (ByteString -> a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NestedCtxt_ CardanoToByron Header a
 -> NestedCtxt_ ByronBlock Header a)
-> NestedCtxt Header CardanoToByron a
-> NestedCtxt Header ByronBlock a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ CardanoToByron Header a
-> NestedCtxt_ ByronBlock Header a
forall (f :: * -> *) a.
NestedCtxt_ CardanoToByron f a -> NestedCtxt_ ByronBlock f a
unNestedCtxt_C2B

{------------------------------------------------------------------------------
  Cardano to Byron: NodeToNode
------------------------------------------------------------------------------}

encodeNodeToNodeC2B ::
     forall f cardano c2b.
     ( SerialiseNodeToNode (CardanoBlock Crypto) (f (CardanoBlock Crypto))
     , Coercible cardano (f (CardanoBlock Crypto))
     )
  => Proxy f
  -> (c2b -> cardano)
  -> CodecConfig CardanoToByron
  -> BlockNodeToNodeVersion CardanoToByron
  -> c2b
  -> Encoding
encodeNodeToNodeC2B :: forall (f :: * -> *) cardano c2b.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToNodeC2B Proxy f
_ c2b -> cardano
toCardano (CodecConfigC2B CodecConfig ByronBlock
ccfg) () c2b
x =
    CodecConfig (CardanoBlock Crypto)
-> BlockNodeToNodeVersion (CardanoBlock Crypto)
-> f (CardanoBlock Crypto)
-> Encoding
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk -> BlockNodeToNodeVersion blk -> a -> Encoding
encodeNodeToNode
      (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg)
      BlockNodeToNodeVersion (CardanoBlock Crypto)
cardanoNodeToNodeVersion
      (c2b -> f (CardanoBlock Crypto)
toCardano' c2b
x)
  where
    toCardano' :: c2b -> f (CardanoBlock Crypto)
    toCardano' :: c2b -> f (CardanoBlock Crypto)
toCardano' = cardano -> f (CardanoBlock Crypto)
forall a b. Coercible a b => a -> b
coerce (cardano -> f (CardanoBlock Crypto))
-> (c2b -> cardano) -> c2b -> f (CardanoBlock Crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c2b -> cardano
toCardano

decodeNodeToNodeC2B ::
     forall f byron c2b.
     ( SerialiseNodeToNode ByronBlock (f ByronBlock)
     , Coercible byron (f ByronBlock)
     )
  => Proxy f
  -> (byron -> c2b)
  -> CodecConfig CardanoToByron
  -> BlockNodeToNodeVersion CardanoToByron
  -> forall s. Decoder s c2b
decodeNodeToNodeC2B :: forall (f :: * -> *) byron c2b.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToNodeC2B Proxy f
_ byron -> c2b
fromByron (CodecConfigC2B CodecConfig ByronBlock
ccfg) () =
    f ByronBlock -> c2b
fromByron' (f ByronBlock -> c2b) -> Decoder s (f ByronBlock) -> Decoder s c2b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CodecConfig ByronBlock
-> BlockNodeToNodeVersion ByronBlock
-> forall s. Decoder s (f ByronBlock)
forall blk a.
SerialiseNodeToNode blk a =>
CodecConfig blk
-> BlockNodeToNodeVersion blk -> forall s. Decoder s a
decodeNodeToNode CodecConfig ByronBlock
ccfg BlockNodeToNodeVersion ByronBlock
byronNodeToNodeVersion
  where
    fromByron' :: f ByronBlock -> c2b
    fromByron' :: f ByronBlock -> c2b
fromByron' = byron -> c2b
fromByron (byron -> c2b) -> (f ByronBlock -> byron) -> f ByronBlock -> c2b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ByronBlock -> byron
forall a b. Coercible a b => a -> b
coerce

instance SerialiseNodeToNode CardanoToByron CardanoToByron where
  encodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> CardanoToByron
-> Encoding
encodeNodeToNode = Proxy I
-> (CardanoToByron -> CardanoBlock Crypto)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) (ByronBlock -> CardanoBlock Crypto
forall c. ByronBlock -> CardanoBlock c
BlockByron (ByronBlock -> CardanoBlock Crypto)
-> (CardanoToByron -> ByronBlock)
-> CardanoToByron
-> CardanoBlock Crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoToByron -> ByronBlock
unC2B)
  decodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s CardanoToByron
decodeNodeToNode = Proxy I
-> (ByronBlock -> CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s CardanoToByron
forall (f :: * -> *) byron c2b.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) ByronBlock -> CardanoToByron
C2B

instance SerialiseNodeToNode CardanoToByron (Serialised CardanoToByron) where
  encodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> Serialised CardanoToByron
-> Encoding
encodeNodeToNode = Proxy Serialised
-> (Serialised CardanoToByron -> Serialised CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> Serialised CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised) Serialised CardanoToByron -> Serialised CardanoToByron
forall a. a -> a
id
  decodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (Serialised CardanoToByron)
decodeNodeToNode = Proxy Serialised
-> (Serialised CardanoToByron -> Serialised CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (Serialised CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised) Serialised CardanoToByron -> Serialised CardanoToByron
forall a. a -> a
id

instance SerialiseNodeToNode CardanoToByron (SerialisedHeader CardanoToByron) where
  encodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> SerialisedHeader CardanoToByron
-> Encoding
encodeNodeToNode = Proxy SerialisedHeader
-> (SerialisedHeader CardanoToByron
    -> SerialisedHeader (CardanoBlock Crypto))
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> SerialisedHeader CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToNodeC2B
                       (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @SerialisedHeader)
                       ((forall a.
 NestedCtxt_ CardanoToByron Header a
 -> NestedCtxt_ (CardanoBlock Crypto) Header a)
-> SerialisedHeader CardanoToByron
-> SerialisedHeader (CardanoBlock Crypto)
forall blk blk'.
(forall a. NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a)
-> SerialisedHeader blk -> SerialisedHeader blk'
castSerialisedHeader (\(NestedCtxt_C2B NestedCtxt_ ByronBlock Header a
ctxt) -> NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ (CardanoBlock Crypto) Header a
forall x (a :: * -> *) b (xs1 :: [*]).
NestedCtxt_ x a b -> NestedCtxt_ (HardForkBlock (x : xs1)) a b
NCZ NestedCtxt_ ByronBlock Header a
ctxt))
  decodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (SerialisedHeader CardanoToByron)
decodeNodeToNode = Proxy SerialisedHeader
-> (SerialisedHeader ByronBlock -> SerialisedHeader CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (SerialisedHeader CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToNodeC2B
                       (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @SerialisedHeader)
                       ((forall a.
 NestedCtxt_ ByronBlock Header a
 -> NestedCtxt_ CardanoToByron Header a)
-> SerialisedHeader ByronBlock -> SerialisedHeader CardanoToByron
forall blk blk'.
(forall a. NestedCtxt_ blk Header a -> NestedCtxt_ blk' Header a)
-> SerialisedHeader blk -> SerialisedHeader blk'
castSerialisedHeader NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ CardanoToByron Header a
forall a.
NestedCtxt_ ByronBlock Header a
-> NestedCtxt_ CardanoToByron Header a
forall (f :: * -> *) a.
NestedCtxt_ ByronBlock f a -> NestedCtxt_ CardanoToByron f a
NestedCtxt_C2B)

instance SerialiseNodeToNode CardanoToByron (Header CardanoToByron) where
  encodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> Header CardanoToByron
-> Encoding
encodeNodeToNode = Proxy Header
-> (Header CardanoToByron -> Header (CardanoBlock Crypto))
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> Header CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Header) (Header ByronBlock -> Header (CardanoBlock Crypto)
forall c. Header ByronBlock -> CardanoHeader c
HeaderByron (Header ByronBlock -> Header (CardanoBlock Crypto))
-> (Header CardanoToByron -> Header ByronBlock)
-> Header CardanoToByron
-> Header (CardanoBlock Crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header CardanoToByron -> Header ByronBlock
unHeaderC2B)
  decodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (Header CardanoToByron)
decodeNodeToNode = Proxy Header
-> (Header ByronBlock -> Header CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (Header CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Header) Header ByronBlock -> Header CardanoToByron
HeaderC2B

instance SerialiseNodeToNode CardanoToByron (GenTx CardanoToByron) where
  encodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> GenTx CardanoToByron
-> Encoding
encodeNodeToNode = Proxy GenTx
-> (GenTx CardanoToByron -> GenTx (CardanoBlock Crypto))
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> GenTx CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) (GenTx ByronBlock -> GenTx (CardanoBlock Crypto)
forall c. GenTx ByronBlock -> CardanoGenTx c
GenTxByron (GenTx ByronBlock -> GenTx (CardanoBlock Crypto))
-> (GenTx CardanoToByron -> GenTx ByronBlock)
-> GenTx CardanoToByron
-> GenTx (CardanoBlock Crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx CardanoToByron -> GenTx ByronBlock
unGenTxC2B)
  decodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (GenTx CardanoToByron)
decodeNodeToNode = Proxy GenTx
-> (GenTx ByronBlock -> GenTx CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (GenTx CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) GenTx ByronBlock -> GenTx CardanoToByron
GenTxC2B

instance SerialiseNodeToNode CardanoToByron (GenTxId CardanoToByron) where
  encodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> GenTxId CardanoToByron
-> Encoding
encodeNodeToNode = Proxy WrapGenTxId
-> (GenTxId CardanoToByron -> CardanoGenTxId Crypto)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> GenTxId CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToNode
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId) (GenTxId ByronBlock -> CardanoGenTxId Crypto
forall c. GenTxId ByronBlock -> CardanoGenTxId c
GenTxIdByron (GenTxId ByronBlock -> CardanoGenTxId Crypto)
-> (GenTxId CardanoToByron -> GenTxId ByronBlock)
-> GenTxId CardanoToByron
-> CardanoGenTxId Crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTxId CardanoToByron -> GenTxId ByronBlock
unGenTxIdC2B)
  decodeNodeToNode :: CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (GenTxId CardanoToByron)
decodeNodeToNode = Proxy WrapGenTxId
-> (GenTxId ByronBlock -> GenTxId CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s (GenTxId CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToNode ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToNodeVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToNodeC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId) GenTxId ByronBlock -> GenTxId CardanoToByron
GenTxIdC2B

instance SerialiseNodeToNodeConstraints CardanoToByron where
  estimateBlockSize :: Header CardanoToByron -> SizeInBytes
estimateBlockSize = Header ByronBlock -> SizeInBytes
forall blk.
SerialiseNodeToNodeConstraints blk =>
Header blk -> SizeInBytes
estimateBlockSize (Header ByronBlock -> SizeInBytes)
-> (Header CardanoToByron -> Header ByronBlock)
-> Header CardanoToByron
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header CardanoToByron -> Header ByronBlock
unHeaderC2B

{------------------------------------------------------------------------------
  Cardano to Byron: NodeToClient
------------------------------------------------------------------------------}

encodeNodeToClientC2B ::
     forall f cardano c2b.
     ( SerialiseNodeToClient (CardanoBlock Crypto) (f (CardanoBlock Crypto))
     , Coercible cardano (f (CardanoBlock Crypto))
     )
  => Proxy f
  -> (c2b -> cardano)
  -> CodecConfig CardanoToByron
  -> BlockNodeToClientVersion CardanoToByron
  -> c2b
  -> Encoding
encodeNodeToClientC2B :: forall (f :: * -> *) cardano c2b.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToClientC2B Proxy f
_ c2b -> cardano
toCardano (CodecConfigC2B CodecConfig ByronBlock
ccfg) () c2b
x =
    forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk -> BlockNodeToClientVersion blk -> a -> Encoding
encodeNodeToClient
      @(CardanoBlock Crypto)
      (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg)
      BlockNodeToClientVersion (CardanoBlock Crypto)
cardanoNodeToClientVersion
      (c2b -> f (CardanoBlock Crypto)
toCardano' c2b
x)
  where
    toCardano' :: c2b -> f (CardanoBlock Crypto)
    toCardano' :: c2b -> f (CardanoBlock Crypto)
toCardano' = cardano -> f (CardanoBlock Crypto)
forall a b. Coercible a b => a -> b
coerce (cardano -> f (CardanoBlock Crypto))
-> (c2b -> cardano) -> c2b -> f (CardanoBlock Crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c2b -> cardano
toCardano

decodeNodeToClientC2B ::
     forall f byron c2b.
     ( SerialiseNodeToClient ByronBlock (f ByronBlock)
     , Coercible byron (f ByronBlock)
     )
  => Proxy f
  -> (byron -> c2b)
  -> CodecConfig CardanoToByron
  -> BlockNodeToClientVersion CardanoToByron
  -> forall s. Decoder s c2b
decodeNodeToClientC2B :: forall (f :: * -> *) byron c2b.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToClientC2B Proxy f
_ byron -> c2b
fromByron (CodecConfigC2B CodecConfig ByronBlock
ccfg) () =
    f ByronBlock -> c2b
fromByron' (f ByronBlock -> c2b) -> Decoder s (f ByronBlock) -> Decoder s c2b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall blk a.
SerialiseNodeToClient blk a =>
CodecConfig blk
-> BlockNodeToClientVersion blk -> forall s. Decoder s a
decodeNodeToClient @ByronBlock CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
byronNodeToClientVersion
  where
    fromByron' :: f ByronBlock -> c2b
    fromByron' :: f ByronBlock -> c2b
fromByron' = byron -> c2b
fromByron (byron -> c2b) -> (f ByronBlock -> byron) -> f ByronBlock -> c2b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f ByronBlock -> byron
forall a b. Coercible a b => a -> b
coerce

instance SerialiseNodeToClient CardanoToByron CardanoToByron where
  encodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> CardanoToByron
-> Encoding
encodeNodeToClient = Proxy I
-> (CardanoToByron -> CardanoBlock Crypto)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) (ByronBlock -> CardanoBlock Crypto
forall c. ByronBlock -> CardanoBlock c
BlockByron (ByronBlock -> CardanoBlock Crypto)
-> (CardanoToByron -> ByronBlock)
-> CardanoToByron
-> CardanoBlock Crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoToByron -> ByronBlock
unC2B)
  decodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s CardanoToByron
decodeNodeToClient = Proxy I
-> (ByronBlock -> CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s CardanoToByron
forall (f :: * -> *) byron c2b.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @I) ByronBlock -> CardanoToByron
C2B

instance SerialiseNodeToClient CardanoToByron (Serialised CardanoToByron) where
  encodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> Serialised CardanoToByron
-> Encoding
encodeNodeToClient = Proxy Serialised
-> (Serialised CardanoToByron -> Serialised CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> Serialised CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised) Serialised CardanoToByron -> Serialised CardanoToByron
forall a. a -> a
id
  decodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s (Serialised CardanoToByron)
decodeNodeToClient = Proxy Serialised
-> (Serialised CardanoToByron -> Serialised CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s (Serialised CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @Serialised) Serialised CardanoToByron -> Serialised CardanoToByron
forall a. a -> a
id

instance SerialiseNodeToClient CardanoToByron (GenTx CardanoToByron) where
  encodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> GenTx CardanoToByron
-> Encoding
encodeNodeToClient = Proxy GenTx
-> (GenTx CardanoToByron -> GenTx (CardanoBlock Crypto))
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> GenTx CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) (GenTx ByronBlock -> GenTx (CardanoBlock Crypto)
forall c. GenTx ByronBlock -> CardanoGenTx c
GenTxByron (GenTx ByronBlock -> GenTx (CardanoBlock Crypto))
-> (GenTx CardanoToByron -> GenTx ByronBlock)
-> GenTx CardanoToByron
-> GenTx (CardanoBlock Crypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx CardanoToByron -> GenTx ByronBlock
unGenTxC2B)
  decodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s (GenTx CardanoToByron)
decodeNodeToClient = Proxy GenTx
-> (GenTx ByronBlock -> GenTx CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s (GenTx CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @GenTx) GenTx ByronBlock -> GenTx CardanoToByron
GenTxC2B

instance SerialiseNodeToClient CardanoToByron (GenTxId CardanoToByron) where
  encodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> GenTxId CardanoToByron
-> Encoding
encodeNodeToClient = Proxy WrapGenTxId
-> (GenTxId CardanoToByron -> CardanoGenTxId Crypto)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> GenTxId CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId) (GenTxId ByronBlock -> CardanoGenTxId Crypto
forall c. GenTxId ByronBlock -> CardanoGenTxId c
GenTxIdByron (GenTxId ByronBlock -> CardanoGenTxId Crypto)
-> (GenTxId CardanoToByron -> GenTxId ByronBlock)
-> GenTxId CardanoToByron
-> CardanoGenTxId Crypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTxId CardanoToByron -> GenTxId ByronBlock
unGenTxIdC2B)
  decodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s (GenTxId CardanoToByron)
decodeNodeToClient = Proxy WrapGenTxId
-> (GenTxId ByronBlock -> GenTxId CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s (GenTxId CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapGenTxId) GenTxId ByronBlock -> GenTxId CardanoToByron
GenTxIdC2B

instance SerialiseNodeToClient CardanoToByron SlotNo

-- | @'ApplyTxErr' 'CardanoToByron'@
instance SerialiseNodeToClient CardanoToByron CC.ApplyMempoolPayloadErr where
  encodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> ApplyMempoolPayloadErr
-> Encoding
encodeNodeToClient = Proxy WrapApplyTxErr
-> (ApplyMempoolPayloadErr -> CardanoApplyTxErr Crypto)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> ApplyMempoolPayloadErr
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapApplyTxErr) ApplyMempoolPayloadErr -> CardanoApplyTxErr Crypto
ApplyTxErr ByronBlock -> CardanoApplyTxErr Crypto
forall c. ApplyTxErr ByronBlock -> CardanoApplyTxErr c
ApplyTxErrByron
  decodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s ApplyMempoolPayloadErr
decodeNodeToClient = Proxy WrapApplyTxErr
-> (ApplyMempoolPayloadErr -> ApplyMempoolPayloadErr)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s ApplyMempoolPayloadErr
forall (f :: * -> *) byron c2b.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToClientC2B (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @WrapApplyTxErr) ApplyMempoolPayloadErr -> ApplyMempoolPayloadErr
forall a. a -> a
id

instance SerialiseNodeToClient CardanoToByron (SomeSecond BlockQuery CardanoToByron) where
  encodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> SomeSecond BlockQuery CardanoToByron
-> Encoding
encodeNodeToClient =
      Proxy (SomeSecond BlockQuery)
-> (SomeSecond BlockQuery CardanoToByron
    -> SomeSecond BlockQuery (CardanoBlock Crypto))
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> SomeSecond BlockQuery CardanoToByron
-> Encoding
forall (f :: * -> *) cardano c2b.
(SerialiseNodeToClient
   (CardanoBlock Crypto) (f (CardanoBlock Crypto)),
 Coercible cardano (f (CardanoBlock Crypto))) =>
Proxy f
-> (c2b -> cardano)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> c2b
-> Encoding
encodeNodeToClientC2B
        (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(SomeSecond BlockQuery))
        (\(SomeSecond BlockQuery CardanoToByron b
q) -> BlockQuery (CardanoBlock Crypto) (CardanoQueryResult Crypto b)
-> SomeSecond BlockQuery (CardanoBlock Crypto)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery ByronBlock b
-> BlockQuery (CardanoBlock Crypto) (CardanoQueryResult Crypto b)
forall c a result.
(CardanoQueryResult c result ~ a) =>
BlockQuery ByronBlock result -> CardanoQuery c a
QueryIfCurrentByron (BlockQuery CardanoToByron b -> BlockQuery ByronBlock b
forall a. BlockQuery CardanoToByron a -> BlockQuery ByronBlock a
unQueryC2B BlockQuery CardanoToByron b
q)))
  decodeNodeToClient :: CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s (SomeSecond BlockQuery CardanoToByron)
decodeNodeToClient =
      Proxy (SomeSecond BlockQuery)
-> (SomeSecond BlockQuery ByronBlock
    -> SomeSecond BlockQuery CardanoToByron)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s (SomeSecond BlockQuery CardanoToByron)
forall (f :: * -> *) byron c2b.
(SerialiseNodeToClient ByronBlock (f ByronBlock),
 Coercible byron (f ByronBlock)) =>
Proxy f
-> (byron -> c2b)
-> CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> forall s. Decoder s c2b
decodeNodeToClientC2B
        (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(SomeSecond BlockQuery))
        (\(SomeSecond BlockQuery ByronBlock b
q) -> BlockQuery CardanoToByron b -> SomeSecond BlockQuery CardanoToByron
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery ByronBlock b -> BlockQuery CardanoToByron b
forall a. BlockQuery ByronBlock a -> BlockQuery CardanoToByron a
QueryC2B BlockQuery ByronBlock b
q))

instance SerialiseResult CardanoToByron (BlockQuery CardanoToByron) where
  encodeResult :: forall result.
CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> BlockQuery CardanoToByron result
-> result
-> Encoding
encodeResult (CodecConfigC2B CodecConfig ByronBlock
ccfg) () (QueryC2B BlockQuery ByronBlock result
q) (result
r :: result) =
      CodecConfig (CardanoBlock Crypto)
-> BlockNodeToClientVersion (CardanoBlock Crypto)
-> BlockQuery
     (CardanoBlock Crypto) (CardanoQueryResult Crypto result)
-> CardanoQueryResult Crypto result
-> Encoding
forall result.
CodecConfig (CardanoBlock Crypto)
-> BlockNodeToClientVersion (CardanoBlock Crypto)
-> BlockQuery (CardanoBlock Crypto) result
-> result
-> Encoding
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> result
-> Encoding
encodeResult
        (CodecConfig ByronBlock -> CodecConfig (CardanoBlock Crypto)
toCardanoCodecConfig CodecConfig ByronBlock
ccfg)
        BlockNodeToClientVersion (CardanoBlock Crypto)
cardanoNodeToClientVersion
        (BlockQuery ByronBlock result
-> BlockQuery
     (CardanoBlock Crypto) (CardanoQueryResult Crypto result)
forall c a result.
(CardanoQueryResult c result ~ a) =>
BlockQuery ByronBlock result -> CardanoQuery c a
QueryIfCurrentByron BlockQuery ByronBlock result
q)
        (result -> CardanoQueryResult Crypto result
forall result c. result -> CardanoQueryResult c result
QueryResultSuccess result
r :: CardanoQueryResult Crypto result)
  decodeResult :: forall result.
CodecConfig CardanoToByron
-> BlockNodeToClientVersion CardanoToByron
-> BlockQuery CardanoToByron result
-> forall s. Decoder s result
decodeResult (CodecConfigC2B CodecConfig ByronBlock
ccfg) () (QueryC2B BlockQuery ByronBlock result
q) =
      CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> BlockQuery ByronBlock result
-> forall s. Decoder s result
forall result.
CodecConfig ByronBlock
-> BlockNodeToClientVersion ByronBlock
-> BlockQuery ByronBlock result
-> forall s. Decoder s result
forall blk (query :: * -> *) result.
SerialiseResult blk query =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> query result
-> forall s. Decoder s result
decodeResult CodecConfig ByronBlock
ccfg BlockNodeToClientVersion ByronBlock
byronNodeToClientVersion BlockQuery ByronBlock result
q

instance SerialiseNodeToClientConstraints CardanoToByron

{------------------------------------------------------------------------------
  Cardano to Byron: Arbitrary instances
------------------------------------------------------------------------------}

instance Arbitrary CardanoToByron where
  arbitrary :: Gen CardanoToByron
arbitrary = ByronBlock -> CardanoToByron
C2B (ByronBlock -> CardanoToByron)
-> Gen ByronBlock -> Gen CardanoToByron
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByronBlock
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (Header CardanoToByron) where
  arbitrary :: Gen (Header CardanoToByron)
arbitrary = Header ByronBlock -> Header CardanoToByron
HeaderC2B (Header ByronBlock -> Header CardanoToByron)
-> Gen (Header ByronBlock) -> Gen (Header CardanoToByron)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen (WithVersion ByronNodeToNodeVersion (Header ByronBlock))
forall a. Arbitrary a => Gen a
arbitrary Gen (WithVersion ByronNodeToNodeVersion (Header ByronBlock))
-> (WithVersion ByronNodeToNodeVersion (Header ByronBlock)
    -> Maybe (Header ByronBlock))
-> Gen (Header ByronBlock)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` WithVersion ByronNodeToNodeVersion (Header ByronBlock)
-> Maybe (Header ByronBlock)
isRightVersion)
    where
      isRightVersion ::
           WithVersion ByronNodeToNodeVersion (Header ByronBlock)
        -> Maybe (Header ByronBlock)
      isRightVersion :: WithVersion ByronNodeToNodeVersion (Header ByronBlock)
-> Maybe (Header ByronBlock)
isRightVersion (WithVersion ByronNodeToNodeVersion
version Header ByronBlock
hdr)
        | ByronNodeToNodeVersion
version ByronNodeToNodeVersion -> ByronNodeToNodeVersion -> Bool
forall a. Eq a => a -> a -> Bool
== BlockNodeToNodeVersion ByronBlock
ByronNodeToNodeVersion
byronNodeToNodeVersion = Header ByronBlock -> Maybe (Header ByronBlock)
forall a. a -> Maybe a
Just Header ByronBlock
hdr
        | Bool
otherwise                         = Maybe (Header ByronBlock)
forall a. Maybe a
Nothing

instance Arbitrary (GenTx CardanoToByron) where
  arbitrary :: Gen (GenTx CardanoToByron)
arbitrary = GenTx ByronBlock -> GenTx CardanoToByron
GenTxC2B (GenTx ByronBlock -> GenTx CardanoToByron)
-> Gen (GenTx ByronBlock) -> Gen (GenTx CardanoToByron)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (GenTx ByronBlock)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (GenTxId CardanoToByron) where
  arbitrary :: Gen (GenTxId CardanoToByron)
arbitrary = GenTxId ByronBlock -> GenTxId CardanoToByron
GenTxIdC2B (GenTxId ByronBlock -> GenTxId CardanoToByron)
-> Gen (GenTxId ByronBlock) -> Gen (GenTxId CardanoToByron)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (GenTxId ByronBlock)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (SomeSecond BlockQuery CardanoToByron) where
  arbitrary :: Gen (SomeSecond BlockQuery CardanoToByron)
arbitrary = (\(SomeSecond BlockQuery ByronBlock b
q) -> BlockQuery CardanoToByron b -> SomeSecond BlockQuery CardanoToByron
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery ByronBlock b -> BlockQuery CardanoToByron b
forall a. BlockQuery ByronBlock a -> BlockQuery CardanoToByron a
QueryC2B BlockQuery ByronBlock b
q)) (SomeSecond BlockQuery ByronBlock
 -> SomeSecond BlockQuery CardanoToByron)
-> Gen (SomeSecond BlockQuery ByronBlock)
-> Gen (SomeSecond BlockQuery CardanoToByron)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SomeSecond BlockQuery ByronBlock)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (SomeResult CardanoToByron) where
  arbitrary :: Gen (SomeResult CardanoToByron)
arbitrary = (\(SomeResult BlockQuery ByronBlock result
q result
r) -> BlockQuery CardanoToByron result
-> result -> SomeResult CardanoToByron
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (BlockQuery ByronBlock result -> BlockQuery CardanoToByron result
forall a. BlockQuery ByronBlock a -> BlockQuery CardanoToByron a
QueryC2B BlockQuery ByronBlock result
q) result
r) (SomeResult ByronBlock -> SomeResult CardanoToByron)
-> Gen (SomeResult ByronBlock) -> Gen (SomeResult CardanoToByron)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SomeResult ByronBlock)
forall a. Arbitrary a => Gen a
arbitrary