{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveAnyClass        #-}
{-# LANGUAGE DerivingVia           #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# OPTIONS_GHC -Wno-orphans           #-}
module Cardano.Protocol.Socket.Type where

import Codec.Serialise.Class (Serialise)
import Control.Monad (forever)
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadTimer
import Crypto.Hash (SHA256, hash)
import Data.Aeson.Extras qualified as JSON
import Data.ByteArray qualified as BA
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Map ((!))
import Data.Text qualified as Text
import Data.Time.Units.Extra ()
import Data.Void (Void)

import GHC.Generics
import NoThunks.Class (NoThunks (noThunks, showTypeOf, wNoThunks))

import Cardano.Api (NetworkId (..))
import Cardano.Api qualified as C
import Cardano.Chain.Slotting (EpochSlots (..))
import Codec.Serialise (DeserialiseFailure)
import Codec.Serialise qualified as CBOR
import Network.TypedProtocol.Codec
import Ouroboros.Consensus.Byron.Ledger qualified as Byron
import Ouroboros.Consensus.Cardano.Block (CardanoBlock, CodecConfig (..))
import Ouroboros.Consensus.Network.NodeToClient (ClientCodecs, clientCodecs)
import Ouroboros.Consensus.Node.NetworkProtocolVersion (BlockNodeToClientVersion, supportedNodeToClientVersions)
import Ouroboros.Consensus.Shelley.Eras (StandardCrypto)
import Ouroboros.Consensus.Shelley.Ledger qualified as Shelley
import Ouroboros.Network.Block (HeaderHash, Point, StandardHash)
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Network.Mux
import Ouroboros.Network.NodeToClient (NodeToClientVersion (..), NodeToClientVersionData (..))
import Ouroboros.Network.Protocol.ChainSync.Codec qualified as ChainSync
import Ouroboros.Network.Protocol.ChainSync.Type qualified as ChainSync
import Ouroboros.Network.Protocol.LocalTxSubmission.Codec qualified as TxSubmission
import Ouroboros.Network.Protocol.LocalTxSubmission.Type qualified as TxSubmission
import Ouroboros.Network.Util.ShowProxy

import PlutusTx.Builtins qualified as PlutusTx
import Prettyprinter.Extras

import Ledger (Block, OnChainTx (..), TxId (..))

-- | Tip of the block chain type (used by node protocols).
type Tip = Block

-- | The node protocols require a block header type.
newtype BlockId = BlockId { BlockId -> ByteString
getBlockId :: BS.ByteString }
  deriving (BlockId -> BlockId -> Bool
(BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool) -> Eq BlockId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockId -> BlockId -> Bool
$c/= :: BlockId -> BlockId -> Bool
== :: BlockId -> BlockId -> Bool
$c== :: BlockId -> BlockId -> Bool
Eq, Eq BlockId
Eq BlockId
-> (BlockId -> BlockId -> Ordering)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> Bool)
-> (BlockId -> BlockId -> BlockId)
-> (BlockId -> BlockId -> BlockId)
-> Ord BlockId
BlockId -> BlockId -> Bool
BlockId -> BlockId -> Ordering
BlockId -> BlockId -> BlockId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BlockId -> BlockId -> BlockId
$cmin :: BlockId -> BlockId -> BlockId
max :: BlockId -> BlockId -> BlockId
$cmax :: BlockId -> BlockId -> BlockId
>= :: BlockId -> BlockId -> Bool
$c>= :: BlockId -> BlockId -> Bool
> :: BlockId -> BlockId -> Bool
$c> :: BlockId -> BlockId -> Bool
<= :: BlockId -> BlockId -> Bool
$c<= :: BlockId -> BlockId -> Bool
< :: BlockId -> BlockId -> Bool
$c< :: BlockId -> BlockId -> Bool
compare :: BlockId -> BlockId -> Ordering
$ccompare :: BlockId -> BlockId -> Ordering
$cp1Ord :: Eq BlockId
Ord, (forall x. BlockId -> Rep BlockId x)
-> (forall x. Rep BlockId x -> BlockId) -> Generic BlockId
forall x. Rep BlockId x -> BlockId
forall x. BlockId -> Rep BlockId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockId x -> BlockId
$cfrom :: forall x. BlockId -> Rep BlockId x
Generic)
  deriving newtype (Decoder s BlockId
Decoder s [BlockId]
[BlockId] -> Encoding
BlockId -> Encoding
(BlockId -> Encoding)
-> (forall s. Decoder s BlockId)
-> ([BlockId] -> Encoding)
-> (forall s. Decoder s [BlockId])
-> Serialise BlockId
forall s. Decoder s [BlockId]
forall s. Decoder s BlockId
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [BlockId]
$cdecodeList :: forall s. Decoder s [BlockId]
encodeList :: [BlockId] -> Encoding
$cencodeList :: [BlockId] -> Encoding
decode :: Decoder s BlockId
$cdecode :: forall s. Decoder s BlockId
encode :: BlockId -> Encoding
$cencode :: BlockId -> Encoding
Serialise, Context -> BlockId -> IO (Maybe ThunkInfo)
Proxy BlockId -> String
(Context -> BlockId -> IO (Maybe ThunkInfo))
-> (Context -> BlockId -> IO (Maybe ThunkInfo))
-> (Proxy BlockId -> String)
-> NoThunks BlockId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy BlockId -> String
$cshowTypeOf :: Proxy BlockId -> String
wNoThunks :: Context -> BlockId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> BlockId -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockId -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> BlockId -> IO (Maybe ThunkInfo)
NoThunks)
  deriving [BlockId] -> Doc ann
BlockId -> Doc ann
(forall ann. BlockId -> Doc ann)
-> (forall ann. [BlockId] -> Doc ann) -> Pretty BlockId
forall ann. [BlockId] -> Doc ann
forall ann. BlockId -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [BlockId] -> Doc ann
$cprettyList :: forall ann. [BlockId] -> Doc ann
pretty :: BlockId -> Doc ann
$cpretty :: forall ann. BlockId -> Doc ann
Pretty via (PrettyShow BlockId)

instance Show BlockId where
    show :: BlockId -> String
show = Text -> String
Text.unpack (Text -> String) -> (BlockId -> Text) -> BlockId -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
JSON.encodeByteString (ByteString -> Text) -> (BlockId -> ByteString) -> BlockId -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockId -> ByteString
getBlockId

-- | A hash of the block's contents.
blockId :: Block -> BlockId
blockId :: Block -> BlockId
blockId = ByteString -> BlockId
BlockId
        (ByteString -> BlockId)
-> (Block -> ByteString) -> Block -> BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
        (Digest SHA256 -> ByteString)
-> (Block -> Digest SHA256) -> Block -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArrayAccess ByteString, HashAlgorithm SHA256) =>
ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @_ @SHA256
        (ByteString -> Digest SHA256)
