{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Byron mempool integration
module Ouroboros.Consensus.Byron.Ledger.Mempool
  ( -- * Mempool integration
    GenTx (..)
  , TxId (..)
  , Validated (..)

    -- * Transaction IDs
  , byronIdDlg
  , byronIdProp
  , byronIdTx
  , byronIdVote

    -- * Serialisation
  , decodeByronApplyTxError
  , decodeByronGenTx
  , decodeByronGenTxId
  , encodeByronApplyTxError
  , encodeByronGenTx
  , encodeByronGenTxId

    -- * Low-level API (primarily for testing)
  , fromMempoolPayload
  , toMempoolPayload

    -- * Auxiliary functions
  , countByronGenTxs
  ) where

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Chain.Byron.API as CC
import qualified Cardano.Chain.Delegation as Delegation
import qualified Cardano.Chain.MempoolPayload as CC
import qualified Cardano.Chain.UTxO as Utxo
import qualified Cardano.Chain.Update as Update
import qualified Cardano.Chain.ValidationMode as CC
import Cardano.Crypto (hashDecoded)
import qualified Cardano.Crypto as CC
import Cardano.Ledger.Binary
  ( ByteSpan
  , DecoderError (..)
  , byronProtVer
  , fromByronCBOR
  , serialize
  , slice
  , toByronCBOR
  , unsafeDeserialize
  )
import Cardano.Ledger.Binary.Plain (enforceSize)
import Cardano.Prelude (Natural, cborError)
import Codec.CBOR.Decoding (Decoder)
import qualified Codec.CBOR.Decoding as CBOR
import Codec.CBOR.Encoding (Encoding)
import qualified Codec.CBOR.Encoding as CBOR
import Control.Monad (void)
import Control.Monad.Except (Except, throwError)
import Data.ByteString (ByteString)
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import Data.ByteString.Short (ShortByteString)
import Data.Maybe (maybeToList)
import Data.Word
import GHC.Generics (Generic)
import NoThunks.Class (InspectHeapNamed (..), NoThunks (..))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Byron.Ledger.Block
import Ouroboros.Consensus.Byron.Ledger.Conversions (toByronSlotNo)
import Ouroboros.Consensus.Byron.Ledger.Ledger
import Ouroboros.Consensus.Byron.Ledger.Orphans ()
import Ouroboros.Consensus.Byron.Ledger.Serialisation
  ( byronBlockEncodingOverhead
  )
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Util (ShowProxy (..))
import Ouroboros.Consensus.Util.Condense
import Ouroboros.Network.Tx (HasRawTxId (..))

{-------------------------------------------------------------------------------
  Transactions
-------------------------------------------------------------------------------}

-- | Generalized transactions in Byron
--
-- This is effectively the same as 'CC.AMempoolPayload' but we cache the
-- transaction ID (a hash).
data instance GenTx ByronBlock
  = ByronTx !Utxo.TxId !(Utxo.ATxAux ByteString)
  | ByronDlg !Delegation.CertificateId !(Delegation.ACertificate ByteString)
  | ByronUpdateProposal !Update.UpId !(Update.AProposal ByteString)
  | ByronUpdateVote !Update.VoteId !(Update.AVote ByteString)
  deriving (GenTx ByronBlock -> GenTx ByronBlock -> Bool
(GenTx ByronBlock -> GenTx ByronBlock -> Bool)
-> (GenTx ByronBlock -> GenTx ByronBlock -> Bool)
-> Eq (GenTx ByronBlock)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenTx ByronBlock -> GenTx ByronBlock -> Bool
== :: GenTx ByronBlock -> GenTx ByronBlock -> Bool
$c/= :: GenTx ByronBlock -> GenTx ByronBlock -> Bool
/= :: GenTx ByronBlock -> GenTx ByronBlock -> Bool
Eq, (forall x. GenTx ByronBlock -> Rep (GenTx ByronBlock) x)
-> (forall x. Rep (GenTx ByronBlock) x -> GenTx ByronBlock)
-> Generic (GenTx ByronBlock)
forall x. Rep (GenTx ByronBlock) x -> GenTx ByronBlock
forall x. GenTx ByronBlock -> Rep (GenTx ByronBlock) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenTx ByronBlock -> Rep (GenTx ByronBlock) x
from :: forall x. GenTx ByronBlock -> Rep (GenTx ByronBlock) x
$cto :: forall x. Rep (GenTx ByronBlock) x -> GenTx ByronBlock
to :: forall x. Rep (GenTx ByronBlock) x -> GenTx ByronBlock
Generic)
  deriving Context -> GenTx ByronBlock -> IO (Maybe ThunkInfo)
Proxy (GenTx ByronBlock) -> String
(Context -> GenTx ByronBlock -> IO (Maybe ThunkInfo))
-> (Context -> GenTx ByronBlock -> IO (Maybe ThunkInfo))
-> (Proxy (GenTx ByronBlock) -> String)
-> NoThunks (GenTx ByronBlock)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> GenTx ByronBlock -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx ByronBlock -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GenTx ByronBlock -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenTx ByronBlock -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (GenTx ByronBlock) -> String
showTypeOf :: Proxy (GenTx ByronBlock) -> String
NoThunks via InspectHeapNamed "GenTx ByronBlock" (GenTx ByronBlock)

instance ShowProxy (GenTx ByronBlock)

newtype instance Validated (GenTx ByronBlock) = ValidatedByronTx
  { Validated (GenTx ByronBlock) -> GenTx ByronBlock
forgetValidatedByronTx :: GenTx ByronBlock
  }
  deriving (Validated (GenTx ByronBlock)
-> Validated (GenTx ByronBlock) -> Bool
(Validated (GenTx ByronBlock)
 -> Validated (GenTx ByronBlock) -> Bool)
-> (Validated (GenTx ByronBlock)
    -> Validated (GenTx ByronBlock) -> Bool)
-> Eq (Validated (GenTx ByronBlock))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Validated (GenTx ByronBlock)
-> Validated (GenTx ByronBlock) -> Bool
== :: Validated (GenTx ByronBlock)
-> Validated (GenTx ByronBlock) -> Bool
$c/= :: Validated (GenTx ByronBlock)
-> Validated (GenTx ByronBlock) -> Bool
/= :: Validated (GenTx ByronBlock)
-> Validated (GenTx ByronBlock) -> Bool
Eq, (forall x.
 Validated (GenTx ByronBlock)
 -> Rep (Validated (GenTx ByronBlock)) x)
-> (forall x.
    Rep (Validated (GenTx ByronBlock)) x
    -> Validated (GenTx ByronBlock))
-> Generic (Validated (GenTx ByronBlock))
forall x.
Rep (Validated (GenTx ByronBlock)) x
-> Validated (GenTx ByronBlock)
forall x.
Validated (GenTx ByronBlock)
-> Rep (Validated (GenTx ByronBlock)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
Validated (GenTx ByronBlock)
-> Rep (Validated (GenTx ByronBlock)) x
from :: forall x.
Validated (GenTx ByronBlock)
-> Rep (Validated (GenTx ByronBlock)) x
$cto :: forall x.
Rep (Validated (GenTx ByronBlock)) x
-> Validated (GenTx ByronBlock)
to :: forall x.
Rep (Validated (GenTx ByronBlock)) x
-> Validated (GenTx ByronBlock)
Generic)
  deriving anyclass Context -> Validated (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
Proxy (Validated (GenTx ByronBlock)) -> String
(Context -> Validated (GenTx ByronBlock) -> IO (Maybe ThunkInfo))
-> (Context
    -> Validated (GenTx ByronBlock) -> IO (Maybe ThunkInfo))
-> (Proxy (Validated (GenTx ByronBlock)) -> String)
-> NoThunks (Validated (GenTx ByronBlock))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Validated (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
noThunks :: Context -> Validated (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Validated (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Validated (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (Validated (GenTx ByronBlock)) -> String
showTypeOf :: Proxy (Validated (GenTx ByronBlock)) -> String
NoThunks

type instance ApplyTxErr ByronBlock = CC.ApplyMempoolPayloadErr

-- orphaned instance
instance ShowProxy CC.ApplyMempoolPayloadErr

instance LedgerSupportsMempool ByronBlock where
  -- Check that the annotation is the canonical encoding. This is currently
  -- enforced by 'decodeByronGenTx', see its docstring for more context.
  txInvariant :: GenTx ByronBlock -> Bool
txInvariant GenTx ByronBlock
tx =
    AMempoolPayload ByteString -> ByteString
CC.mempoolPayloadRecoverBytes AMempoolPayload ByteString
tx' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== AMempoolPayload ByteString -> ByteString
forall a. AMempoolPayload a -> ByteString
CC.mempoolPayloadReencode AMempoolPayload ByteString
tx'
   where
    tx' :: AMempoolPayload ByteString
tx' = GenTx ByronBlock -> AMempoolPayload ByteString
toMempoolPayload GenTx ByronBlock
tx

  applyTx :: LedgerConfig ByronBlock
-> WhetherToIntervene
-> SlotNo
-> GenTx ByronBlock
-> TickedLedgerState ByronBlock ValuesMK
-> Except
     (ApplyTxErr ByronBlock)
     (TickedLedgerState ByronBlock DiffMK, Validated (GenTx ByronBlock))
applyTx LedgerConfig ByronBlock
cfg WhetherToIntervene
_wti SlotNo
slot GenTx ByronBlock
tx TickedLedgerState ByronBlock ValuesMK
st =
    (\TickedLedgerState ByronBlock DiffMK
st' -> (TickedLedgerState ByronBlock DiffMK
st', GenTx ByronBlock -> Validated (GenTx ByronBlock)
ValidatedByronTx GenTx ByronBlock
tx))
      (TickedLedgerState ByronBlock DiffMK
 -> (TickedLedgerState ByronBlock DiffMK,
     Validated (GenTx ByronBlock)))
-> ExceptT
     ApplyMempoolPayloadErr
     Identity
     (TickedLedgerState ByronBlock DiffMK)
-> ExceptT
     ApplyMempoolPayloadErr
     Identity
     (TickedLedgerState ByronBlock DiffMK, Validated (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> TickedLedgerState ByronBlock ValuesMK
-> Except
     (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock DiffMK)
forall (mk1 :: MapKind) (mk2 :: MapKind).
ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> TickedLedgerState ByronBlock mk1
-> Except
     (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock mk2)
applyByronGenTx ValidationMode
validationMode LedgerConfig ByronBlock
cfg SlotNo
slot GenTx ByronBlock
tx TickedLedgerState ByronBlock ValuesMK
st
   where
    validationMode :: ValidationMode
validationMode = BlockValidationMode -> TxValidationMode -> ValidationMode
CC.ValidationMode BlockValidationMode
CC.BlockValidation TxValidationMode
Utxo.TxValidation

  reapplyTx :: HasCallStack =>
LedgerConfig ByronBlock
-> SlotNo
-> Validated (GenTx ByronBlock)
-> TickedLedgerState ByronBlock ValuesMK
-> Except
     (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock ValuesMK)
reapplyTx LedgerConfig ByronBlock
cfg SlotNo
slot Validated (GenTx ByronBlock)
vtx TickedLedgerState ByronBlock ValuesMK
st =
    ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> TickedLedgerState ByronBlock ValuesMK
-> Except
     (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock ValuesMK)
forall (mk1 :: MapKind) (mk2 :: MapKind).
ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> TickedLedgerState ByronBlock mk1
-> Except
     (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock mk2)
applyByronGenTx ValidationMode
validationMode LedgerConfig ByronBlock
cfg SlotNo
slot (Validated (GenTx ByronBlock) -> GenTx ByronBlock
forgetValidatedByronTx Validated (GenTx ByronBlock)
vtx) TickedLedgerState ByronBlock ValuesMK
st
   where
    validationMode :: ValidationMode
validationMode = BlockValidationMode -> TxValidationMode -> ValidationMode
CC.ValidationMode BlockValidationMode
CC.NoBlockValidation TxValidationMode
Utxo.TxValidationNoCrypto

  txForgetValidated :: Validated (GenTx ByronBlock) -> GenTx ByronBlock
txForgetValidated = Validated (GenTx ByronBlock) -> GenTx ByronBlock
forgetValidatedByronTx

  getTransactionKeySets :: GenTx ByronBlock -> LedgerTables ByronBlock KeysMK
getTransactionKeySets GenTx ByronBlock
_ = LedgerTables ByronBlock KeysMK
forall (mk :: MapKind) blk.
(ZeroableMK mk, LedgerTableConstraints blk) =>
LedgerTables blk mk
emptyLedgerTables

  mkMempoolApplyTxError :: forall (mk :: MapKind).
TickedLedgerState ByronBlock mk
-> Text -> Maybe (ApplyTxErr ByronBlock)
mkMempoolApplyTxError = TickedLedgerState ByronBlock mk
-> Text -> Maybe (ApplyTxErr ByronBlock)
forall blk (mk :: MapKind).
TickedLedgerState blk mk -> Text -> Maybe (ApplyTxErr blk)
nothingMkMempoolApplyTxError

instance TxLimits ByronBlock where
  type TxMeasurePhase1 ByronBlock = IgnoringOverflow ByteSize32
  type TxMeasurePhase2 ByronBlock = TrivialTxMeasurePhase2

  txWireSize :: GenTx ByronBlock -> SizeInBytes
txWireSize =
    (SizeInBytes -> SizeInBytes -> SizeInBytes
forall a. Num a => a -> a -> a
+ SizeInBytes
2)
      -- 2 bytes overhead added by `EncCBOR (AMempoolPayload
      -- ByteString)` instance
      (SizeInBytes -> SizeInBytes)
-> (GenTx ByronBlock -> SizeInBytes)
-> GenTx ByronBlock
-> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> SizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral
      (Int -> SizeInBytes)
-> (GenTx ByronBlock -> Int) -> GenTx ByronBlock -> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
Strict.length
      (ByteString -> Int)
-> (GenTx ByronBlock -> ByteString) -> GenTx ByronBlock -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AMempoolPayload ByteString -> ByteString
CC.mempoolPayloadRecoverBytes
      (AMempoolPayload ByteString -> ByteString)
-> (GenTx ByronBlock -> AMempoolPayload ByteString)
-> GenTx ByronBlock
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx ByronBlock -> AMempoolPayload ByteString
toMempoolPayload

  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerConfig ByronBlock
-> TickedLedgerState ByronBlock mk -> TxMeasure ByronBlock
blockCapacityTxMeasure LedgerConfig ByronBlock
_cfg TickedLedgerState ByronBlock mk
st =
    TxMeasurePhase1 ByronBlock
-> TxMeasurePhase2 ByronBlock -> TxMeasure ByronBlock
forall blk.
TxMeasurePhase1 blk -> TxMeasurePhase2 blk -> TxMeasure blk
TxMeasure
      ( ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$
          Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$
            ChainValidationState -> Word32
CC.getMaxBlockSize ChainValidationState
cvs Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
byronBlockEncodingOverhead
      )
      TrivialTxMeasurePhase2
TxMeasurePhase2 ByronBlock
TrivialTxMeasurePhase2
   where
    cvs :: ChainValidationState
cvs = TickedLedgerState ByronBlock mk -> ChainValidationState
forall (mk :: MapKind).
Ticked LedgerState ByronBlock mk -> ChainValidationState
tickedByronLedgerState TickedLedgerState ByronBlock mk
st

  txMeasurePhase1 :: LedgerConfig ByronBlock
-> TickedLedgerState ByronBlock EmptyMK
-> GenTx ByronBlock
-> Except (ApplyTxErr ByronBlock) (TxMeasurePhase1 ByronBlock)
txMeasurePhase1 LedgerConfig ByronBlock
_cfg TickedLedgerState ByronBlock EmptyMK
st GenTx ByronBlock
tx =
    if Natural
txszNat Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
maxTxSize
      then ApplyMempoolPayloadErr
-> ExceptT
     ApplyMempoolPayloadErr Identity (IgnoringOverflow ByteSize32)
forall a.
ApplyMempoolPayloadErr -> ExceptT ApplyMempoolPayloadErr Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ApplyMempoolPayloadErr
err
      else
        IgnoringOverflow ByteSize32
-> ExceptT
     (ApplyTxErr ByronBlock) Identity (IgnoringOverflow ByteSize32)
forall a. a -> ExceptT (ApplyTxErr ByronBlock) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IgnoringOverflow ByteSize32
 -> ExceptT
      (ApplyTxErr ByronBlock) Identity (IgnoringOverflow ByteSize32))
-> IgnoringOverflow ByteSize32
-> ExceptT
     (ApplyTxErr ByronBlock) Identity (IgnoringOverflow ByteSize32)
forall a b. (a -> b) -> a -> b
$ ByteSize32 -> IgnoringOverflow ByteSize32
forall a. a -> IgnoringOverflow a
IgnoringOverflow (ByteSize32 -> IgnoringOverflow ByteSize32)
-> ByteSize32 -> IgnoringOverflow ByteSize32
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteSize32
ByteSize32 (Word32 -> ByteSize32) -> Word32 -> ByteSize32
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
txsz
   where
    maxTxSize :: Natural
maxTxSize =
      ProtocolParameters -> Natural
Update.ppMaxTxSize (ProtocolParameters -> Natural) -> ProtocolParameters -> Natural
forall a b. (a -> b) -> a -> b
$
        State -> ProtocolParameters
CC.adoptedProtocolParameters (State -> ProtocolParameters) -> State -> ProtocolParameters
forall a b. (a -> b) -> a -> b
$
          ChainValidationState -> State
CC.cvsUpdateState (ChainValidationState -> State) -> ChainValidationState -> State
forall a b. (a -> b) -> a -> b
$
            TickedLedgerState ByronBlock EmptyMK -> ChainValidationState
forall (mk :: MapKind).
Ticked LedgerState ByronBlock mk -> ChainValidationState
tickedByronLedgerState TickedLedgerState ByronBlock EmptyMK
st

    txszNat :: Natural
txszNat = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
txsz :: Natural

    txsz :: Int
txsz =
      ByteString -> Int
Strict.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$
        AMempoolPayload ByteString -> ByteString
CC.mempoolPayloadRecoverBytes (AMempoolPayload ByteString -> ByteString)
-> AMempoolPayload ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
          GenTx ByronBlock -> AMempoolPayload ByteString
toMempoolPayload GenTx ByronBlock
tx

    err :: ApplyMempoolPayloadErr
err =
      UTxOValidationError -> ApplyMempoolPayloadErr
CC.MempoolTxErr (UTxOValidationError -> ApplyMempoolPayloadErr)
-> UTxOValidationError -> ApplyMempoolPayloadErr
forall a b. (a -> b) -> a -> b
$
        TxValidationError -> UTxOValidationError
Utxo.UTxOValidationTxValidationError (TxValidationError -> UTxOValidationError)
-> TxValidationError -> UTxOValidationError
forall a b. (a -> b) -> a -> b
$
          Natural -> Natural -> TxValidationError
Utxo.TxValidationTxTooLarge Natural
txszNat Natural
maxTxSize

  txMeasurePhase2 :: LedgerConfig ByronBlock
-> TickedLedgerState ByronBlock ValuesMK
-> GenTx ByronBlock
-> Except (ApplyTxErr ByronBlock) (TxMeasurePhase2 ByronBlock)
txMeasurePhase2 LedgerConfig ByronBlock
_ TickedLedgerState ByronBlock ValuesMK
_ GenTx ByronBlock
_ = TrivialTxMeasurePhase2
-> ExceptT ApplyMempoolPayloadErr Identity TrivialTxMeasurePhase2
forall a. a -> ExceptT ApplyMempoolPayloadErr Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TrivialTxMeasurePhase2
TrivialTxMeasurePhase2

data instance TxId (GenTx ByronBlock)
  = ByronTxId !Utxo.TxId
  | ByronDlgId !Delegation.CertificateId
  | ByronUpdateProposalId !Update.UpId
  | ByronUpdateVoteId !Update.VoteId
  deriving (TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
(TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool)
-> (TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool)
-> Eq (TxId (GenTx ByronBlock))
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
== :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
$c/= :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
/= :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
Eq, Eq (TxId (GenTx ByronBlock))
Eq (TxId (GenTx ByronBlock)) =>
(TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Ordering)
-> (TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool)
-> (TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool)
-> (TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool)
-> (TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool)
-> (TxId (GenTx ByronBlock)
    -> TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock))
-> (TxId (GenTx ByronBlock)
    -> TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock))
-> Ord (TxId (GenTx ByronBlock))
TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Ordering
TxId (GenTx ByronBlock)
-> TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock)
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
$ccompare :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Ordering
compare :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Ordering
$c< :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
< :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
$c<= :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
<= :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
$c> :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
> :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
$c>= :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
>= :: TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock) -> Bool
$cmax :: TxId (GenTx ByronBlock)
-> TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock)
max :: TxId (GenTx ByronBlock)
-> TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock)
$cmin :: TxId (GenTx ByronBlock)
-> TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock)
min :: TxId (GenTx ByronBlock)
-> TxId (GenTx ByronBlock) -> TxId (GenTx ByronBlock)
Ord)
  deriving Context -> TxId (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
Proxy (TxId (GenTx ByronBlock)) -> String
(Context -> TxId (GenTx ByronBlock) -> IO (Maybe ThunkInfo))
-> (Context -> TxId (GenTx ByronBlock) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx ByronBlock)) -> String)
-> NoThunks (TxId (GenTx ByronBlock))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TxId (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxId (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxId (GenTx ByronBlock) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (TxId (GenTx ByronBlock)) -> String
showTypeOf :: Proxy (TxId (GenTx ByronBlock)) -> String
NoThunks via InspectHeapNamed "TxId (GenTx ByronBlock)" (TxId (GenTx ByronBlock))

instance ShowProxy (TxId (GenTx ByronBlock))

instance HasTxId (GenTx ByronBlock) where
  txId :: GenTx ByronBlock -> TxId (GenTx ByronBlock)
txId (ByronTx AbstractHash Blake2b_256 Tx
i ATxAux ByteString
_) = AbstractHash Blake2b_256 Tx -> TxId (GenTx ByronBlock)
ByronTxId AbstractHash Blake2b_256 Tx
i
  txId (ByronDlg AbstractHash Blake2b_256 Certificate
i ACertificate ByteString
_) = AbstractHash Blake2b_256 Certificate -> TxId (GenTx ByronBlock)
ByronDlgId AbstractHash Blake2b_256 Certificate
i
  txId (ByronUpdateProposal AbstractHash Blake2b_256 Proposal
i AProposal ByteString
_) = AbstractHash Blake2b_256 Proposal -> TxId (GenTx ByronBlock)
ByronUpdateProposalId AbstractHash Blake2b_256 Proposal
i
  txId (ByronUpdateVote AbstractHash Blake2b_256 Vote
i AVote ByteString
_) = AbstractHash Blake2b_256 Vote -> TxId (GenTx ByronBlock)
ByronUpdateVoteId AbstractHash Blake2b_256 Vote
i

instance ConvertRawTxId (GenTx ByronBlock) where
  toRawTxIdHash :: TxId (GenTx ByronBlock) -> ShortByteString
toRawTxIdHash (ByronTxId AbstractHash Blake2b_256 Tx
i) = AbstractHash Blake2b_256 Tx -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort AbstractHash Blake2b_256 Tx
i
  toRawTxIdHash (ByronDlgId AbstractHash Blake2b_256 Certificate
i) = AbstractHash Blake2b_256 Certificate -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort AbstractHash Blake2b_256 Certificate
i
  toRawTxIdHash (ByronUpdateProposalId AbstractHash Blake2b_256 Proposal
i) = AbstractHash Blake2b_256 Proposal -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort AbstractHash Blake2b_256 Proposal
i
  toRawTxIdHash (ByronUpdateVoteId AbstractHash Blake2b_256 Vote
i) = AbstractHash Blake2b_256 Vote -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort AbstractHash Blake2b_256 Vote
i

instance HasRawTxId (TxId (GenTx ByronBlock)) where
  type RawTxId (TxId (GenTx ByronBlock)) = ShortByteString
  getRawTxId :: TxId (GenTx ByronBlock) -> RawTxId (TxId (GenTx ByronBlock))
getRawTxId = TxId (GenTx ByronBlock) -> ShortByteString
TxId (GenTx ByronBlock) -> RawTxId (TxId (GenTx ByronBlock))
forall tx. ConvertRawTxId tx => TxId tx -> ShortByteString
toRawTxIdHash

instance HasTxs ByronBlock where
  extractTxs :: ByronBlock -> [GenTx ByronBlock]
extractTxs ByronBlock
blk = case ByronBlock -> ABlockOrBoundary ByteString
byronBlockRaw ByronBlock
blk of
    -- EBBs don't contain transactions
    CC.ABOBBoundary ABoundaryBlock ByteString
_ebb -> []
    CC.ABOBBlock ABlock ByteString
regularBlk ->
      AMempoolPayload ByteString -> GenTx ByronBlock
fromMempoolPayload
        (AMempoolPayload ByteString -> GenTx ByronBlock)
-> [AMempoolPayload ByteString] -> [GenTx ByronBlock]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (AMempoolPayload ByteString) -> [AMempoolPayload ByteString]
forall a. Maybe a -> [a]
maybeToList Maybe (AMempoolPayload ByteString)
proposal [AMempoolPayload ByteString]
-> [AMempoolPayload ByteString] -> [AMempoolPayload ByteString]
forall a. Semigroup a => a -> a -> a
<> [AMempoolPayload ByteString]
votes [AMempoolPayload ByteString]
-> [AMempoolPayload ByteString] -> [AMempoolPayload ByteString]
forall a. Semigroup a => a -> a -> a
<> [AMempoolPayload ByteString]
dlgs [AMempoolPayload ByteString]
-> [AMempoolPayload ByteString] -> [AMempoolPayload ByteString]
forall a. Semigroup a => a -> a -> a
<> [AMempoolPayload ByteString]
txs
     where
      body :: ABody ByteString
body = ABlock ByteString -> ABody ByteString
forall a. ABlock a -> ABody a
CC.blockBody ABlock ByteString
regularBlk

      txs :: [AMempoolPayload ByteString]
txs = ATxAux ByteString -> AMempoolPayload ByteString
forall a. ATxAux a -> AMempoolPayload a
CC.MempoolTx (ATxAux ByteString -> AMempoolPayload ByteString)
-> [ATxAux ByteString] -> [AMempoolPayload ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ATxPayload ByteString -> [ATxAux ByteString]
forall a. ATxPayload a -> [ATxAux a]
Utxo.aUnTxPayload (ABody ByteString -> ATxPayload ByteString
forall a. ABody a -> ATxPayload a
CC.bodyTxPayload ABody ByteString
body)
      proposal :: Maybe (AMempoolPayload ByteString)
proposal = AProposal ByteString -> AMempoolPayload ByteString
forall a. AProposal a -> AMempoolPayload a
CC.MempoolUpdateProposal (AProposal ByteString -> AMempoolPayload ByteString)
-> Maybe (AProposal ByteString)
-> Maybe (AMempoolPayload ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> APayload ByteString -> Maybe (AProposal ByteString)
forall a. APayload a -> Maybe (AProposal a)
Update.payloadProposal (ABody ByteString -> APayload ByteString
forall a. ABody a -> APayload a
CC.bodyUpdatePayload ABody ByteString
body)
      votes :: [AMempoolPayload ByteString]
votes = AVote ByteString -> AMempoolPayload ByteString
forall a. AVote a -> AMempoolPayload a
CC.MempoolUpdateVote (AVote ByteString -> AMempoolPayload ByteString)
-> [AVote ByteString] -> [AMempoolPayload ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> APayload ByteString -> [AVote ByteString]
forall a. APayload a -> [AVote a]
Update.payloadVotes (ABody ByteString -> APayload ByteString
forall a. ABody a -> APayload a
CC.bodyUpdatePayload ABody ByteString
body)
      dlgs :: [AMempoolPayload ByteString]
dlgs = ACertificate ByteString -> AMempoolPayload ByteString
forall a. ACertificate a -> AMempoolPayload a
CC.MempoolDlg (ACertificate ByteString -> AMempoolPayload ByteString)
-> [ACertificate ByteString] -> [AMempoolPayload ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> APayload ByteString -> [ACertificate ByteString]
forall a. APayload a -> [ACertificate a]
Delegation.getPayload (ABody ByteString -> APayload ByteString
forall a. ABody a -> APayload a
CC.bodyDlgPayload ABody ByteString
body)

{-------------------------------------------------------------------------------
  Conversion to and from 'AMempoolPayload'
-------------------------------------------------------------------------------}

toMempoolPayload :: GenTx ByronBlock -> CC.AMempoolPayload ByteString
toMempoolPayload :: GenTx ByronBlock -> AMempoolPayload ByteString
toMempoolPayload = GenTx ByronBlock -> AMempoolPayload ByteString
go
 where
  -- Just extract the payload @p@
  go :: GenTx ByronBlock -> CC.AMempoolPayload ByteString
  go :: GenTx ByronBlock -> AMempoolPayload ByteString
go (ByronTx AbstractHash Blake2b_256 Tx
_ ATxAux ByteString
p) = ATxAux ByteString -> AMempoolPayload ByteString
forall a. ATxAux a -> AMempoolPayload a
CC.MempoolTx ATxAux ByteString
p
  go (ByronDlg AbstractHash Blake2b_256 Certificate
_ ACertificate ByteString
p) = ACertificate ByteString -> AMempoolPayload ByteString
forall a. ACertificate a -> AMempoolPayload a
CC.MempoolDlg ACertificate ByteString
p
  go (ByronUpdateProposal AbstractHash Blake2b_256 Proposal
_ AProposal ByteString
p) = AProposal ByteString -> AMempoolPayload ByteString
forall a. AProposal a -> AMempoolPayload a
CC.MempoolUpdateProposal AProposal ByteString
p
  go (ByronUpdateVote AbstractHash Blake2b_256 Vote
_ AVote ByteString
p) = AVote ByteString -> AMempoolPayload ByteString
forall a. AVote a -> AMempoolPayload a
CC.MempoolUpdateVote AVote ByteString
p

fromMempoolPayload :: CC.AMempoolPayload ByteString -> GenTx ByronBlock
fromMempoolPayload :: AMempoolPayload ByteString -> GenTx ByronBlock
fromMempoolPayload = AMempoolPayload ByteString -> GenTx ByronBlock
go
 where
  -- Bundle the payload @p@ with its ID
  go :: CC.AMempoolPayload ByteString -> GenTx ByronBlock
  go :: AMempoolPayload ByteString -> GenTx ByronBlock
go (CC.MempoolTx ATxAux ByteString
p) = AbstractHash Blake2b_256 Tx
-> ATxAux ByteString -> GenTx ByronBlock
ByronTx (ATxAux ByteString -> AbstractHash Blake2b_256 Tx
byronIdTx ATxAux ByteString
p) ATxAux ByteString
p
  go (CC.MempoolDlg ACertificate ByteString
p) = AbstractHash Blake2b_256 Certificate
-> ACertificate ByteString -> GenTx ByronBlock
ByronDlg (ACertificate ByteString -> AbstractHash Blake2b_256 Certificate
byronIdDlg ACertificate ByteString
p) ACertificate ByteString
p
  go (CC.MempoolUpdateProposal AProposal ByteString
p) = AbstractHash Blake2b_256 Proposal
-> AProposal ByteString -> GenTx ByronBlock
ByronUpdateProposal (AProposal ByteString -> AbstractHash Blake2b_256 Proposal
byronIdProp AProposal ByteString
p) AProposal ByteString
p
  go (CC.MempoolUpdateVote AVote ByteString
p) = AbstractHash Blake2b_256 Vote
-> AVote ByteString -> GenTx ByronBlock
ByronUpdateVote (AVote ByteString -> AbstractHash Blake2b_256 Vote
byronIdVote AVote ByteString
p) AVote ByteString
p

{-------------------------------------------------------------------------------
  Auxiliary: transaction IDs
-------------------------------------------------------------------------------}

-- TODO: move to cardano-ledger-byron (cardano-ledger-byron#581)
byronIdTx :: Utxo.ATxAux ByteString -> Utxo.TxId
byronIdTx :: ATxAux ByteString -> AbstractHash Blake2b_256 Tx
byronIdTx = Annotated Tx ByteString
-> Hash (BaseType (Annotated Tx ByteString))
Annotated Tx ByteString -> AbstractHash Blake2b_256 Tx
forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded (Annotated Tx ByteString -> AbstractHash Blake2b_256 Tx)
-> (ATxAux ByteString -> Annotated Tx ByteString)
-> ATxAux ByteString
-> AbstractHash Blake2b_256 Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ATxAux ByteString -> Annotated Tx ByteString
forall a. ATxAux a -> Annotated Tx a
Utxo.aTaTx

byronIdDlg :: Delegation.ACertificate ByteString -> Delegation.CertificateId
byronIdDlg :: ACertificate ByteString -> AbstractHash Blake2b_256 Certificate
byronIdDlg = ACertificate ByteString -> AbstractHash Blake2b_256 Certificate
Delegation.recoverCertificateId

byronIdProp :: Update.AProposal ByteString -> Update.UpId
byronIdProp :: AProposal ByteString -> AbstractHash Blake2b_256 Proposal
byronIdProp = AProposal ByteString -> AbstractHash Blake2b_256 Proposal
Update.recoverUpId

byronIdVote :: Update.AVote ByteString -> Update.VoteId
byronIdVote :: AVote ByteString -> AbstractHash Blake2b_256 Vote
byronIdVote = AVote ByteString -> AbstractHash Blake2b_256 Vote
Update.recoverVoteId

{-------------------------------------------------------------------------------
  Pretty-printing
-------------------------------------------------------------------------------}

instance Condense (GenTx ByronBlock) where
  condense :: GenTx ByronBlock -> String
condense = AMempoolPayload ByteString -> String
forall a. Condense a => a -> String
condense (AMempoolPayload ByteString -> String)
-> (GenTx ByronBlock -> AMempoolPayload ByteString)
-> GenTx ByronBlock
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx ByronBlock -> AMempoolPayload ByteString
toMempoolPayload

instance Condense (GenTxId ByronBlock) where
  condense :: TxId (GenTx ByronBlock) -> String
condense (ByronTxId AbstractHash Blake2b_256 Tx
i) = AbstractHash Blake2b_256 Tx -> String
forall a. Condense a => a -> String
condense AbstractHash Blake2b_256 Tx
i
  condense (ByronDlgId AbstractHash Blake2b_256 Certificate
i) = AbstractHash Blake2b_256 Certificate -> String
forall a. Condense a => a -> String
condense AbstractHash Blake2b_256 Certificate
i
  condense (ByronUpdateProposalId AbstractHash Blake2b_256 Proposal
i) = AbstractHash Blake2b_256 Proposal -> String
forall a. Condense a => a -> String
condense AbstractHash Blake2b_256 Proposal
i
  condense (ByronUpdateVoteId AbstractHash Blake2b_256 Vote
i) = AbstractHash Blake2b_256 Vote -> String
forall a. Condense a => a -> String
condense AbstractHash Blake2b_256 Vote
i

instance Show (GenTx ByronBlock) where
  show :: GenTx ByronBlock -> String
show = GenTx ByronBlock -> String
forall a. Condense a => a -> String
condense

instance Show (Validated (GenTx ByronBlock)) where
  show :: Validated (GenTx ByronBlock) -> String
show Validated (GenTx ByronBlock)
vtx = String
"Validated-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenTx ByronBlock -> String
forall a. Condense a => a -> String
condense (Validated (GenTx ByronBlock) -> GenTx ByronBlock
forgetValidatedByronTx Validated (GenTx ByronBlock)
vtx)

instance Show (GenTxId ByronBlock) where
  show :: TxId (GenTx ByronBlock) -> String
show = TxId (GenTx ByronBlock) -> String
forall a. Condense a => a -> String
condense

{-------------------------------------------------------------------------------
  Applying transactions
-------------------------------------------------------------------------------}

applyByronGenTx ::
  CC.ValidationMode ->
  LedgerConfig ByronBlock ->
  SlotNo ->
  GenTx ByronBlock ->
  TickedLedgerState ByronBlock mk1 ->
  Except (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock mk2)
applyByronGenTx :: forall (mk1 :: MapKind) (mk2 :: MapKind).
ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> TickedLedgerState ByronBlock mk1
-> Except
     (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock mk2)
applyByronGenTx ValidationMode
validationMode LedgerConfig ByronBlock
cfg SlotNo
slot GenTx ByronBlock
genTx TickedLedgerState ByronBlock mk1
st =
  (\ChainValidationState
state -> TickedLedgerState ByronBlock mk1
st{tickedByronLedgerState = state})
    (ChainValidationState -> TickedLedgerState ByronBlock mk2)
-> ExceptT ApplyMempoolPayloadErr Identity ChainValidationState
-> ExceptT
     ApplyMempoolPayloadErr Identity (TickedLedgerState ByronBlock mk2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValidationMode
-> Config
-> SlotNumber
-> AMempoolPayload ByteString
-> ChainValidationState
-> ExceptT ApplyMempoolPayloadErr Identity ChainValidationState
forall (m :: * -> *).
MonadError ApplyMempoolPayloadErr m =>
ValidationMode
-> Config
-> SlotNumber
-> AMempoolPayload ByteString
-> ChainValidationState
-> m ChainValidationState
CC.applyMempoolPayload
      ValidationMode
validationMode
      Config
LedgerConfig ByronBlock
cfg
      (SlotNo -> SlotNumber
toByronSlotNo SlotNo
slot)
      (GenTx ByronBlock -> AMempoolPayload ByteString
toMempoolPayload GenTx ByronBlock
genTx)
      (TickedLedgerState ByronBlock mk1 -> ChainValidationState
forall (mk :: MapKind).
Ticked LedgerState ByronBlock mk -> ChainValidationState
tickedByronLedgerState TickedLedgerState ByronBlock mk1
st)

{-------------------------------------------------------------------------------
  Serialisation
-------------------------------------------------------------------------------}

encodeByronGenTx :: GenTx ByronBlock -> Encoding
encodeByronGenTx :: GenTx ByronBlock -> Encoding
encodeByronGenTx GenTx ByronBlock
genTx = AMempoolPayload ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (GenTx ByronBlock -> AMempoolPayload ByteString
toMempoolPayload GenTx ByronBlock
genTx)

-- | The 'ByteString' annotation will be the canonical encoding.
--
-- While the new implementation does not care about canonical encodings, the
-- old one does. When a generalised transaction arrives that is not in its
-- canonical encoding (only the 'CC.UTxO.ATxAux' of the 'ByronTx' can be
-- produced by nodes that are not under our control), the old implementation
-- will reject it. Therefore, we need to reject them too. See #905.
--
-- We use the ledger to check for canonical encodings: the ledger will check
-- whether the signed hash of the transaction (in the case of a
-- 'CC.UTxO.ATxAux', the transaction witness) matches the annotated
-- bytestring. Is therefore __important__ that the annotated bytestring be the
-- /canonical/ encoding, not the /original, possibly non-canonical/ encoding.
decodeByronGenTx :: Decoder s (GenTx ByronBlock)
decodeByronGenTx :: forall s. Decoder s (GenTx ByronBlock)
decodeByronGenTx = AMempoolPayload ByteString -> GenTx ByronBlock
fromMempoolPayload (AMempoolPayload ByteString -> GenTx ByronBlock)
-> (AMempoolPayload ByteSpan -> AMempoolPayload ByteString)
-> AMempoolPayload ByteSpan
-> GenTx ByronBlock
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AMempoolPayload ByteSpan -> AMempoolPayload ByteString
canonicalise (AMempoolPayload ByteSpan -> GenTx ByronBlock)
-> Decoder s (AMempoolPayload ByteSpan)
-> Decoder s (GenTx ByronBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (AMempoolPayload ByteSpan)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
 where
  -- Fill in the 'ByteString' annotation with a canonical encoding of the
  -- 'GenTx'. We must reserialise the deserialised 'GenTx' to be sure we
  -- have the canonical one. We don't have access to the original
  -- 'ByteString' anyway, so having to reserialise here gives us a
  -- 'ByteString' we can use.
  canonicalise ::
    CC.AMempoolPayload ByteSpan ->
    CC.AMempoolPayload ByteString
  canonicalise :: AMempoolPayload ByteSpan -> AMempoolPayload ByteString
canonicalise AMempoolPayload ByteSpan
mp = LazyByteString -> ByteString
Lazy.toStrict (LazyByteString -> ByteString)
-> (ByteSpan -> LazyByteString) -> ByteSpan -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteSpan -> LazyByteString
slice LazyByteString
canonicalBytes (ByteSpan -> ByteString)
-> AMempoolPayload ByteSpan -> AMempoolPayload ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AMempoolPayload ByteSpan
mp'
   where
    canonicalBytes :: LazyByteString
canonicalBytes = Version -> AMempoolPayload () -> LazyByteString
forall a. EncCBOR a => Version -> a -> LazyByteString
serialize Version
byronProtVer (AMempoolPayload ByteSpan -> AMempoolPayload ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void AMempoolPayload ByteSpan
mp)
    -- 'unsafeDeserialize' cannot fail, since we just 'serialize'd it.
    -- Note that we cannot reuse @mp@, as its 'ByteSpan' might differ from
    -- the canonical encoding's 'ByteSpan'.
    mp' :: AMempoolPayload ByteSpan
mp' = Version -> LazyByteString -> AMempoolPayload ByteSpan
forall a. DecCBOR a => Version -> LazyByteString -> a
unsafeDeserialize Version
byronProtVer LazyByteString
canonicalBytes

encodeByronGenTxId :: GenTxId ByronBlock -> Encoding
encodeByronGenTxId :: TxId (GenTx ByronBlock) -> Encoding
encodeByronGenTxId TxId (GenTx ByronBlock)
genTxId =
  [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
    [ Word -> Encoding
CBOR.encodeListLen Word
2
    , case TxId (GenTx ByronBlock)
genTxId of
        ByronTxId AbstractHash Blake2b_256 Tx
i -> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Word8
0 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AbstractHash Blake2b_256 Tx -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR AbstractHash Blake2b_256 Tx
i
        ByronDlgId AbstractHash Blake2b_256 Certificate
i -> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Word8
1 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AbstractHash Blake2b_256 Certificate -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR AbstractHash Blake2b_256 Certificate
i
        ByronUpdateProposalId AbstractHash Blake2b_256 Proposal
i -> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Word8
2 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AbstractHash Blake2b_256 Proposal -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR AbstractHash Blake2b_256 Proposal
i
        ByronUpdateVoteId AbstractHash Blake2b_256 Vote
i -> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Word8
3 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> AbstractHash Blake2b_256 Vote -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR AbstractHash Blake2b_256 Vote
i
    ]

decodeByronGenTxId :: Decoder s (GenTxId ByronBlock)
decodeByronGenTxId :: forall s. Decoder s (TxId (GenTx ByronBlock))
decodeByronGenTxId = do
  Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"GenTxId (ByronBlock cfg)" Int
2
  Decoder s Word8
forall s. Decoder s Word8
CBOR.decodeWord8 Decoder s Word8
-> (Word8 -> Decoder s (TxId (GenTx ByronBlock)))
-> Decoder s (TxId (GenTx ByronBlock))
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> AbstractHash Blake2b_256 Tx -> TxId (GenTx ByronBlock)
ByronTxId (AbstractHash Blake2b_256 Tx -> TxId (GenTx ByronBlock))
-> Decoder s (AbstractHash Blake2b_256 Tx)
-> Decoder s (TxId (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (AbstractHash Blake2b_256 Tx)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
    Word8
1 -> AbstractHash Blake2b_256 Certificate -> TxId (GenTx ByronBlock)
ByronDlgId (AbstractHash Blake2b_256 Certificate -> TxId (GenTx ByronBlock))
-> Decoder s (AbstractHash Blake2b_256 Certificate)
-> Decoder s (TxId (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (AbstractHash Blake2b_256 Certificate)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
    Word8
2 -> AbstractHash Blake2b_256 Proposal -> TxId (GenTx ByronBlock)
ByronUpdateProposalId (AbstractHash Blake2b_256 Proposal -> TxId (GenTx ByronBlock))
-> Decoder s (AbstractHash Blake2b_256 Proposal)
-> Decoder s (TxId (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (AbstractHash Blake2b_256 Proposal)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
    Word8
3 -> AbstractHash Blake2b_256 Vote -> TxId (GenTx ByronBlock)
ByronUpdateVoteId (AbstractHash Blake2b_256 Vote -> TxId (GenTx ByronBlock))
-> Decoder s (AbstractHash Blake2b_256 Vote)
-> Decoder s (TxId (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (AbstractHash Blake2b_256 Vote)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
    Word8
tag ->
      DecoderError -> Decoder s (TxId (GenTx ByronBlock))
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s (TxId (GenTx ByronBlock)))
-> DecoderError -> Decoder s (TxId (GenTx ByronBlock))
forall a b. (a -> b) -> a -> b
$
        Text -> Word -> DecoderError
DecoderErrorUnknownTag Text
"GenTxId (ByronBlock cfg)" (Word -> DecoderError) -> Word -> DecoderError
forall a b. (a -> b) -> a -> b
$
          forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word8 @Word Word8
tag

encodeByronApplyTxError :: ApplyTxErr ByronBlock -> Encoding
encodeByronApplyTxError :: ApplyTxErr ByronBlock -> Encoding
encodeByronApplyTxError = ApplyMempoolPayloadErr -> Encoding
ApplyTxErr ByronBlock -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

decodeByronApplyTxError :: Decoder s (ApplyTxErr ByronBlock)
decodeByronApplyTxError :: forall s. Decoder s (ApplyTxErr ByronBlock)
decodeByronApplyTxError = Decoder s ApplyMempoolPayloadErr
Decoder s (ApplyTxErr ByronBlock)
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

{-------------------------------------------------------------------------------
  Auxiliary functions
-------------------------------------------------------------------------------}

-- | Count all (generalized) transactions in the block
countByronGenTxs :: ByronBlock -> Word64
countByronGenTxs :: ByronBlock -> Word64
countByronGenTxs = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (ByronBlock -> Int) -> ByronBlock -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenTx ByronBlock] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([GenTx ByronBlock] -> Int)
-> (ByronBlock -> [GenTx ByronBlock]) -> ByronBlock -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronBlock -> [GenTx ByronBlock]
forall blk. HasTxs blk => blk -> [GenTx blk]
extractTxs