{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE DisambiguateRecordFields   #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeFamilies               #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Shelley mempool integration
module Ouroboros.Consensus.Shelley.Ledger.Mempool (
    SL.ApplyTxError (..)
  , GenTx (..)
  , TxId (..)
  , mkShelleyTx
  , fixedBlockBodyOverhead
  , perTxOverhead
  ) where

import           Control.Monad.Except (Except)
import qualified Data.ByteString.Lazy as Lazy
import           Data.Foldable (toList)
import qualified Data.Sequence as Seq
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks (..))

import           Cardano.Binary (Annotator (..), FromCBOR (..),
                     FullByteString (..), ToCBOR (..))

import           Ouroboros.Network.Block (unwrapCBORinCBOR, wrapCBORinCBOR)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Util (ShowProxy (..))
import           Ouroboros.Consensus.Util.Condense

import qualified Shelley.Spec.Ledger.API as SL
import           Shelley.Spec.Ledger.BlockChain as SL (TxSeq (..))
import qualified Shelley.Spec.Ledger.UTxO as SL (txid)

import           Ouroboros.Consensus.Shelley.Ledger.Block
import           Ouroboros.Consensus.Shelley.Ledger.Ledger

type ShelleyTxId era = SL.TxId era

data instance GenTx (ShelleyBlock era) = ShelleyTx !(ShelleyTxId era) !(SL.Tx era)
  deriving stock    ((forall x.
 GenTx (ShelleyBlock era) -> Rep (GenTx (ShelleyBlock era)) x)
-> (forall x.
    Rep (GenTx (ShelleyBlock era)) x -> GenTx (ShelleyBlock era))
-> Generic (GenTx (ShelleyBlock era))
forall x.
Rep (GenTx (ShelleyBlock era)) x -> GenTx (ShelleyBlock era)
forall x.
GenTx (ShelleyBlock era) -> Rep (GenTx (ShelleyBlock era)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (GenTx (ShelleyBlock era)) x -> GenTx (ShelleyBlock era)
forall era x.
GenTx (ShelleyBlock era) -> Rep (GenTx (ShelleyBlock era)) x
$cto :: forall era x.
Rep (GenTx (ShelleyBlock era)) x -> GenTx (ShelleyBlock era)
$cfrom :: forall era x.
GenTx (ShelleyBlock era) -> Rep (GenTx (ShelleyBlock era)) x
Generic)

deriving instance ShelleyBasedEra era => NoThunks (GenTx (ShelleyBlock era))

deriving instance ShelleyBasedEra era => Eq (GenTx (ShelleyBlock era))

instance Typeable era => ShowProxy (GenTx (ShelleyBlock era)) where

type instance ApplyTxErr (ShelleyBlock era) = SL.ApplyTxError era

-- orphaned instance
instance Typeable era => ShowProxy (SL.ApplyTxError era) where


-- |'txInBlockSize' is used to estimate how many transactions we can grab from
-- the Mempool to put into the block we are going to forge without exceeding
-- the maximum block body size according to the ledger. If we exceed that
-- limit, we will have forged a block that is invalid according to the ledger.
-- We ourselves won't even adopt it, causing us to lose our slot, something we
-- must try to avoid.
--
-- For this reason it is better to overestimate the size of a transaction than
-- to underestimate. The only downside is that we maybe could have put one (or
-- more?) transactions extra in that block.
--
-- As the sum of the serialised transaction sizes is not equal to the size of
-- the serialised block body ('SL.TxSeq') consisting of those transactions
-- (see cardano-node#1545 for an example), we account for some extra overhead
-- per transaction as a safety margin.
--
-- Also see 'perTxOverhead'.
fixedBlockBodyOverhead :: Num a => a
fixedBlockBodyOverhead :: a
fixedBlockBodyOverhead = a
1024

-- | See 'fixedBlockBodyOverhead'.
perTxOverhead :: Num a => a
perTxOverhead :: a
perTxOverhead = a
4

instance ShelleyBasedEra era
      => LedgerSupportsMempool (ShelleyBlock era) where
  txInvariant :: GenTx (ShelleyBlock era) -> Bool
txInvariant = Bool -> GenTx (ShelleyBlock era) -> Bool
forall a b. a -> b -> a
const Bool
True

  applyTx :: LedgerConfig (ShelleyBlock era)
-> SlotNo
-> GenTx (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
-> Except
     (ApplyTxErr (ShelleyBlock era))
     (Ticked (LedgerState (ShelleyBlock era)))
applyTx = LedgerConfig (ShelleyBlock era)
-> SlotNo
-> GenTx (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
-> Except
     (ApplyTxErr (ShelleyBlock era))
     (Ticked (LedgerState (ShelleyBlock era)))
forall era.
ShelleyBasedEra era =>
LedgerConfig (ShelleyBlock era)
-> SlotNo
-> GenTx (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
-> Except
     (ApplyTxErr (ShelleyBlock era))
     (Ticked (LedgerState (ShelleyBlock era)))
applyShelleyTx

  -- TODO actual reapplication:
  -- https://github.com/input-output-hk/cardano-ledger-specs/issues/1304
  reapplyTx :: LedgerConfig (ShelleyBlock era)
-> SlotNo
-> GenTx (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
-> Except
     (ApplyTxErr (ShelleyBlock era))
     (Ticked (LedgerState (ShelleyBlock era)))
reapplyTx = LedgerConfig (ShelleyBlock era)
-> SlotNo
-> GenTx (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
-> Except
     (ApplyTxErr (ShelleyBlock era))
     (Ticked (LedgerState (ShelleyBlock era)))
forall era.
ShelleyBasedEra era =>
LedgerConfig (ShelleyBlock era)
-> SlotNo
-> GenTx (ShelleyBlock era)
-> Ticked (LedgerState (ShelleyBlock era))
-> Except
     (ApplyTxErr (ShelleyBlock era))
     (Ticked (LedgerState (ShelleyBlock era)))
applyShelleyTx

  maxTxCapacity :: Ticked (LedgerState (ShelleyBlock era)) -> Word32
maxTxCapacity TickedShelleyLedgerState { tickedShelleyLedgerState = shelleyState } =
      Natural -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
HKD Identity Natural
maxBlockBodySize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
forall a. Num a => a
fixedBlockBodyOverhead
    where
      SL.PParams { _maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize = HKD Identity Natural
maxBlockBodySize } = NewEpochState era -> PParams' Identity era
forall era. NewEpochState era -> PParams era
getPParams NewEpochState era
shelleyState

  txInBlockSize :: GenTx (ShelleyBlock era) -> Word32
txInBlockSize (ShelleyTx _ tx) = Word32
txSize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
forall a. Num a => a
perTxOverhead
    where
      txSize :: Word32
txSize = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> (Tx era -> Int64) -> Tx era -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
Lazy.length (ByteString -> Int64) -> (Tx era -> ByteString) -> Tx era -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> ByteString
forall era. Tx era -> ByteString
SL.txFullBytes (Tx era -> Word32) -> Tx era -> Word32
forall a b. (a -> b) -> a -> b
$ Tx era
tx

mkShelleyTx :: ShelleyBasedEra era => SL.Tx era -> GenTx (ShelleyBlock era)
mkShelleyTx :: Tx era -> GenTx (ShelleyBlock era)
mkShelleyTx Tx era
tx = ShelleyTxId era -> Tx era -> GenTx (ShelleyBlock era)
forall era. ShelleyTxId era -> Tx era -> GenTx (ShelleyBlock era)
ShelleyTx (TxBody era -> ShelleyTxId era
forall era. TxBodyConstraints era => TxBody era -> TxId era
SL.txid (Tx era -> TxBodyConstraints era => TxBody era
forall era. Tx era -> TxBodyConstraints era => TxBody era
SL._body Tx era
tx)) Tx era
tx

newtype instance TxId (GenTx (ShelleyBlock era)) = ShelleyTxId (ShelleyTxId era)
  deriving newtype (TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
(TxId (GenTx (ShelleyBlock era))
 -> TxId (GenTx (ShelleyBlock era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era)) -> Bool)
-> Eq (TxId (GenTx (ShelleyBlock era)))
forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
$c/= :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
== :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
$c== :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
Eq, Eq (TxId (GenTx (ShelleyBlock era)))
Eq (TxId (GenTx (ShelleyBlock era)))
-> (TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era)) -> Ordering)
-> (TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era)) -> Bool)
-> (TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era)))
-> (TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era))
    -> TxId (GenTx (ShelleyBlock era)))
