{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# 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.Update as Update
import qualified Cardano.Chain.UTxO as Utxo
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.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

{-------------------------------------------------------------------------------
  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) where

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 where

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 =>
ComputeDiffs
-> LedgerConfig ByronBlock
-> SlotNo
-> Validated (GenTx ByronBlock)
-> TickedLedgerState ByronBlock ValuesMK
-> Except
     (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock TrackingMK)
reapplyTx ComputeDiffs
_ 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 TrackingMK)
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 (LedgerState ByronBlock) KeysMK
getTransactionKeySets GenTx ByronBlock
_ = LedgerTables (LedgerState ByronBlock) KeysMK
forall (mk :: MapKind) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables

instance TxLimits ByronBlock where
  type TxMeasure ByronBlock = IgnoringOverflow ByteSize32

  blockCapacityTxMeasure :: forall (mk :: MapKind).
LedgerConfig ByronBlock
-> TickedLedgerState ByronBlock mk -> TxMeasure ByronBlock
blockCapacityTxMeasure LedgerConfig ByronBlock
_cfg TickedLedgerState ByronBlock mk
st =
      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
    where
      cvs :: ChainValidationState
cvs = TickedLedgerState ByronBlock mk -> ChainValidationState
forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ChainValidationState
tickedByronLedgerState TickedLedgerState ByronBlock mk
st

  txMeasure :: LedgerConfig ByronBlock
-> TickedLedgerState ByronBlock ValuesMK
-> GenTx ByronBlock
-> Except (ApplyTxErr ByronBlock) (TxMeasure ByronBlock)
txMeasure LedgerConfig ByronBlock
_cfg TickedLedgerState ByronBlock ValuesMK
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
      TxMeasure ByronBlock
-> Except (ApplyTxErr ByronBlock) (TxMeasure ByronBlock)
forall a. a -> ExceptT (ApplyTxErr ByronBlock) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMeasure ByronBlock
 -> Except (ApplyTxErr ByronBlock) (TxMeasure ByronBlock))
-> TxMeasure ByronBlock
-> Except (ApplyTxErr ByronBlock) (TxMeasure ByronBlock)
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 ValuesMK -> ChainValidationState
forall (mk :: MapKind).
Ticked (LedgerState ByronBlock) mk -> ChainValidationState
tickedByronLedgerState TickedLedgerState ByronBlock ValuesMK
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

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)) where

instance HasTxId (GenTx ByronBlock) where
  txId :: GenTx ByronBlock -> TxId (GenTx ByronBlock)
txId (ByronTx             TxId
i ATxAux ByteString
_) = TxId -> TxId (GenTx ByronBlock)
ByronTxId             TxId
i
  txId (ByronDlg            CertificateId
i ACertificate ByteString
_) = CertificateId -> TxId (GenTx ByronBlock)
ByronDlgId            CertificateId
i
  txId (ByronUpdateProposal UpId
i AProposal ByteString
_) = UpId -> TxId (GenTx ByronBlock)
ByronUpdateProposalId UpId
i
  txId (ByronUpdateVote     VoteId
i AVote ByteString
_) = VoteId -> TxId (GenTx ByronBlock)
ByronUpdateVoteId     VoteId
i

instance ConvertRawTxId (GenTx ByronBlock) where
  toRawTxIdHash :: TxId (GenTx ByronBlock) -> ShortByteString
