{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Byron.Ledger.Mempool (
GenTx (..)
, TxId (..)
, Validated (..)
, byronIdDlg
, byronIdProp
, byronIdTx
, byronIdVote
, decodeByronApplyTxError
, decodeByronGenTx
, decodeByronGenTxId
, encodeByronApplyTxError
, encodeByronGenTx
, encodeByronGenTxId
, fromMempoolPayload
, toMempoolPayload
, 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.Util (ShowProxy (..))
import Ouroboros.Consensus.Util.Condense
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
instance ShowProxy CC.ApplyMempoolPayloadErr where
instance LedgerSupportsMempool ByronBlock where
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
-> Ticked (LedgerState ByronBlock)
-> Except
(ApplyTxErr ByronBlock)
(Ticked (LedgerState ByronBlock), Validated (GenTx ByronBlock))
applyTx LedgerConfig ByronBlock
cfg WhetherToIntervene
_wti SlotNo
slot GenTx ByronBlock
tx Ticked (LedgerState ByronBlock)
st =
(\Ticked (LedgerState ByronBlock)
st' -> (Ticked (LedgerState ByronBlock)
st', GenTx ByronBlock -> Validated (GenTx ByronBlock)
ValidatedByronTx GenTx ByronBlock
tx))
(Ticked (LedgerState ByronBlock)
-> (Ticked (LedgerState ByronBlock), Validated (GenTx ByronBlock)))
-> ExceptT
ApplyMempoolPayloadErr Identity (Ticked (LedgerState ByronBlock))
-> ExceptT
ApplyMempoolPayloadErr
Identity
(Ticked (LedgerState ByronBlock), Validated (GenTx ByronBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> Ticked (LedgerState ByronBlock)
-> Except (ApplyTxErr ByronBlock) (Ticked (LedgerState ByronBlock))
applyByronGenTx ValidationMode
validationMode LedgerConfig ByronBlock
cfg SlotNo
slot GenTx ByronBlock
tx Ticked (LedgerState ByronBlock)
st
where
validationMode :: ValidationMode
validationMode = BlockValidationMode -> TxValidationMode -> ValidationMode
CC.ValidationMode BlockValidationMode
CC.BlockValidation TxValidationMode
Utxo.TxValidation
reapplyTx :: HasCallStack =>
LedgerConfig ByronBlock
-> SlotNo
-> Validated (GenTx ByronBlock)
-> Ticked (LedgerState ByronBlock)
-> Except (ApplyTxErr ByronBlock) (Ticked (LedgerState ByronBlock))
reapplyTx LedgerConfig ByronBlock
cfg SlotNo
slot Validated (GenTx ByronBlock)
vtx Ticked (LedgerState ByronBlock)
st =
ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> Ticked (LedgerState ByronBlock)
-> Except (ApplyTxErr ByronBlock) (Ticked (LedgerState ByronBlock))
applyByronGenTx ValidationMode
validationMode LedgerConfig ByronBlock
cfg SlotNo
slot (Validated (GenTx ByronBlock) -> GenTx ByronBlock
forgetValidatedByronTx Validated (GenTx ByronBlock)
vtx) Ticked (LedgerState ByronBlock)
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
instance TxLimits ByronBlock where
type TxMeasure ByronBlock = IgnoringOverflow ByteSize32
blockCapacityTxMeasure :: LedgerConfig ByronBlock
-> Ticked (LedgerState ByronBlock) -> TxMeasure ByronBlock
blockCapacityTxMeasure LedgerConfig ByronBlock
_cfg Ticked (LedgerState ByronBlock)
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 = Ticked (LedgerState ByronBlock) -> ChainValidationState
tickedByronLedgerState Ticked (LedgerState ByronBlock)
st
txMeasure :: LedgerConfig ByronBlock
-> Ticked (LedgerState ByronBlock)
-> GenTx ByronBlock
-> Except (ApplyTxErr ByronBlock) (TxMeasure ByronBlock)
txMeasure LedgerConfig ByronBlock
_cfg Ticked (LedgerState ByronBlock)
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
$ Ticked (LedgerState ByronBlock) -> ChainValidationState
tickedByronLedgerState Ticked (LedgerState ByronBlock)
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
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)
toMempoolPayload :: GenTx ByronBlock -> CC.AMempoolPayload ByteString
toMempoolPayload :: GenTx ByronBlock -> AMempoolPayload ByteString
toMempoolPayload = GenTx ByronBlock -> AMempoolPayload ByteString
go
where
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
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
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
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
applyByronGenTx :: CC.ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> TickedLedgerState ByronBlock
-> Except (ApplyTxErr ByronBlock) (TickedLedgerState ByronBlock)
applyByronGenTx :: ValidationMode
-> LedgerConfig ByronBlock
-> SlotNo
-> GenTx ByronBlock
-> Ticked (LedgerState ByronBlock)
-> Except (ApplyTxErr ByronBlock) (Ticked (LedgerState ByronBlock))
applyByronGenTx ValidationMode
validationMode LedgerConfig ByronBlock
cfg SlotNo
slot GenTx ByronBlock
genTx Ticked (LedgerState ByronBlock)
st =
(\ChainValidationState
state -> Ticked (LedgerState ByronBlock)
st {tickedByronLedgerState = state}) (ChainValidationState -> Ticked (LedgerState ByronBlock))
-> ExceptT ApplyMempoolPayloadErr Identity ChainValidationState
-> ExceptT
ApplyMempoolPayloadErr Identity (Ticked (LedgerState ByronBlock))
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)
(Ticked (LedgerState ByronBlock) -> ChainValidationState
tickedByronLedgerState Ticked (LedgerState ByronBlock)
st)
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)
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
canonicalise :: CC.AMempoolPayload ByteSpan
-> CC.AMempoolPayload ByteString
canonicalise :: AMempoolPayload ByteSpan -> AMempoolPayload ByteString
canonicalise AMempoolPayload ByteSpan
mp = ByteString -> ByteString
Lazy.toStrict (ByteString -> ByteString)
-> (ByteSpan -> ByteString) -> ByteSpan -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteSpan -> ByteString
slice ByteString
canonicalBytes (ByteSpan -> ByteString)
-> AMempoolPayload ByteSpan -> AMempoolPayload ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AMempoolPayload ByteSpan
mp'
where
canonicalBytes :: ByteString
canonicalBytes = Version -> AMempoolPayload () -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer (AMempoolPayload ByteSpan -> AMempoolPayload ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void AMempoolPayload ByteSpan
mp)
mp' :: AMempoolPayload ByteSpan
mp' = Version -> ByteString -> AMempoolPayload ByteSpan
forall a. DecCBOR a => Version -> ByteString -> a
unsafeDeserialize Version
byronProtVer ByteString
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
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