-> (Block -> ByteString) -> Block -> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
        (ByteString -> ByteString)
-> (Block -> ByteString) -> Block -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> ByteString
forall a. Serialise a => a -> ByteString
CBOR.serialise

-- | Explains why our (plutus) data structures are hashable.
type instance HeaderHash (C.Tx C.BabbageEra) = TxId
type instance HeaderHash Block = BlockId
deriving instance StandardHash (C.Tx C.BabbageEra)

-- TODO: Is this the best place for these instances?
instance ShowProxy Char
instance ShowProxy (C.Tx C.BabbageEra) where
instance ShowProxy OnChainTx where
instance ShowProxy a => ShowProxy [a] where
  showProxy :: Proxy [a] -> String
showProxy Proxy [a]
_ = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Proxy a -> String
forall k (p :: k). ShowProxy p => Proxy p -> String
showProxy (Proxy a
forall k (t :: k). Proxy t
Proxy @a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

deriving instance StandardHash Block

instance NoThunks PlutusTx.BuiltinByteString where
  noThunks :: Context -> BuiltinByteString -> IO (Maybe ThunkInfo)
noThunks Context
ctx BuiltinByteString
b = Context -> ByteString -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks Context
ctx (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
b)
  wNoThunks :: Context -> BuiltinByteString -> IO (Maybe ThunkInfo)
wNoThunks Context
ctx BuiltinByteString
b = Context -> ByteString -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
wNoThunks Context
ctx (BuiltinByteString -> ByteString
forall arep a. FromBuiltin arep a => arep -> a
PlutusTx.fromBuiltin BuiltinByteString
b)
  showTypeOf :: Proxy BuiltinByteString -> String
showTypeOf Proxy BuiltinByteString
_ = Proxy ByteString -> String
forall a. NoThunks a => Proxy a -> String
showTypeOf (Proxy ByteString
forall k (t :: k). Proxy t
Proxy @BS.ByteString)

deriving newtype instance NoThunks TxId

-- | Limits for the protocols we use.
maximumMiniProtocolLimits :: MiniProtocolLimits
maximumMiniProtocolLimits :: MiniProtocolLimits
maximumMiniProtocolLimits =
    MiniProtocolLimits :: Int -> MiniProtocolLimits
MiniProtocolLimits {
        maximumIngressQueue :: Int
maximumIngressQueue = Int
forall a. Bounded a => a
maxBound
    }

-- | Protocol versions
nodeToClientVersion :: NodeToClientVersion
nodeToClientVersion :: NodeToClientVersion
nodeToClientVersion = NodeToClientVersion
NodeToClientV_13

-- | A temporary definition of the protocol version. This will be moved as an
-- argument to the client connection function in a future PR (the network magic
-- number matches the one in the test net created by scripts)
cfgNetworkMagic :: NetworkMagic
cfgNetworkMagic :: NetworkMagic
cfgNetworkMagic = Word32 -> NetworkMagic
NetworkMagic Word32
1097911063

cfgNetworkId :: NetworkId
cfgNetworkId :: NetworkId
cfgNetworkId    = NetworkMagic -> NetworkId
Testnet NetworkMagic
cfgNetworkMagic

nodeToClientVersionData :: NodeToClientVersionData
nodeToClientVersionData :: NodeToClientVersionData
nodeToClientVersionData = NodeToClientVersionData :: NetworkMagic -> NodeToClientVersionData
NodeToClientVersionData { networkMagic :: NetworkMagic
networkMagic = NetworkMagic
cfgNetworkMagic }

-- | A protocol client that will never leave the initial state.
doNothingInitiatorProtocol
  :: MonadTimer m => RunMiniProtocol 'InitiatorMode BSL.ByteString m a Void
doNothingInitiatorProtocol :: RunMiniProtocol 'InitiatorMode ByteString m a Void
doNothingInitiatorProtocol =
    MuxPeer ByteString m a
-> RunMiniProtocol 'InitiatorMode ByteString m a Void
forall bytes (m :: * -> *) a.
MuxPeer bytes m a -> RunMiniProtocol 'InitiatorMode bytes m a Void
InitiatorProtocolOnly (MuxPeer ByteString m a
 -> RunMiniProtocol 'InitiatorMode ByteString m a Void)
-> MuxPeer ByteString m a
-> RunMiniProtocol 'InitiatorMode ByteString m a Void
forall a b. (a -> b) -> a -> b
$ (Channel m ByteString -> m (a, Maybe ByteString))
-> MuxPeer ByteString m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw ((Channel m ByteString -> m (a, Maybe ByteString))
 -> MuxPeer ByteString m a)
-> (Channel m ByteString -> m (a, Maybe ByteString))
-> MuxPeer ByteString m a
forall a b. (a -> b) -> a -> b
$
    m (a, Maybe ByteString)
-> Channel m ByteString -> m (a, Maybe ByteString)
forall a b. a -> b -> a
const (m (a, Maybe ByteString)
 -> Channel m ByteString -> m (a, Maybe ByteString))
-> m (a, Maybe ByteString)
-> Channel m ByteString
-> m (a, Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ m () -> m (a, Maybe ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m (a, Maybe ByteString))
-> m () -> m (a, Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1e6

doNothingResponderProtocol
  :: MonadTimer m => RunMiniProtocol 'ResponderMode BSL.ByteString m Void a
doNothingResponderProtocol :: RunMiniProtocol 'ResponderMode ByteString m Void a
doNothingResponderProtocol =
  MuxPeer ByteString m a
-> RunMiniProtocol 'ResponderMode ByteString m Void a
forall bytes (m :: * -> *) b.
MuxPeer bytes m b -> RunMiniProtocol 'ResponderMode bytes m Void b
ResponderProtocolOnly (MuxPeer ByteString m a
 -> RunMiniProtocol 'ResponderMode ByteString m Void a)
-> MuxPeer ByteString m a
-> RunMiniProtocol 'ResponderMode ByteString m Void a
forall a b. (a -> b) -> a -> b
$ (Channel m ByteString -> m (a, Maybe ByteString))
-> MuxPeer ByteString m a
forall (m :: * -> *) bytes a.
(Channel m bytes -> m (a, Maybe bytes)) -> MuxPeer bytes m a
MuxPeerRaw ((Channel m ByteString -> m (a, Maybe ByteString))
 -> MuxPeer ByteString m a)
-> (Channel m ByteString -> m (a, Maybe ByteString))
-> MuxPeer ByteString m a
forall a b. (a -> b) -> a -> b
$
  m (a, Maybe ByteString)
-> Channel m ByteString -> m (a, Maybe ByteString)
forall a b. a -> b -> a
const (m (a, Maybe ByteString)
 -> Channel m ByteString -> m (a, Maybe ByteString))
-> m (a, Maybe ByteString)
-> Channel m ByteString
-> m (a, Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ m () -> m (a, Maybe ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (m () -> m (a, Maybe ByteString))
-> m () -> m (a, Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ DiffTime -> m ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1e6

type Offset = Integer

-- | Boilerplate codecs used for protocol serialisation.

-- | The number of epochSlots is specific to each blockchain instance. This value
-- is what the cardano main and testnet uses. Only applies to the Byron era.
epochSlots :: EpochSlots
epochSlots :: EpochSlots
epochSlots = Word64 -> EpochSlots
EpochSlots Word64
21600

codecVersion :: BlockNodeToClientVersion (CardanoBlock StandardCrypto)
codecVersion :: BlockNodeToClientVersion (CardanoBlock StandardCrypto)
codecVersion = Map
  NodeToClientVersion
  (HardForkNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto))
versionMap Map
  NodeToClientVersion
  (HardForkNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto))
-> NodeToClientVersion
-> HardForkNodeToClientVersion
     (ByronBlock : CardanoShelleyEras StandardCrypto)
forall k a. Ord k => Map k a -> k -> a
! NodeToClientVersion
nodeToClientVersion
  where
    versionMap :: Map
  NodeToClientVersion
  (BlockNodeToClientVersion (CardanoBlock StandardCrypto))
versionMap =
      Proxy (CardanoBlock StandardCrypto)
-> Map
     NodeToClientVersion
     (BlockNodeToClientVersion (CardanoBlock StandardCrypto))
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions
        (Proxy (CardanoBlock StandardCrypto)
forall k (t :: k). Proxy t
Proxy @(CardanoBlock StandardCrypto))

codecConfig :: CodecConfig (CardanoBlock StandardCrypto)
codecConfig :: CodecConfig (CardanoBlock StandardCrypto)
codecConfig =
  CodecConfig ByronBlock
-> CodecConfig
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
-> CodecConfig
     (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
-> CodecConfig (CardanoBlock StandardCrypto)
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))
-> CardanoCodecConfig c
CardanoCodecConfig
    (EpochSlots -> CodecConfig ByronBlock
Byron.ByronCodecConfig EpochSlots
epochSlots)
    CodecConfig
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
    CodecConfig
  (ShelleyBlock (TPraos StandardCrypto) (AllegraEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
    CodecConfig
  (ShelleyBlock (TPraos StandardCrypto) (MaryEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
    CodecConfig
  (ShelleyBlock (TPraos StandardCrypto) (AlonzoEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig
    CodecConfig
  (ShelleyBlock (Praos StandardCrypto) (BabbageEra StandardCrypto))
forall proto era. CodecConfig (ShelleyBlock proto era)
Shelley.ShelleyCodecConfig

nodeToClientCodecs
  :: forall m. MonadST m
  => ClientCodecs (CardanoBlock StandardCrypto) m
nodeToClientCodecs :: ClientCodecs (CardanoBlock StandardCrypto) m
nodeToClientCodecs =
  CodecConfig (CardanoBlock StandardCrypto)
-> BlockNodeToClientVersion (CardanoBlock StandardCrypto)
-> NodeToClientVersion
-> ClientCodecs (CardanoBlock StandardCrypto) m
forall (m :: * -> *) blk.
(MonadST m, SerialiseNodeToClientConstraints blk,
 ShowQuery (BlockQuery blk), StandardHash blk,
 Serialise (HeaderHash blk)) =>
CodecConfig blk
-> BlockNodeToClientVersion blk
-> NodeToClientVersion
-> ClientCodecs blk m
clientCodecs CodecConfig (CardanoBlock StandardCrypto)
codecConfig BlockNodeToClientVersion (CardanoBlock StandardCrypto)
codecVersion NodeToClientVersion
nodeToClientVersion

-- | These codecs are currently used in the mock nodes and will
--   probably soon get removed as the mock nodes are phased out.
chainSyncCodec
  :: forall block.
     ( Serialise block
     , Serialise (HeaderHash block)
     )
  => Codec (ChainSync.ChainSync block (Point block) Tip)
           DeserialiseFailure
           IO BSL.ByteString
chainSyncCodec :: Codec
  (ChainSync block (Point block) Block)
  DeserialiseFailure
  IO
  ByteString
chainSyncCodec =
    (block -> Encoding)
-> (forall s. Decoder s block)
-> (Point block -> Encoding)
-> (forall s. Decoder s (Point block))
-> (Block -> Encoding)
-> (forall s. Decoder s Block)
-> Codec
     (ChainSync block (Point block) Block)
     DeserialiseFailure
     IO
     ByteString
forall header point tip (m :: * -> *).
MonadST m =>
(header -> Encoding)
-> (forall s. Decoder s header)
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (tip -> Encoding)
-> (forall s. Decoder s tip)
-> Codec
     (ChainSync header point tip) DeserialiseFailure m ByteString
ChainSync.codecChainSync
      block -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode             forall s. Decoder s block
forall a s. Serialise a => Decoder s a
CBOR.decode
      Point block -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode             forall s. Decoder s (Point block)
forall a s. Serialise a => Decoder s a
CBOR.decode
      Block -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode             forall s. Decoder s Block
forall a s. Serialise a => Decoder s a
CBOR.decode

txSubmissionCodec :: Codec (TxSubmission.LocalTxSubmission (C.Tx C.BabbageEra) String)
                           DeserialiseFailure
                           IO BSL.ByteString
txSubmissionCodec :: Codec
  (LocalTxSubmission (Tx BabbageEra) String)
  DeserialiseFailure
  IO
  ByteString
txSubmissionCodec =
    (Tx BabbageEra -> Encoding)
-> (forall s. Decoder s (Tx BabbageEra))
-> (String -> Encoding)
-> (forall s. Decoder s String)
-> Codec
     (LocalTxSubmission (Tx BabbageEra) String)
     DeserialiseFailure
     IO
     ByteString
forall tx reject (m :: * -> *).
MonadST m =>
(tx -> Encoding)
-> (forall s. Decoder s tx)
-> (reject -> Encoding)
-> (forall s. Decoder s reject)
-> Codec
     (LocalTxSubmission tx reject) DeserialiseFailure m ByteString
TxSubmission.codecLocalTxSubmission
      (ByteString -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode (ByteString -> Encoding)
-> (Tx BabbageEra -> ByteString) -> Tx BabbageEra -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx BabbageEra -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR) forall s. Decoder s (Tx BabbageEra)
decodeTx
      String -> Encoding
forall a. Serialise a => a -> Encoding
CBOR.encode forall s. Decoder s String
forall a s. Serialise a => Decoder s a
CBOR.decode
    where
        decodeTx :: Decoder s (Tx BabbageEra)
decodeTx = do
          ByteString
bs <- Decoder s ByteString
forall a s. Serialise a => Decoder s a
CBOR.decode
          (DecoderError -> Decoder s (Tx BabbageEra))
-> (Tx BabbageEra -> Decoder s (Tx BabbageEra))
-> Either DecoderError (Tx BabbageEra)
-> Decoder s (Tx BabbageEra)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
              (Decoder s (Tx BabbageEra)
-> DecoderError -> Decoder s (Tx BabbageEra)
forall a b. a -> b -> a
const (Decoder s (Tx BabbageEra)
 -> DecoderError -> Decoder s (Tx BabbageEra))
-> Decoder s (Tx BabbageEra)
-> DecoderError
-> Decoder s (Tx BabbageEra)
forall a b. (a -> b) -> a -> b
$ String -> Decoder s (Tx BabbageEra)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't deserialize tx")
              Tx BabbageEra -> Decoder s (Tx BabbageEra)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (AsType (Tx BabbageEra)
-> ByteString -> Either DecoderError (Tx BabbageEra)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
C.deserialiseFromCBOR (AsType BabbageEra -> AsType (Tx BabbageEra)
forall era. AsType era -> AsType (Tx era)
C.AsTx AsType BabbageEra
C.AsBabbageEra) ByteString
bs)