-> Ord (TxId (GenTx (ShelleyBlock era)))
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Ordering
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
forall era. Eq (TxId (GenTx (ShelleyBlock era)))
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
forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Ordering
forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
min :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
$cmin :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
max :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
$cmax :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era))
>= :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
$c>= :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
> :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
$c> :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
<= :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
$c<= :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
< :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
$c< :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Bool
compare :: TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Ordering
$ccompare :: forall era.
TxId (GenTx (ShelleyBlock era))
-> TxId (GenTx (ShelleyBlock era)) -> Ordering
$cp1Ord :: forall era. Eq (TxId (GenTx (ShelleyBlock era)))
Ord, Typeable (TxId (GenTx (ShelleyBlock era)))
Decoder s (TxId (GenTx (ShelleyBlock era)))
Typeable (TxId (GenTx (ShelleyBlock era)))
-> (forall s. Decoder s (TxId (GenTx (ShelleyBlock era))))
-> (Proxy (TxId (GenTx (ShelleyBlock era))) -> Text)
-> FromCBOR (TxId (GenTx (ShelleyBlock era)))
Proxy (TxId (GenTx (ShelleyBlock era))) -> Text
forall s. Decoder s (TxId (GenTx (ShelleyBlock era)))
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall era. Era era => Typeable (TxId (GenTx (ShelleyBlock era)))
forall era.
Era era =>
Proxy (TxId (GenTx (ShelleyBlock era))) -> Text
forall era s.
Era era =>
Decoder s (TxId (GenTx (ShelleyBlock era)))
label :: Proxy (TxId (GenTx (ShelleyBlock era))) -> Text
$clabel :: forall era.
Era era =>
Proxy (TxId (GenTx (ShelleyBlock era))) -> Text
fromCBOR :: Decoder s (TxId (GenTx (ShelleyBlock era)))
$cfromCBOR :: forall era s.
Era era =>
Decoder s (TxId (GenTx (ShelleyBlock era)))
$cp1FromCBOR :: forall era. Era era => Typeable (TxId (GenTx (ShelleyBlock era)))
FromCBOR, Typeable (TxId (GenTx (ShelleyBlock era)))
Typeable (TxId (GenTx (ShelleyBlock era)))
-> (TxId (GenTx (ShelleyBlock era)) -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (TxId (GenTx (ShelleyBlock era))) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [TxId (GenTx (ShelleyBlock era))] -> Size)
-> ToCBOR (TxId (GenTx (ShelleyBlock era)))
TxId (GenTx (ShelleyBlock era)) -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxId (GenTx (ShelleyBlock era))] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxId (GenTx (ShelleyBlock era))) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall era. Era era => Typeable (TxId (GenTx (ShelleyBlock era)))
forall era. Era era => TxId (GenTx (ShelleyBlock era)) -> Encoding
forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxId (GenTx (ShelleyBlock era))] -> Size
forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxId (GenTx (ShelleyBlock era))) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxId (GenTx (ShelleyBlock era))] -> Size
$cencodedListSizeExpr :: forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [TxId (GenTx (ShelleyBlock era))] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxId (GenTx (ShelleyBlock era))) -> Size
$cencodedSizeExpr :: forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (TxId (GenTx (ShelleyBlock era))) -> Size
toCBOR :: TxId (GenTx (ShelleyBlock era)) -> Encoding
$ctoCBOR :: forall era. Era era => TxId (GenTx (ShelleyBlock era)) -> Encoding
$cp1ToCBOR :: forall era. Era era => Typeable (TxId (GenTx (ShelleyBlock era)))
ToCBOR, Context -> TxId (GenTx (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
Proxy (TxId (GenTx (ShelleyBlock era))) -> String
(Context
 -> TxId (GenTx (ShelleyBlock era)) -> IO (Maybe ThunkInfo))
-> (Context
    -> TxId (GenTx (ShelleyBlock era)) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx (ShelleyBlock era))) -> String)