toRawTxIdHash (ByronTxId             TxId
i) = TxId -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort TxId
i
  toRawTxIdHash (ByronDlgId            CertificateId
i) = CertificateId -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort CertificateId
i
  toRawTxIdHash (ByronUpdateProposalId UpId
i) = UpId -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort UpId
i
  toRawTxIdHash (ByronUpdateVoteId     VoteId
i) = VoteId -> ShortByteString
forall algo a. AbstractHash algo a -> ShortByteString
CC.abstractHashToShort VoteId
i

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             TxId
_ ATxAux ByteString
p) = ATxAux ByteString -> AMempoolPayload ByteString
forall a. ATxAux a -> AMempoolPayload a
CC.MempoolTx             ATxAux ByteString
p
    go (ByronDlg            CertificateId
_ ACertificate ByteString
p) = ACertificate ByteString -> AMempoolPayload ByteString
forall a. ACertificate a -> AMempoolPayload a
CC.MempoolDlg            ACertificate ByteString
p
    go (ByronUpdateProposal UpId
_ AProposal ByteString
p) = AProposal ByteString -> AMempoolPayload ByteString
forall a. AProposal a -> AMempoolPayload a
CC.MempoolUpdateProposal AProposal ByteString
p
    go (ByronUpdateVote     VoteId
_ 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) = TxId -> ATxAux ByteString -> GenTx ByronBlock
ByronTx             (ATxAux ByteString -> TxId
byronIdTx   ATxAux ByteString
p) ATxAux ByteString
p
    go (CC.MempoolDlg            ACertificate ByteString
p) = CertificateId -> ACertificate ByteString -> GenTx ByronBlock
ByronDlg            (ACertificate ByteString -> CertificateId
byronIdDlg  ACertificate ByteString
p) ACertificate ByteString
p
    go (CC.MempoolUpdateProposal AProposal ByteString
p) = UpId -> AProposal ByteString -> GenTx ByronBlock
ByronUpdateProposal (AProposal ByteString -> UpId
byronIdProp AProposal ByteString
p) AProposal ByteString
p
    go (CC.MempoolUpdateVote     AVote ByteString
p) = VoteId -> AVote ByteString -> GenTx ByronBlock
ByronUpdateVote     (AVote ByteString -> VoteId
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 -> TxId
byronIdTx = Annotated Tx ByteString
-> Hash (BaseType (Annotated Tx ByteString))
Annotated Tx ByteString -> TxId
forall t. Decoded t => t -> Hash (BaseType t)
hashDecoded (Annotated Tx ByteString -> TxId)
-> (ATxAux ByteString -> Annotated Tx ByteString)
-> ATxAux ByteString
-> TxId
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 -> CertificateId
byronIdDlg = ACertificate ByteString -> CertificateId
Delegation.recoverCertificateId

byronIdProp :: Update.AProposal ByteString -> Update.UpId
byronIdProp :: AProposal ByteString -> UpId
byronIdProp = AProposal ByteString -> UpId
Update.recoverUpId

byronIdVote :: Update.AVote ByteString -> Update.VoteId
byronIdVote :: AVote ByteString -> VoteId
byronIdVote = AVote ByteString -> VoteId
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             TxId
i) = TxId -> String
forall a. Condense a => a -> String
condense TxId
i
  condense (ByronDlgId            CertificateId
i) = CertificateId -> String
forall a. Condense a => a -> String
condense CertificateId
i
  condense (ByronUpdateProposalId UpId
i) = UpId -> String
forall a. Condense a => a -> String
condense UpId
i
  condense (ByronUpdateVoteId     VoteId
i) = VoteId -> String
forall a. Condense a => a -> String
condense VoteId
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             TxId
i -> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Word8
0 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> TxId -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR TxId
i
        ByronDlgId            CertificateId
i -> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Word8
1 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CertificateId -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR CertificateId
i
        ByronUpdateProposalId UpId
i -> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Word8
2 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UpId -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR UpId
i
        ByronUpdateVoteId     VoteId
i -> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR (Word8
3 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VoteId -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR VoteId
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   -> TxId -> TxId (GenTx ByronBlock)
ByronTxId             (TxId -> TxId (GenTx ByronBlock))
-> Decoder s TxId -> Decoder s (TxId (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s TxId
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
      Word8
1   -> CertificateId -> TxId (GenTx ByronBlock)
ByronDlgId            (CertificateId -> TxId (GenTx ByronBlock))
-> Decoder s CertificateId -> Decoder s (TxId (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s CertificateId
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
      Word8
2   -> UpId -> TxId (GenTx ByronBlock)
ByronUpdateProposalId (UpId -> TxId (GenTx ByronBlock))
-> Decoder s UpId -> Decoder s (TxId (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s UpId
forall a s. DecCBOR a => Decoder s a
fromByronCBOR
      Word8
3   -> VoteId -> TxId (GenTx ByronBlock)
ByronUpdateVoteId     (VoteId -> TxId (GenTx ByronBlock))
-> Decoder s VoteId -> Decoder s (TxId (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s VoteId
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 -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"GenTxId (ByronBlock cfg)" 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