-> NoThunks (TxId (GenTx (ShelleyBlock era)))
forall era.
Context -> TxId (GenTx (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
forall era. Proxy (TxId (GenTx (ShelleyBlock era))) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxId (GenTx (ShelleyBlock era))) -> String
$cshowTypeOf :: forall era. Proxy (TxId (GenTx (ShelleyBlock era))) -> String
wNoThunks :: Context -> TxId (GenTx (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context -> TxId (GenTx (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId (GenTx (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Context -> TxId (GenTx (ShelleyBlock era)) -> IO (Maybe ThunkInfo)
NoThunks)

instance Typeable era => ShowProxy (TxId (GenTx (ShelleyBlock era))) where

instance ShelleyBasedEra era => HasTxId (GenTx (ShelleyBlock era)) where
  txId :: GenTx (ShelleyBlock era) -> TxId (GenTx (ShelleyBlock era))
txId (ShelleyTx i _) = ShelleyTxId era -> TxId (GenTx (ShelleyBlock era))
forall era. ShelleyTxId era -> TxId (GenTx (ShelleyBlock era))
ShelleyTxId ShelleyTxId era
i

instance ShelleyBasedEra era => HasTxs (ShelleyBlock era) where
  extractTxs :: ShelleyBlock era -> [GenTx (ShelleyBlock era)]
extractTxs =
        (Tx era -> GenTx (ShelleyBlock era))
-> [Tx era] -> [GenTx (ShelleyBlock era)]
forall a b. (a -> b) -> [a] -> [b]
map Tx era -> GenTx (ShelleyBlock era)
forall era.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock era)
mkShelleyTx
      ([Tx era] -> [GenTx (ShelleyBlock era)])
-> (ShelleyBlock era -> [Tx era])
-> ShelleyBlock era
-> [GenTx (ShelleyBlock era)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSeq era -> [Tx era]
txSeqToList
      (TxSeq era -> [Tx era])
-> (ShelleyBlock era -> TxSeq era) -> ShelleyBlock era -> [Tx era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block era -> TxSeq era
forall era. Era era => Block era -> TxSeq era
SL.bbody
      (Block era -> TxSeq era)
-> (ShelleyBlock era -> Block era) -> ShelleyBlock era -> TxSeq era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBlock era -> Block era
forall era. ShelleyBlock era -> Block era
shelleyBlockRaw
    where
      txSeqToList :: TxSeq era -> [SL.Tx era]
      txSeqToList :: TxSeq era -> [Tx era]
txSeqToList (TxSeq StrictSeq (Tx era)
s) = StrictSeq (Tx era) -> [Tx era]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList StrictSeq (Tx era)
s

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

instance ShelleyBasedEra era => ToCBOR (GenTx (ShelleyBlock era)) where
  -- No need to encode the 'TxId', it's just a hash of the 'SL.TxBody' inside
  -- 'SL.Tx', so it can be recomputed.
  toCBOR :: GenTx (ShelleyBlock era) -> Encoding
toCBOR (ShelleyTx _txid tx) = (Tx era -> Encoding) -> Tx era -> Encoding
forall a. (a -> Encoding) -> a -> Encoding
wrapCBORinCBOR Tx era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Tx era
tx

instance ShelleyBasedEra era => FromCBOR (GenTx (ShelleyBlock era)) where
  fromCBOR :: Decoder s (GenTx (ShelleyBlock era))
fromCBOR = (Tx era -> GenTx (ShelleyBlock era))
-> Decoder s (Tx era) -> Decoder s (GenTx (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx era -> GenTx (ShelleyBlock era)
forall era.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock era)
mkShelleyTx (Decoder s (Tx era) -> Decoder s (GenTx (ShelleyBlock era)))
-> Decoder s (Tx era) -> Decoder s (GenTx (ShelleyBlock era))
forall a b. (a -> b) -> a -> b
$ (forall s. Decoder s (ByteString -> Tx era))
-> forall s. Decoder s (Tx era)
forall a.
(forall s. Decoder s (ByteString -> a)) -> forall s. Decoder s a
unwrapCBORinCBOR
    ((forall s. Decoder s (ByteString -> Tx era))
 -> forall s. Decoder s (Tx era))
-> (forall s. Decoder s (ByteString -> Tx era))
-> forall s. Decoder s (Tx era)
forall a b. (a -> b) -> a -> b
$ ((FullByteString -> Tx era)
-> (ByteString -> FullByteString) -> ByteString -> Tx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FullByteString
Full) ((FullByteString -> Tx era) -> ByteString -> Tx era)
-> (Annotator (Tx era) -> FullByteString -> Tx era)
-> Annotator (Tx era)
-> ByteString
-> Tx era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotator (Tx era) -> FullByteString -> Tx era
forall a. Annotator a -> FullByteString -> a
runAnnotator (Annotator (Tx era) -> ByteString -> Tx era)
-> Decoder s (Annotator (Tx era))
-> Decoder s (ByteString -> Tx era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Annotator (Tx era))
forall a s. FromCBOR a => Decoder s a
fromCBOR

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

instance ShelleyBasedEra era => Condense (GenTx (ShelleyBlock era)) where
  condense :: GenTx (ShelleyBlock era) -> String
condense (ShelleyTx _ tx ) = Tx era -> String
forall a. Show a => a -> String
show Tx era
tx

instance Condense (GenTxId (ShelleyBlock era)) where
  condense :: GenTxId (ShelleyBlock era) -> String
condense (ShelleyTxId i) = String
"txid: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ShelleyTxId era -> String
forall a. Show a => a -> String
show ShelleyTxId era
i

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

instance Show (GenTxId (ShelleyBlock era)) where
  show :: GenTxId (ShelleyBlock era) -> String
show = GenTxId (ShelleyBlock era) -> String
forall a. Condense a => a -> String
condense

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

applyShelleyTx ::
     ShelleyBasedEra era
  => LedgerConfig (ShelleyBlock era)
  -> SlotNo
  -> GenTx (ShelleyBlock era)
  -> TickedLedgerState (ShelleyBlock era)
  -> Except (ApplyTxErr (ShelleyBlock era)) (TickedLedgerState (ShelleyBlock era))
applyShelleyTx :: LedgerConfig (ShelleyBlock era)
-> SlotNo
-> GenTx (ShelleyBlock era)
-> TickedLedgerState (ShelleyBlock era)
-> Except
     (ApplyTxErr (ShelleyBlock era))
     (TickedLedgerState (ShelleyBlock era))
applyShelleyTx LedgerConfig (ShelleyBlock era)
cfg SlotNo
slot (ShelleyTx _ tx) TickedLedgerState (ShelleyBlock era)
st =
    (\NewEpochState era
state -> TickedLedgerState (ShelleyBlock era)
R:TickedLedgerState era
st { tickedShelleyLedgerState :: NewEpochState era
tickedShelleyLedgerState = NewEpochState era
state }) (NewEpochState era -> TickedLedgerState (ShelleyBlock era))
-> ExceptT (ApplyTxError era) Identity (NewEpochState era)
-> ExceptT
     (ApplyTxError era) Identity (TickedLedgerState (ShelleyBlock era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Globals
-> SlotNo
-> Seq (Tx era)
-> NewEpochState era
-> ExceptT (ApplyTxError era) Identity (NewEpochState era)
forall era (m :: * -> *).
(ApplyTx era, MonadError (ApplyTxError era) m) =>
Globals
-> SlotNo
-> Seq (Tx era)
-> NewEpochState era
-> m (NewEpochState era)
SL.applyTxs
          (ShelleyLedgerConfig era -> Globals
forall era. ShelleyLedgerConfig era -> Globals
shelleyLedgerGlobals LedgerConfig (ShelleyBlock era)
ShelleyLedgerConfig era
cfg)
          SlotNo
slot
          (Tx era -> Seq (Tx era)
forall a. a -> Seq a
Seq.singleton Tx era
tx)
          (TickedLedgerState (ShelleyBlock era) -> NewEpochState era
forall era.
Ticked (LedgerState (ShelleyBlock era)) -> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock era)
st)