{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Ouroboros.Consensus.Ledger.Dual (
    Bridge (..)
    -- * Pair types
  , DualBlock (..)
  , DualGenTxErr (..)
  , DualHeader
  , DualLedgerConfig (..)
  , DualLedgerError (..)
    -- * Lifted functions
  , ctxtDualMain
  , dualExtValidationErrorMain
  , dualTopLevelConfigMain
    -- * Type class family instances
  , BlockConfig (..)
  , CodecConfig (..)
  , GenTx (..)
  , Header (..)
  , LedgerState (..)
  , NestedCtxt_ (..)
  , StorageConfig (..)
  , Ticked (..)
  , TxId (..)
  , Validated (..)
    -- * Serialisation
  , decodeDualBlock
  , decodeDualGenTx
  , decodeDualGenTxErr
  , decodeDualGenTxId
  , decodeDualHeader
  , decodeDualLedgerConfig
  , decodeDualLedgerState
  , encodeDualBlock
  , encodeDualGenTx
  , encodeDualGenTxErr
  , encodeDualGenTxId
  , encodeDualHeader
  , encodeDualLedgerConfig
  , encodeDualLedgerState
  ) where

import           Cardano.Binary (enforceSize)
import           Codec.CBOR.Decoding (Decoder)
import           Codec.CBOR.Encoding (Encoding, encodeListLen)
import           Codec.Serialise
import           Control.Arrow ((+++))
import           Control.Monad.Except
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Short as Short
import           Data.Functor ((<&>))
import           Data.Kind (Type)
import           Data.Typeable
import           GHC.Generics (Generic)
import           GHC.Stack
import           NoThunks.Class (AllowThunk (..), NoThunks (..))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Config.SupportsNode
import           Ouroboros.Consensus.HardFork.Abstract
import           Ouroboros.Consensus.HardFork.Combinator.PartialConfig
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.CommonProtocolParams
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Inspect
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.SupportsPeerSelection
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.Util (ShowProxy (..))
import           Ouroboros.Consensus.Util.Condense

{-------------------------------------------------------------------------------
  Block
-------------------------------------------------------------------------------}

-- | Dual block
--
-- The dual block is used to instantiate the consensus with a dual ledger,
-- consisting of two ledger states associated with two types of blocks. The
-- (consensus) chain state will still be updated based on one block type only,
-- which is therefore designed as the /main/ block, while the other block is
-- designated as the /auxiliary/ block.
--
-- The auxiliary block is optional; this can be used if some " main " blocks
-- should have no effect on the auxiliary ledger state at all. The motivating
-- example is EBBs: if the main blocks are real Byron blocks, and the auxiliary
-- blocks are Byron spec blocks, then regular Byron blocks correspond to Byron
-- spec blocks, but EBBs don't correspond to a spec block at all and should
-- leave the Byron spec ledger state unchanged.
--
-- NOTE: The dual ledger is used for testing purposes only; we do not do any
-- meaningful 'NoThunks' checks here.
data DualBlock m a = DualBlock {
      forall m a. DualBlock m a -> m
dualBlockMain   :: m
    , forall m a. DualBlock m a -> Maybe a
dualBlockAux    :: Maybe a
    , forall m a. DualBlock m a -> BridgeBlock m a
dualBlockBridge :: BridgeBlock m a
    }

deriving instance (Show m, Show a, Show (BridgeBlock m a)) => Show (DualBlock m a)
deriving instance (Eq   m, Eq   a, Eq   (BridgeBlock m a)) => Eq   (DualBlock m a)

instance (Typeable m, Typeable a)
    => ShowProxy (DualBlock m a) where

instance Condense m => Condense (DualBlock m a) where
  condense :: DualBlock m a -> String
condense = m -> String
forall a. Condense a => a -> String
condense (m -> String) -> (DualBlock m a -> m) -> DualBlock m a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DualBlock m a -> m
forall m a. DualBlock m a -> m
dualBlockMain

type instance HeaderHash (DualBlock m a) = HeaderHash m
instance StandardHash m => StandardHash (DualBlock m a)

instance ConvertRawHash m => ConvertRawHash (DualBlock m a) where
  toShortRawHash :: forall (proxy :: * -> *).
proxy (DualBlock m a)
-> HeaderHash (DualBlock m a) -> ShortByteString
toShortRawHash   proxy (DualBlock m a)
_ = Proxy m -> HeaderHash m -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy m -> HeaderHash m -> ShortByteString
toShortRawHash   (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
  fromShortRawHash :: forall (proxy :: * -> *).
proxy (DualBlock m a)
-> ShortByteString -> HeaderHash (DualBlock m a)
fromShortRawHash proxy (DualBlock m a)
_ = Proxy m -> ShortByteString -> HeaderHash m
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
forall (proxy :: * -> *).
proxy m -> ShortByteString -> HeaderHash m
fromShortRawHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
  hashSize :: forall (proxy :: * -> *). proxy (DualBlock m a) -> Word32
hashSize         proxy (DualBlock m a)
_ = Proxy m -> Word32
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> Word32
forall (proxy :: * -> *). proxy m -> Word32
hashSize         (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)

{-------------------------------------------------------------------------------
  Header
-------------------------------------------------------------------------------}

newtype instance Header (DualBlock m a) = DualHeader { forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain :: Header m }
  deriving Context -> Header (DualBlock m a) -> IO (Maybe ThunkInfo)
Proxy (Header (DualBlock m a)) -> String
(Context -> Header (DualBlock m a) -> IO (Maybe ThunkInfo))
-> (Context -> Header (DualBlock m a) -> IO (Maybe ThunkInfo))
-> (Proxy (Header (DualBlock m a)) -> String)
-> NoThunks (Header (DualBlock m a))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a.
Context -> Header (DualBlock m a) -> IO (Maybe ThunkInfo)
forall m a. Proxy (Header (DualBlock m a)) -> String
$cnoThunks :: forall m a.
Context -> Header (DualBlock m a) -> IO (Maybe ThunkInfo)
noThunks :: Context -> Header (DualBlock m a) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a.
Context -> Header (DualBlock m a) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Header (DualBlock m a) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (Header (DualBlock m a)) -> String
showTypeOf :: Proxy (Header (DualBlock m a)) -> String
NoThunks via AllowThunk (Header (DualBlock m a))

instance Bridge m a => GetHeader (DualBlock m a) where
  getHeader :: DualBlock m a -> Header (DualBlock m a)
getHeader = Header m -> Header (DualBlock m a)
forall m a. Header m -> Header (DualBlock m a)
DualHeader (Header m -> Header (DualBlock m a))
-> (DualBlock m a -> Header m)
-> DualBlock m a
-> Header (DualBlock m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> Header m
forall blk. GetHeader blk => blk -> Header blk
getHeader (m -> Header m)
-> (DualBlock m a -> m) -> DualBlock m a -> Header m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DualBlock m a -> m
forall m a. DualBlock m a -> m
dualBlockMain

  blockMatchesHeader :: Header (DualBlock m a) -> DualBlock m a -> Bool
blockMatchesHeader Header (DualBlock m a)
hdr =
      Header m -> m -> Bool
forall blk. GetHeader blk => Header blk -> blk -> Bool
blockMatchesHeader (Header (DualBlock m a) -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain Header (DualBlock m a)
hdr) (m -> Bool) -> (DualBlock m a -> m) -> DualBlock m a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DualBlock m a -> m
forall m a. DualBlock m a -> m
dualBlockMain

  -- We can look at the concrete header to see if this is an EBB
  headerIsEBB :: Header (DualBlock m a) -> Maybe EpochNo
headerIsEBB = Header m -> Maybe EpochNo
forall blk. GetHeader blk => Header blk -> Maybe EpochNo
headerIsEBB (Header m -> Maybe EpochNo)
-> (Header (DualBlock m a) -> Header m)
-> Header (DualBlock m a)
-> Maybe EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (DualBlock m a) -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain

type DualHeader m a = Header (DualBlock m a)

deriving instance Show (Header m) => Show (DualHeader m a)

instance (Typeable m, Typeable a)
    => ShowProxy (DualHeader m a) where

{-------------------------------------------------------------------------------
  Config
-------------------------------------------------------------------------------}

data instance BlockConfig (DualBlock m a) = DualBlockConfig {
      forall m a. BlockConfig (DualBlock m a) -> BlockConfig m
dualBlockConfigMain :: BlockConfig m
    , forall m a. BlockConfig (DualBlock m a) -> BlockConfig a
dualBlockConfigAux  :: BlockConfig a
    }
  deriving Context -> BlockConfig (DualBlock m a) -> IO (Maybe ThunkInfo)
Proxy (BlockConfig (DualBlock m a)) -> String
(Context -> BlockConfig (DualBlock m a) -> IO (Maybe ThunkInfo))
-> (Context -> BlockConfig (DualBlock m a) -> IO (Maybe ThunkInfo))
-> (Proxy (BlockConfig (DualBlock m a)) -> String)
-> NoThunks (BlockConfig (DualBlock m a))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a.
Context -> BlockConfig (DualBlock m a) -> IO (Maybe ThunkInfo)
forall m a. Proxy (BlockConfig (DualBlock m a)) -> String
$cnoThunks :: forall m a.
Context -> BlockConfig (DualBlock m a) -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlockConfig (DualBlock m a) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a.
Context -> BlockConfig (DualBlock m a) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> BlockConfig (DualBlock m a) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (BlockConfig (DualBlock m a)) -> String
showTypeOf :: Proxy (BlockConfig (DualBlock m a)) -> String
NoThunks via AllowThunk (BlockConfig (DualBlock m a))

instance ConfigSupportsNode m => ConfigSupportsNode (DualBlock m a) where
  getSystemStart :: BlockConfig (DualBlock m a) -> SystemStart
getSystemStart  = BlockConfig m -> SystemStart
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> SystemStart
getSystemStart  (BlockConfig m -> SystemStart)
-> (BlockConfig (DualBlock m a) -> BlockConfig m)
-> BlockConfig (DualBlock m a)
-> SystemStart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig (DualBlock m a) -> BlockConfig m
forall m a. BlockConfig (DualBlock m a) -> BlockConfig m
dualBlockConfigMain
  getNetworkMagic :: BlockConfig (DualBlock m a) -> NetworkMagic
getNetworkMagic = BlockConfig m -> NetworkMagic
forall blk.
ConfigSupportsNode blk =>
BlockConfig blk -> NetworkMagic
getNetworkMagic (BlockConfig m -> NetworkMagic)
-> (BlockConfig (DualBlock m a) -> BlockConfig m)
-> BlockConfig (DualBlock m a)
-> NetworkMagic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig (DualBlock m a) -> BlockConfig m
forall m a. BlockConfig (DualBlock m a) -> BlockConfig m
dualBlockConfigMain

{-------------------------------------------------------------------------------
  Splitting the config
-------------------------------------------------------------------------------}

-- | This is only used for block production
dualTopLevelConfigMain :: TopLevelConfig (DualBlock m a) -> TopLevelConfig m
dualTopLevelConfigMain :: forall m a. TopLevelConfig (DualBlock m a) -> TopLevelConfig m
dualTopLevelConfigMain TopLevelConfig{StorageConfig (DualBlock m a)
CodecConfig (DualBlock m a)
BlockConfig (DualBlock m a)
ConsensusConfig (BlockProtocol (DualBlock m a))
LedgerConfig (DualBlock m a)
CheckpointsMap (DualBlock m a)
topLevelConfigProtocol :: ConsensusConfig (BlockProtocol (DualBlock m a))
topLevelConfigLedger :: LedgerConfig (DualBlock m a)
topLevelConfigBlock :: BlockConfig (DualBlock m a)
topLevelConfigCodec :: CodecConfig (DualBlock m a)
topLevelConfigStorage :: StorageConfig (DualBlock m a)
topLevelConfigCheckpoints :: CheckpointsMap (DualBlock m a)
topLevelConfigProtocol :: forall blk.
TopLevelConfig blk -> ConsensusConfig (BlockProtocol blk)
topLevelConfigLedger :: forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigBlock :: forall blk. TopLevelConfig blk -> BlockConfig blk
topLevelConfigCodec :: forall blk. TopLevelConfig blk -> CodecConfig blk
topLevelConfigStorage :: forall blk. TopLevelConfig blk -> StorageConfig blk
topLevelConfigCheckpoints :: forall blk. TopLevelConfig blk -> CheckpointsMap blk
..} = TopLevelConfig{
      topLevelConfigProtocol :: ConsensusConfig (BlockProtocol m)
topLevelConfigProtocol    = ConsensusConfig (BlockProtocol m)
ConsensusConfig (BlockProtocol (DualBlock m a))
topLevelConfigProtocol
    , topLevelConfigLedger :: LedgerConfig m
topLevelConfigLedger      = DualLedgerConfig m a -> LedgerConfig m
forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigMain  LedgerConfig (DualBlock m a)
DualLedgerConfig m a
topLevelConfigLedger
    , topLevelConfigBlock :: BlockConfig m
topLevelConfigBlock       = BlockConfig (DualBlock m a) -> BlockConfig m
forall m a. BlockConfig (DualBlock m a) -> BlockConfig m
dualBlockConfigMain   BlockConfig (DualBlock m a)
topLevelConfigBlock
    , topLevelConfigCodec :: CodecConfig m
topLevelConfigCodec       = CodecConfig (DualBlock m a) -> CodecConfig m
forall m a. CodecConfig (DualBlock m a) -> CodecConfig m
dualCodecConfigMain   CodecConfig (DualBlock m a)
topLevelConfigCodec
    , topLevelConfigStorage :: StorageConfig m
topLevelConfigStorage     = StorageConfig (DualBlock m a) -> StorageConfig m
forall m a. StorageConfig (DualBlock m a) -> StorageConfig m
dualStorageConfigMain StorageConfig (DualBlock m a)
topLevelConfigStorage
    , topLevelConfigCheckpoints :: CheckpointsMap m
topLevelConfigCheckpoints = CheckpointsMap (DualBlock m a) -> CheckpointsMap m
forall blk blk'.
Coercible (HeaderHash blk) (HeaderHash blk') =>
CheckpointsMap blk -> CheckpointsMap blk'
castCheckpointsMap CheckpointsMap (DualBlock m a)
topLevelConfigCheckpoints
    }

{-------------------------------------------------------------------------------
  CodecConfig
-------------------------------------------------------------------------------}

data instance CodecConfig (DualBlock m a) = DualCodecConfig {
      forall m a. CodecConfig (DualBlock m a) -> CodecConfig m
dualCodecConfigMain :: !(CodecConfig m)
    , forall m a. CodecConfig (DualBlock m a) -> CodecConfig a
dualCodecConfigAux  :: !(CodecConfig a)
    }
  deriving ((forall x.
 CodecConfig (DualBlock m a) -> Rep (CodecConfig (DualBlock m a)) x)
-> (forall x.
    Rep (CodecConfig (DualBlock m a)) x -> CodecConfig (DualBlock m a))
-> Generic (CodecConfig (DualBlock m a))
forall x.
Rep (CodecConfig (DualBlock m a)) x -> CodecConfig (DualBlock m a)
forall x.
CodecConfig (DualBlock m a) -> Rep (CodecConfig (DualBlock m a)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall m a x.
Rep (CodecConfig (DualBlock m a)) x -> CodecConfig (DualBlock m a)
forall m a x.
CodecConfig (DualBlock m a) -> Rep (CodecConfig (DualBlock m a)) x
$cfrom :: forall m a x.
CodecConfig (DualBlock m a) -> Rep (CodecConfig (DualBlock m a)) x
from :: forall x.
CodecConfig (DualBlock m a) -> Rep (CodecConfig (DualBlock m a)) x
$cto :: forall m a x.
Rep (CodecConfig (DualBlock m a)) x -> CodecConfig (DualBlock m a)
to :: forall x.
Rep (CodecConfig (DualBlock m a)) x -> CodecConfig (DualBlock m a)
Generic)

instance ( NoThunks (CodecConfig m)
         , NoThunks (CodecConfig a)
         ) => NoThunks (CodecConfig (DualBlock m a))
  -- Use generic instance

{-------------------------------------------------------------------------------
  StorageConfig
-------------------------------------------------------------------------------}

data instance StorageConfig (DualBlock m a) = DualStorageConfig {
      forall m a. StorageConfig (DualBlock m a) -> StorageConfig m
dualStorageConfigMain :: !(StorageConfig m)
    , forall m a. StorageConfig (DualBlock m a) -> StorageConfig a
dualStorageConfigAux  :: !(StorageConfig a)
    }
  deriving ((forall x.
 StorageConfig (DualBlock m a)
 -> Rep (StorageConfig (DualBlock m a)) x)
-> (forall x.
    Rep (StorageConfig (DualBlock m a)) x
    -> StorageConfig (DualBlock m a))
-> Generic (StorageConfig (DualBlock m a))
forall x.
Rep (StorageConfig (DualBlock m a)) x
-> StorageConfig (DualBlock m a)
forall x.
StorageConfig (DualBlock m a)
-> Rep (StorageConfig (DualBlock m a)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall m a x.
Rep (StorageConfig (DualBlock m a)) x
-> StorageConfig (DualBlock m a)
forall m a x.
StorageConfig (DualBlock m a)
-> Rep (StorageConfig (DualBlock m a)) x
$cfrom :: forall m a x.
StorageConfig (DualBlock m a)
-> Rep (StorageConfig (DualBlock m a)) x
from :: forall x.
StorageConfig (DualBlock m a)
-> Rep (StorageConfig (DualBlock m a)) x
$cto :: forall m a x.
Rep (StorageConfig (DualBlock m a)) x
-> StorageConfig (DualBlock m a)
to :: forall x.
Rep (StorageConfig (DualBlock m a)) x
-> StorageConfig (DualBlock m a)
Generic)

instance ( NoThunks (StorageConfig m)
         , NoThunks (StorageConfig a)
         ) => NoThunks (StorageConfig (DualBlock m a))
  -- Use generic instance

{-------------------------------------------------------------------------------
  Bridge two ledgers
-------------------------------------------------------------------------------}

-- | Bridge the two ledgers
class (
        -- Requirements on the main block
        HasHeader              m
      , GetHeader              m
      , HasHeader     (Header  m)
      , LedgerSupportsProtocol m
      , HasHardForkHistory     m
      , LedgerSupportsMempool  m
      , CommonProtocolParams   m
      , HasTxId (GenTx         m)
      , Show (ApplyTxErr       m)

        -- Requirements on the auxiliary block
        -- No 'LedgerSupportsProtocol' for @a@!
      , Typeable                a
      , UpdateLedger            a
      , LedgerSupportsMempool   a
      , Show (ApplyTxErr        a)
      , NoThunks (LedgerConfig  a)
      , NoThunks (CodecConfig   a)
      , NoThunks (StorageConfig a)

        -- Requirements on the various bridges
      , Show      (BridgeLedger m a)
      , Eq        (BridgeLedger m a)
      , Serialise (BridgeLedger m a)
      , Serialise (BridgeBlock  m a)
      , Serialise (BridgeTx     m a)
      , Show      (BridgeTx     m a)
      ) => Bridge m a where

  -- | Additional information relating both ledgers
  type BridgeLedger m a :: Type

  -- | Information required to update the bridge when applying a block
  type BridgeBlock m a :: Type

  -- | Information required to update the bridge when applying a transaction
  type BridgeTx m a :: Type

  updateBridgeWithBlock :: DualBlock m a
                        -> BridgeLedger m a -> BridgeLedger m a

  updateBridgeWithTx :: Validated (GenTx (DualBlock m a))
                     -> BridgeLedger m a -> BridgeLedger m a

{-------------------------------------------------------------------------------
  HasHeader instance
-------------------------------------------------------------------------------}

instance Bridge m a => HasHeader (DualBlock m a) where
  getHeaderFields :: DualBlock m a -> HeaderFields (DualBlock m a)
getHeaderFields = DualBlock m a -> HeaderFields (DualBlock m a)
forall blk. GetHeader blk => blk -> HeaderFields blk
getBlockHeaderFields

instance Bridge m a => HasHeader (DualHeader m a) where
  getHeaderFields :: DualHeader m a -> HeaderFields (DualHeader m a)
getHeaderFields = HeaderFields (Header m) -> HeaderFields (DualHeader m a)
forall {k1} {k2} (b :: k1) (b' :: k2).
(HeaderHash b ~ HeaderHash b') =>
HeaderFields b -> HeaderFields b'
castHeaderFields (HeaderFields (Header m) -> HeaderFields (DualHeader m a))
-> (DualHeader m a -> HeaderFields (Header m))
-> DualHeader m a
-> HeaderFields (DualHeader m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header m -> HeaderFields (Header m)
forall b. HasHeader b => b -> HeaderFields b
getHeaderFields (Header m -> HeaderFields (Header m))
-> (DualHeader m a -> Header m)
-> DualHeader m a
-> HeaderFields (Header m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DualHeader m a -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain

instance Bridge m a => GetPrevHash (DualBlock m a) where
  headerPrevHash :: Header (DualBlock m a) -> ChainHash (DualBlock m a)
headerPrevHash = ChainHash m -> ChainHash (DualBlock m a)
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
ChainHash b -> ChainHash b'
castHash (ChainHash m -> ChainHash (DualBlock m a))
-> (Header (DualBlock m a) -> ChainHash m)
-> Header (DualBlock m a)
-> ChainHash (DualBlock m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header m -> ChainHash m
forall blk. GetPrevHash blk => Header blk -> ChainHash blk
headerPrevHash (Header m -> ChainHash m)
-> (Header (DualBlock m a) -> Header m)
-> Header (DualBlock m a)
-> ChainHash m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (DualBlock m a) -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain

{-------------------------------------------------------------------------------
  Protocol
-------------------------------------------------------------------------------}

type instance BlockProtocol (DualBlock m a) = BlockProtocol m

instance Bridge m a => BlockSupportsProtocol (DualBlock m a) where
  validateView :: BlockConfig (DualBlock m a)
-> Header (DualBlock m a)
-> ValidateView (BlockProtocol (DualBlock m a))
validateView BlockConfig (DualBlock m a)
cfg = BlockConfig m -> Header m -> ValidateView (BlockProtocol m)
forall blk.
BlockSupportsProtocol blk =>
BlockConfig blk -> Header blk -> ValidateView (BlockProtocol blk)
validateView (BlockConfig (DualBlock m a) -> BlockConfig m
forall m a. BlockConfig (DualBlock m a) -> BlockConfig m
dualBlockConfigMain BlockConfig (DualBlock m a)
cfg) (Header m -> ValidateView (BlockProtocol m))
-> (Header (DualBlock m a) -> Header m)
-> Header (DualBlock m a)
-> ValidateView (BlockProtocol m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (DualBlock m a) -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain
  selectView :: BlockConfig (DualBlock m a)
-> Header (DualBlock m a)
-> SelectView (BlockProtocol (DualBlock m a))
selectView   BlockConfig (DualBlock m a)
cfg = BlockConfig m -> Header m -> SelectView (BlockProtocol m)
forall blk.
BlockSupportsProtocol blk =>
BlockConfig blk -> Header blk -> SelectView (BlockProtocol blk)
selectView   (BlockConfig (DualBlock m a) -> BlockConfig m
forall m a. BlockConfig (DualBlock m a) -> BlockConfig m
dualBlockConfigMain BlockConfig (DualBlock m a)
cfg) (Header m -> SelectView (BlockProtocol m))
-> (Header (DualBlock m a) -> Header m)
-> Header (DualBlock m a)
-> SelectView (BlockProtocol m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (DualBlock m a) -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain

  projectChainOrderConfig :: BlockConfig (DualBlock m a)
-> ChainOrderConfig (SelectView (BlockProtocol (DualBlock m a)))
projectChainOrderConfig = BlockConfig m -> ChainOrderConfig (SelectView (BlockProtocol m))
forall blk.
BlockSupportsProtocol blk =>
BlockConfig blk
-> ChainOrderConfig (SelectView (BlockProtocol blk))
projectChainOrderConfig (BlockConfig m -> ChainOrderConfig (SelectView (BlockProtocol m)))
-> (BlockConfig (DualBlock m a) -> BlockConfig m)
-> BlockConfig (DualBlock m a)
-> ChainOrderConfig (SelectView (BlockProtocol m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BlockConfig (DualBlock m a) -> BlockConfig m
forall m a. BlockConfig (DualBlock m a) -> BlockConfig m
dualBlockConfigMain

{-------------------------------------------------------------------------------
  Ledger errors
-------------------------------------------------------------------------------}

-- | Both ledger rules threw an error
--
-- We do not verify that the errors agree, merely that they both report /some/
-- error.
--
-- If only /one/ of the two semantics reports an error, we fail with an 'error'
-- (see 'agreeOnError'), rather than a regular chain failure; if this happens,
-- it indicates a bug, and the node should fail (rather than just, for example,
-- reject a block).
data DualLedgerError m a = DualLedgerError {
        forall m a. DualLedgerError m a -> LedgerError m
dualLedgerErrorMain :: LedgerError m
      , forall m a. DualLedgerError m a -> LedgerError a
dualLedgerErrorAux  :: LedgerError a
      }
  deriving Context -> DualLedgerError m a -> IO (Maybe ThunkInfo)
Proxy (DualLedgerError m a) -> String
(Context -> DualLedgerError m a -> IO (Maybe ThunkInfo))
-> (Context -> DualLedgerError m a -> IO (Maybe ThunkInfo))
-> (Proxy (DualLedgerError m a) -> String)
-> NoThunks (DualLedgerError m a)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a. Context -> DualLedgerError m a -> IO (Maybe ThunkInfo)
forall m a. Proxy (DualLedgerError m a) -> String
$cnoThunks :: forall m a. Context -> DualLedgerError m a -> IO (Maybe ThunkInfo)
noThunks :: Context -> DualLedgerError m a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a. Context -> DualLedgerError m a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DualLedgerError m a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (DualLedgerError m a) -> String
showTypeOf :: Proxy (DualLedgerError m a) -> String
NoThunks via AllowThunk (DualLedgerError m a)

deriving instance ( Show (LedgerError m)
                  , Show (LedgerError a)
                  ) => Show (DualLedgerError m a)
deriving instance ( Eq (LedgerError m)
                  , Eq (LedgerError a)
                  ) => Eq (DualLedgerError m a)

{-------------------------------------------------------------------------------
  Update the ledger
-------------------------------------------------------------------------------}

data DualLedgerConfig m a = DualLedgerConfig {
      forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigMain :: LedgerConfig m
    , forall m a. DualLedgerConfig m a -> LedgerConfig a
dualLedgerConfigAux  :: LedgerConfig a
    }
  deriving Context -> DualLedgerConfig m a -> IO (Maybe ThunkInfo)
Proxy (DualLedgerConfig m a) -> String
(Context -> DualLedgerConfig m a -> IO (Maybe ThunkInfo))
-> (Context -> DualLedgerConfig m a -> IO (Maybe ThunkInfo))
-> (Proxy (DualLedgerConfig m a) -> String)
-> NoThunks (DualLedgerConfig m a)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a. Context -> DualLedgerConfig m a -> IO (Maybe ThunkInfo)
forall m a. Proxy (DualLedgerConfig m a) -> String
$cnoThunks :: forall m a. Context -> DualLedgerConfig m a -> IO (Maybe ThunkInfo)
noThunks :: Context -> DualLedgerConfig m a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a. Context -> DualLedgerConfig m a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DualLedgerConfig m a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (DualLedgerConfig m a) -> String
showTypeOf :: Proxy (DualLedgerConfig m a) -> String
NoThunks via AllowThunk (DualLedgerConfig m a)

type instance LedgerCfg (LedgerState (DualBlock m a)) = DualLedgerConfig m a

instance Bridge m a => HasPartialLedgerConfig (DualBlock m a)

instance Bridge m a => GetTip (LedgerState (DualBlock m a)) where
  getTip :: LedgerState (DualBlock m a) -> Point (LedgerState (DualBlock m a))
getTip = Point (LedgerState m) -> Point (LedgerState (DualBlock m a))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (LedgerState m) -> Point (LedgerState (DualBlock m a)))
-> (LedgerState (DualBlock m a) -> Point (LedgerState m))
-> LedgerState (DualBlock m a)
-> Point (LedgerState (DualBlock m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState m -> Point (LedgerState m)
forall l. GetTip l => l -> Point l
getTip (LedgerState m -> Point (LedgerState m))
-> (LedgerState (DualBlock m a) -> LedgerState m)
-> LedgerState (DualBlock m a)
-> Point (LedgerState m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (DualBlock m a) -> LedgerState m
forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain

instance Bridge m a => GetTip (Ticked (LedgerState (DualBlock m a))) where
  getTip :: Ticked (LedgerState (DualBlock m a))
-> Point (Ticked (LedgerState (DualBlock m a)))
getTip = Point (Ticked (LedgerState m))
-> Point (Ticked (LedgerState (DualBlock m a)))
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Ticked (LedgerState m))
 -> Point (Ticked (LedgerState (DualBlock m a))))
-> (Ticked (LedgerState (DualBlock m a))
    -> Point (Ticked (LedgerState m)))
-> Ticked (LedgerState (DualBlock m a))
-> Point (Ticked (LedgerState (DualBlock m a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState m) -> Point (Ticked (LedgerState m))
forall l. GetTip l => l -> Point l
getTip (Ticked (LedgerState m) -> Point (Ticked (LedgerState m)))
-> (Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m))
-> Ticked (LedgerState (DualBlock m a))
-> Point (Ticked (LedgerState m))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateMain

data instance Ticked (LedgerState (DualBlock m a)) = TickedDualLedgerState {
      forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateMain    :: Ticked (LedgerState m)
    , forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState a)
tickedDualLedgerStateAux     :: Ticked (LedgerState a)
    , forall m a.
Ticked (LedgerState (DualBlock m a)) -> BridgeLedger m a
tickedDualLedgerStateBridge  :: BridgeLedger m a

      -- | The original, unticked ledger for the auxiliary block
      --
      -- The reason we keep this in addition to the ticked ledger state is that
      -- not every main block is paired with an auxiliary block. When there is
      -- no auxiliary block, the auxiliary ledger state remains unchanged.
    , forall m a. Ticked (LedgerState (DualBlock m a)) -> LedgerState a
tickedDualLedgerStateAuxOrig :: LedgerState a
    }
  deriving Context
-> Ticked (LedgerState (DualBlock m a)) -> IO (Maybe ThunkInfo)
Proxy (Ticked (LedgerState (DualBlock m a))) -> String
(Context
 -> Ticked (LedgerState (DualBlock m a)) -> IO (Maybe ThunkInfo))
-> (Context
    -> Ticked (LedgerState (DualBlock m a)) -> IO (Maybe ThunkInfo))
-> (Proxy (Ticked (LedgerState (DualBlock m a))) -> String)
-> NoThunks (Ticked (LedgerState (DualBlock m a)))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a.
Context
-> Ticked (LedgerState (DualBlock m a)) -> IO (Maybe ThunkInfo)
forall m a. Proxy (Ticked (LedgerState (DualBlock m a))) -> String
$cnoThunks :: forall m a.
Context
-> Ticked (LedgerState (DualBlock m a)) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Ticked (LedgerState (DualBlock m a)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a.
Context
-> Ticked (LedgerState (DualBlock m a)) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> Ticked (LedgerState (DualBlock m a)) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (Ticked (LedgerState (DualBlock m a))) -> String
showTypeOf :: Proxy (Ticked (LedgerState (DualBlock m a))) -> String
NoThunks via AllowThunk (Ticked (LedgerState (DualBlock m a)))

instance Bridge m a => IsLedger (LedgerState (DualBlock m a)) where
  type LedgerErr (LedgerState (DualBlock m a)) = DualLedgerError   m a

  -- | The dual ledger events are exactly those of the main ledger; it ignores
  -- any possible auxiliary ledger events.
  --
  -- NOTE: This may change. It's unclear whether we want the two ledgers to emit
  -- the same events. And right now we only use the Dual ledger for our tests,
  -- and do so only with the Byron and ByronSpecs ledgers, neither of which have
  -- any events. So we make this easy choice for for now.
  type AuxLedgerEvent (LedgerState (DualBlock m a)) = AuxLedgerEvent (LedgerState m)

  applyChainTickLedgerResult :: ComputeLedgerEvents
-> LedgerCfg (LedgerState (DualBlock m a))
-> SlotNo
-> LedgerState (DualBlock m a)
-> LedgerResult
     (LedgerState (DualBlock m a))
     (Ticked (LedgerState (DualBlock m a)))
applyChainTickLedgerResult ComputeLedgerEvents
evs
                             DualLedgerConfig{LedgerConfig m
LedgerConfig a
dualLedgerConfigMain :: forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigAux :: forall m a. DualLedgerConfig m a -> LedgerConfig a
dualLedgerConfigMain :: LedgerConfig m
dualLedgerConfigAux :: LedgerConfig a
..}
                             SlotNo
slot
                             DualLedgerState{LedgerState m
LedgerState a
BridgeLedger m a
dualLedgerStateMain :: forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain :: LedgerState m
dualLedgerStateAux :: LedgerState a
dualLedgerStateBridge :: BridgeLedger m a
dualLedgerStateAux :: forall m a. LedgerState (DualBlock m a) -> LedgerState a
dualLedgerStateBridge :: forall m a. LedgerState (DualBlock m a) -> BridgeLedger m a
..} =
      LedgerResult (LedgerState m) (Ticked (LedgerState m))
-> LedgerResult
     (LedgerState (DualBlock m a)) (Ticked (LedgerState m))
forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult (LedgerState m) (Ticked (LedgerState m))
ledgerResult LedgerResult (LedgerState (DualBlock m a)) (Ticked (LedgerState m))
-> (Ticked (LedgerState m) -> Ticked (LedgerState (DualBlock m a)))
-> LedgerResult
     (LedgerState (DualBlock m a))
     (Ticked (LedgerState (DualBlock m a)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Ticked (LedgerState m)
main -> TickedDualLedgerState {
          tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateMain    = Ticked (LedgerState m)
main
        , tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateAux     = ComputeLedgerEvents
-> LedgerConfig a
-> SlotNo
-> LedgerState a
-> Ticked (LedgerState a)
forall l.
IsLedger l =>
ComputeLedgerEvents -> LedgerCfg l -> SlotNo -> l -> Ticked l
applyChainTick ComputeLedgerEvents
evs
                                           LedgerConfig a
dualLedgerConfigAux
                                           SlotNo
slot
                                          LedgerState a
dualLedgerStateAux
        , tickedDualLedgerStateAuxOrig :: LedgerState a
tickedDualLedgerStateAuxOrig = LedgerState a
dualLedgerStateAux
        , tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateBridge  = BridgeLedger m a
dualLedgerStateBridge
        }
    where
      ledgerResult :: LedgerResult (LedgerState m) (Ticked (LedgerState m))
ledgerResult = ComputeLedgerEvents
-> LedgerConfig m
-> SlotNo
-> LedgerState m
-> LedgerResult (LedgerState m) (Ticked (LedgerState m))
forall l.
IsLedger l =>
ComputeLedgerEvents
-> LedgerCfg l -> SlotNo -> l -> LedgerResult l (Ticked l)
applyChainTickLedgerResult ComputeLedgerEvents
evs
                       LedgerConfig m
dualLedgerConfigMain
                       SlotNo
slot
                       LedgerState m
dualLedgerStateMain

applyHelper ::
     Bridge m a
  => (   ComputeLedgerEvents
      -> LedgerCfg (LedgerState m)
      -> m
      -> Ticked (LedgerState m)
      -> Except (LedgerErr (LedgerState m)) (LedgerResult (LedgerState m) (LedgerState m))
     )
  -> ComputeLedgerEvents
  -> DualLedgerConfig m a
  -> DualBlock m a
  -> Ticked (LedgerState (DualBlock m a))
  -> Except (DualLedgerError m a) (LedgerResult (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
applyHelper :: forall m a.
Bridge m a =>
(ComputeLedgerEvents
 -> LedgerCfg (LedgerState m)
 -> m
 -> Ticked (LedgerState m)
 -> Except
      (LedgerErr (LedgerState m))
      (LedgerResult (LedgerState m) (LedgerState m)))
-> ComputeLedgerEvents
-> DualLedgerConfig m a
-> DualBlock m a
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (DualLedgerError m a)
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
applyHelper ComputeLedgerEvents
-> LedgerCfg (LedgerState m)
-> m
-> Ticked (LedgerState m)
-> Except
     (LedgerErr (LedgerState m))
     (LedgerResult (LedgerState m) (LedgerState m))
f ComputeLedgerEvents
opts DualLedgerConfig m a
cfg block :: DualBlock m a
block@DualBlock{m
Maybe a
BridgeBlock m a
dualBlockMain :: forall m a. DualBlock m a -> m
dualBlockAux :: forall m a. DualBlock m a -> Maybe a
dualBlockBridge :: forall m a. DualBlock m a -> BridgeBlock m a
dualBlockMain :: m
dualBlockAux :: Maybe a
dualBlockBridge :: BridgeBlock m a
..} TickedDualLedgerState{Ticked (LedgerState m)
Ticked (LedgerState a)
LedgerState a
BridgeLedger m a
tickedDualLedgerStateMain :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateAux :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState a)
tickedDualLedgerStateBridge :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> BridgeLedger m a
tickedDualLedgerStateAuxOrig :: forall m a. Ticked (LedgerState (DualBlock m a)) -> LedgerState a
tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateAuxOrig :: LedgerState a
..} = do
      (LedgerResult (LedgerState m) (LedgerState m)
ledgerResult, LedgerState a
aux') <-
        (LedgerErr (LedgerState m)
 -> LedgerErr (LedgerState a) -> DualLedgerError m a)
-> (Except
      (LedgerErr (LedgerState m))
      (LedgerResult (LedgerState m) (LedgerState m)),
    Except (LedgerErr (LedgerState a)) (LedgerState a))
-> Except
     (DualLedgerError m a)
     (LedgerResult (LedgerState m) (LedgerState m), LedgerState a)
forall e e' err a b.
(Show e, Show e', HasCallStack) =>
(e -> e' -> err) -> (Except e a, Except e' b) -> Except err (a, b)
agreeOnError LedgerErr (LedgerState m)
-> LedgerErr (LedgerState a) -> DualLedgerError m a
forall m a. LedgerError m -> LedgerError a -> DualLedgerError m a
DualLedgerError (
             ComputeLedgerEvents
-> LedgerCfg (LedgerState m)
-> m
-> Ticked (LedgerState m)
-> Except
     (LedgerErr (LedgerState m))
     (LedgerResult (LedgerState m) (LedgerState m))
f ComputeLedgerEvents
opts
              (DualLedgerConfig m a -> LedgerCfg (LedgerState m)
forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigMain DualLedgerConfig m a
cfg)
              m
dualBlockMain
              Ticked (LedgerState m)
tickedDualLedgerStateMain
          , ComputeLedgerEvents
-> LedgerConfig a
-> Maybe a
-> Ticked (LedgerState a)
-> LedgerState a
-> Except (LedgerErr (LedgerState a)) (LedgerState a)
forall blk.
UpdateLedger blk =>
ComputeLedgerEvents
-> LedgerConfig blk
-> Maybe blk
-> TickedLedgerState blk
-> LedgerState blk
-> Except (LedgerError blk) (LedgerState blk)
applyMaybeBlock ComputeLedgerEvents
opts
              (DualLedgerConfig m a -> LedgerConfig a
forall m a. DualLedgerConfig m a -> LedgerConfig a
dualLedgerConfigAux DualLedgerConfig m a
cfg)
              Maybe a
dualBlockAux
              Ticked (LedgerState a)
tickedDualLedgerStateAux
              LedgerState a
tickedDualLedgerStateAuxOrig
          )
      LedgerResult
  (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))
-> Except
     (DualLedgerError m a)
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
forall a. a -> ExceptT (DualLedgerError m a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerResult
   (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))
 -> Except
      (DualLedgerError m a)
      (LedgerResult
         (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))))
-> LedgerResult
     (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))
-> Except
     (DualLedgerError m a)
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
forall a b. (a -> b) -> a -> b
$ LedgerResult (LedgerState m) (LedgerState m)
-> LedgerResult (LedgerState (DualBlock m a)) (LedgerState m)
forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult (LedgerState m) (LedgerState m)
ledgerResult LedgerResult (LedgerState (DualBlock m a)) (LedgerState m)
-> (LedgerState m -> LedgerState (DualBlock m a))
-> LedgerResult
     (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \LedgerState m
main' -> DualLedgerState {
          dualLedgerStateMain :: LedgerState m
dualLedgerStateMain   = LedgerState m
main'
        , dualLedgerStateAux :: LedgerState a
dualLedgerStateAux    = LedgerState a
aux'
        , dualLedgerStateBridge :: BridgeLedger m a
dualLedgerStateBridge = DualBlock m a -> BridgeLedger m a -> BridgeLedger m a
forall m a.
Bridge m a =>
DualBlock m a -> BridgeLedger m a -> BridgeLedger m a
updateBridgeWithBlock
                                    DualBlock m a
block
                                    BridgeLedger m a
tickedDualLedgerStateBridge
        }

instance Bridge m a => ApplyBlock (LedgerState (DualBlock m a)) (DualBlock m a) where

  applyBlockLedgerResultWithValidation :: HasCallStack =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState (DualBlock m a))
-> DualBlock m a
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (LedgerErr (LedgerState (DualBlock m a)))
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
applyBlockLedgerResultWithValidation ValidationPolicy
doValidate =
    (ComputeLedgerEvents
 -> LedgerCfg (LedgerState m)
 -> m
 -> Ticked (LedgerState m)
 -> Except
      (LedgerErr (LedgerState m))
      (LedgerResult (LedgerState m) (LedgerState m)))
-> ComputeLedgerEvents
-> DualLedgerConfig m a
-> DualBlock m a
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (DualLedgerError m a)
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
forall m a.
Bridge m a =>
(ComputeLedgerEvents
 -> LedgerCfg (LedgerState m)
 -> m
 -> Ticked (LedgerState m)
 -> Except
      (LedgerErr (LedgerState m))
      (LedgerResult (LedgerState m) (LedgerState m)))
-> ComputeLedgerEvents
-> DualLedgerConfig m a
-> DualBlock m a
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (DualLedgerError m a)
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
applyHelper (ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg (LedgerState m)
-> m
-> Ticked (LedgerState m)
-> Except
     (LedgerErr (LedgerState m))
     (LedgerResult (LedgerState m) (LedgerState m))
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
ValidationPolicy
-> ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l
-> Except (LedgerErr l) (LedgerResult l l)
applyBlockLedgerResultWithValidation ValidationPolicy
doValidate)

  applyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState (DualBlock m a))
-> DualBlock m a
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (LedgerErr (LedgerState (DualBlock m a)))
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
applyBlockLedgerResult =
    (ComputeLedgerEvents
 -> LedgerCfg (LedgerState m)
 -> m
 -> Ticked (LedgerState m)
 -> Except
      (LedgerErr (LedgerState m))
      (LedgerResult (LedgerState m) (LedgerState m)))
-> ComputeLedgerEvents
-> DualLedgerConfig m a
-> DualBlock m a
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (DualLedgerError m a)
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
forall m a.
Bridge m a =>
(ComputeLedgerEvents
 -> LedgerCfg (LedgerState m)
 -> m
 -> Ticked (LedgerState m)
 -> Except
      (LedgerErr (LedgerState m))
      (LedgerResult (LedgerState m) (LedgerState m)))
-> ComputeLedgerEvents
-> DualLedgerConfig m a
-> DualBlock m a
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (DualLedgerError m a)
     (LedgerResult
        (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a)))
applyHelper ComputeLedgerEvents
-> LedgerCfg (LedgerState m)
-> m
-> Ticked (LedgerState m)
-> Except
     (LedgerErr (LedgerState m))
     (LedgerResult (LedgerState m) (LedgerState m))
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l
-> blk
-> Ticked l
-> Except (LedgerErr l) (LedgerResult l l)
applyBlockLedgerResult

  reapplyBlockLedgerResult :: HasCallStack =>
ComputeLedgerEvents
-> LedgerCfg (LedgerState (DualBlock m a))
-> DualBlock m a
-> Ticked (LedgerState (DualBlock m a))
-> LedgerResult
     (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))
reapplyBlockLedgerResult ComputeLedgerEvents
evs LedgerCfg (LedgerState (DualBlock m a))
cfg
                           block :: DualBlock m a
block@DualBlock{m
Maybe a
BridgeBlock m a
dualBlockMain :: forall m a. DualBlock m a -> m
dualBlockAux :: forall m a. DualBlock m a -> Maybe a
dualBlockBridge :: forall m a. DualBlock m a -> BridgeBlock m a
dualBlockMain :: m
dualBlockAux :: Maybe a
dualBlockBridge :: BridgeBlock m a
..}
                           TickedDualLedgerState{Ticked (LedgerState m)
Ticked (LedgerState a)
LedgerState a
BridgeLedger m a
tickedDualLedgerStateMain :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateAux :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState a)
tickedDualLedgerStateBridge :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> BridgeLedger m a
tickedDualLedgerStateAuxOrig :: forall m a. Ticked (LedgerState (DualBlock m a)) -> LedgerState a
tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateAuxOrig :: LedgerState a
..} =
    LedgerResult (LedgerState m) (LedgerState m)
-> LedgerResult (LedgerState (DualBlock m a)) (LedgerState m)
forall l l' a.
(AuxLedgerEvent l ~ AuxLedgerEvent l') =>
LedgerResult l a -> LedgerResult l' a
castLedgerResult LedgerResult (LedgerState m) (LedgerState m)
ledgerResult LedgerResult (LedgerState (DualBlock m a)) (LedgerState m)
-> (LedgerState m -> LedgerState (DualBlock m a))
-> LedgerResult
     (LedgerState (DualBlock m a)) (LedgerState (DualBlock m a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \LedgerState m
main' -> DualLedgerState {
        dualLedgerStateMain :: LedgerState m
dualLedgerStateMain   = LedgerState m
main'
      , dualLedgerStateAux :: LedgerState a
dualLedgerStateAux    = ComputeLedgerEvents
-> LedgerConfig a
-> Maybe a
-> Ticked (LedgerState a)
-> LedgerState a
-> LedgerState a
forall blk.
UpdateLedger blk =>
ComputeLedgerEvents
-> LedgerConfig blk
-> Maybe blk
-> TickedLedgerState blk
-> LedgerState blk
-> LedgerState blk
reapplyMaybeBlock ComputeLedgerEvents
evs
                                  (DualLedgerConfig m a -> LedgerConfig a
forall m a. DualLedgerConfig m a -> LedgerConfig a
dualLedgerConfigAux LedgerCfg (LedgerState (DualBlock m a))
DualLedgerConfig m a
cfg)
                                  Maybe a
dualBlockAux
                                  Ticked (LedgerState a)
tickedDualLedgerStateAux
                                  LedgerState a
tickedDualLedgerStateAuxOrig
      , dualLedgerStateBridge :: BridgeLedger m a
dualLedgerStateBridge = DualBlock m a -> BridgeLedger m a -> BridgeLedger m a
forall m a.
Bridge m a =>
DualBlock m a -> BridgeLedger m a -> BridgeLedger m a
updateBridgeWithBlock
                                  DualBlock m a
block
                                  BridgeLedger m a
tickedDualLedgerStateBridge
      }
    where
      ledgerResult :: LedgerResult (LedgerState m) (LedgerState m)
ledgerResult = ComputeLedgerEvents
-> LedgerCfg (LedgerState m)
-> m
-> Ticked (LedgerState m)
-> LedgerResult (LedgerState m) (LedgerState m)
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l -> blk -> Ticked l -> LedgerResult l l
reapplyBlockLedgerResult ComputeLedgerEvents
evs
                       (DualLedgerConfig m a -> LedgerCfg (LedgerState m)
forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigMain LedgerCfg (LedgerState (DualBlock m a))
DualLedgerConfig m a
cfg)
                       m
dualBlockMain
                       Ticked (LedgerState m)
tickedDualLedgerStateMain

data instance LedgerState (DualBlock m a) = DualLedgerState {
      forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain   :: LedgerState m
    , forall m a. LedgerState (DualBlock m a) -> LedgerState a
dualLedgerStateAux    :: LedgerState a
    , forall m a. LedgerState (DualBlock m a) -> BridgeLedger m a
dualLedgerStateBridge :: BridgeLedger m a
    }
  deriving Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo)
Proxy (LedgerState (DualBlock m a)) -> String
(Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo))
-> (Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo))
-> (Proxy (LedgerState (DualBlock m a)) -> String)
-> NoThunks (LedgerState (DualBlock m a))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a.
Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo)
forall m a. Proxy (LedgerState (DualBlock m a)) -> String
$cnoThunks :: forall m a.
Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo)
noThunks :: Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a.
Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LedgerState (DualBlock m a) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (LedgerState (DualBlock m a)) -> String
showTypeOf :: Proxy (LedgerState (DualBlock m a)) -> String
NoThunks via AllowThunk (LedgerState (DualBlock m a))

instance Bridge m a => UpdateLedger (DualBlock m a)

deriving instance ( Bridge m a
                  ) => Show (LedgerState (DualBlock m a))
deriving instance ( Bridge m a
                  ) => Eq (LedgerState (DualBlock m a))

{-------------------------------------------------------------------------------
  Utilities for working with the extended ledger state
-------------------------------------------------------------------------------}

dualExtValidationErrorMain :: ExtValidationError (DualBlock m a)
                           -> ExtValidationError m
dualExtValidationErrorMain :: forall m a.
ExtValidationError (DualBlock m a) -> ExtValidationError m
dualExtValidationErrorMain = \case
    ExtValidationErrorLedger LedgerError (DualBlock m a)
e -> LedgerError m -> ExtValidationError m
forall blk. LedgerError blk -> ExtValidationError blk
ExtValidationErrorLedger (DualLedgerError m a -> LedgerError m
forall m a. DualLedgerError m a -> LedgerError m
dualLedgerErrorMain LedgerError (DualBlock m a)
DualLedgerError m a
e)
    ExtValidationErrorHeader HeaderError (DualBlock m a)
e -> HeaderError m -> ExtValidationError m
forall blk. HeaderError blk -> ExtValidationError blk
ExtValidationErrorHeader (HeaderError (DualBlock m a) -> HeaderError m
forall blk blk'.
(ValidationErr (BlockProtocol blk)
 ~ ValidationErr (BlockProtocol blk'),
 HeaderHash blk ~ HeaderHash blk',
 OtherHeaderEnvelopeError blk ~ OtherHeaderEnvelopeError blk') =>
HeaderError blk -> HeaderError blk'
castHeaderError     HeaderError (DualBlock m a)
e)

{-------------------------------------------------------------------------------
  LedgerSupportsProtocol

  These definitions are asymmetric because the auxiliary block is not involved
  in the consensus protocol, and has no 'LedgerSupportsProtocol' instance.
-------------------------------------------------------------------------------}

instance Bridge m a => HasAnnTip (DualBlock m a) where
  type TipInfo (DualBlock m a) = TipInfo m
  tipInfoHash :: forall (proxy :: * -> *).
proxy (DualBlock m a)
-> TipInfo (DualBlock m a) -> HeaderHash (DualBlock m a)
tipInfoHash proxy (DualBlock m a)
_ = Proxy m -> TipInfo m -> HeaderHash m
forall blk (proxy :: * -> *).
HasAnnTip blk =>
proxy blk -> TipInfo blk -> HeaderHash blk
forall (proxy :: * -> *). proxy m -> TipInfo m -> HeaderHash m
tipInfoHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
  getTipInfo :: Header (DualBlock m a) -> TipInfo (DualBlock m a)
getTipInfo    = Header m -> TipInfo m
forall blk. HasAnnTip blk => Header blk -> TipInfo blk
getTipInfo (Header m -> TipInfo m)
-> (Header (DualBlock m a) -> Header m)
-> Header (DualBlock m a)
-> TipInfo m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (DualBlock m a) -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain

instance Bridge m a => BasicEnvelopeValidation (DualBlock m a) where
  expectedFirstBlockNo :: forall (proxy :: * -> *). proxy (DualBlock m a) -> BlockNo
expectedFirstBlockNo  proxy (DualBlock m a)
_ = Proxy m -> BlockNo
forall blk (proxy :: * -> *).
BasicEnvelopeValidation blk =>
proxy blk -> BlockNo
forall (proxy :: * -> *). proxy m -> BlockNo
expectedFirstBlockNo  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
  expectedNextBlockNo :: forall (proxy :: * -> *).
proxy (DualBlock m a)
-> TipInfo (DualBlock m a)
-> TipInfo (DualBlock m a)
-> BlockNo
-> BlockNo
expectedNextBlockNo   proxy (DualBlock m a)
_ = Proxy m -> TipInfo m -> TipInfo m -> BlockNo -> BlockNo
forall blk (proxy :: * -> *).
BasicEnvelopeValidation blk =>
proxy blk -> TipInfo blk -> TipInfo blk -> BlockNo -> BlockNo
forall (proxy :: * -> *).
proxy m -> TipInfo m -> TipInfo m -> BlockNo -> BlockNo
expectedNextBlockNo   (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
  minimumPossibleSlotNo :: Proxy (DualBlock m a) -> SlotNo
minimumPossibleSlotNo Proxy (DualBlock m a)
_ = Proxy m -> SlotNo
forall blk. BasicEnvelopeValidation blk => Proxy blk -> SlotNo
minimumPossibleSlotNo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)
  minimumNextSlotNo :: forall (proxy :: * -> *).
proxy (DualBlock m a)
-> TipInfo (DualBlock m a)
-> TipInfo (DualBlock m a)
-> SlotNo
-> SlotNo
minimumNextSlotNo     proxy (DualBlock m a)
_ = Proxy m -> TipInfo m -> TipInfo m -> SlotNo -> SlotNo
forall blk (proxy :: * -> *).
BasicEnvelopeValidation blk =>
proxy blk -> TipInfo blk -> TipInfo blk -> SlotNo -> SlotNo
forall (proxy :: * -> *).
proxy m -> TipInfo m -> TipInfo m -> SlotNo -> SlotNo
minimumNextSlotNo     (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @m)

instance Bridge m a => ValidateEnvelope (DualBlock m a) where
  type OtherHeaderEnvelopeError (DualBlock m a) = OtherHeaderEnvelopeError m

  additionalEnvelopeChecks :: TopLevelConfig (DualBlock m a)
-> LedgerView (BlockProtocol (DualBlock m a))
-> Header (DualBlock m a)
-> Except (OtherHeaderEnvelopeError (DualBlock m a)) ()
additionalEnvelopeChecks TopLevelConfig (DualBlock m a)
cfg LedgerView (BlockProtocol (DualBlock m a))
ledgerView Header (DualBlock m a)
hdr =
      TopLevelConfig m
-> LedgerView (BlockProtocol m)
-> Header m
-> Except (OtherHeaderEnvelopeError m) ()
forall blk.
ValidateEnvelope blk =>
TopLevelConfig blk
-> LedgerView (BlockProtocol blk)
-> Header blk
-> Except (OtherHeaderEnvelopeError blk) ()
additionalEnvelopeChecks
        (TopLevelConfig (DualBlock m a) -> TopLevelConfig m
forall m a. TopLevelConfig (DualBlock m a) -> TopLevelConfig m
dualTopLevelConfigMain TopLevelConfig (DualBlock m a)
cfg)
        LedgerView (BlockProtocol m)
LedgerView (BlockProtocol (DualBlock m a))
ledgerView
        (Header (DualBlock m a) -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain Header (DualBlock m a)
hdr)

instance Bridge m a => LedgerSupportsProtocol (DualBlock m a) where
  protocolLedgerView :: LedgerConfig (DualBlock m a)
-> Ticked (LedgerState (DualBlock m a))
-> LedgerView (BlockProtocol (DualBlock m a))
protocolLedgerView LedgerConfig (DualBlock m a)
cfg Ticked (LedgerState (DualBlock m a))
state =
      LedgerConfig m
-> Ticked (LedgerState m) -> LedgerView (BlockProtocol m)
forall blk.
LedgerSupportsProtocol blk =>
LedgerConfig blk
-> Ticked (LedgerState blk) -> LedgerView (BlockProtocol blk)
protocolLedgerView
        (DualLedgerConfig m a -> LedgerConfig m
forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigMain      LedgerConfig (DualBlock m a)
DualLedgerConfig m a
cfg)
        (Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateMain Ticked (LedgerState (DualBlock m a))
state)

  ledgerViewForecastAt :: HasCallStack =>
LedgerConfig (DualBlock m a)
-> LedgerState (DualBlock m a)
-> Forecast (LedgerView (BlockProtocol (DualBlock m a)))
ledgerViewForecastAt LedgerConfig (DualBlock m a)
cfg LedgerState (DualBlock m a)
state =
      LedgerConfig m
-> LedgerState m -> Forecast (LedgerView (BlockProtocol m))
forall blk.
(LedgerSupportsProtocol blk, HasCallStack) =>
LedgerConfig blk
-> LedgerState blk -> Forecast (LedgerView (BlockProtocol blk))
ledgerViewForecastAt
        (DualLedgerConfig m a -> LedgerConfig m
forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigMain LedgerConfig (DualBlock m a)
DualLedgerConfig m a
cfg)
        (LedgerState (DualBlock m a) -> LedgerState m
forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain  LedgerState (DualBlock m a)
state)

instance Bridge m a => HasHardForkHistory (DualBlock m a) where
  type HardForkIndices (DualBlock m a) = HardForkIndices m

  hardForkSummary :: LedgerConfig (DualBlock m a)
-> LedgerState (DualBlock m a)
-> Summary (HardForkIndices (DualBlock m a))
hardForkSummary LedgerConfig (DualBlock m a)
cfg LedgerState (DualBlock m a)
state =
      LedgerConfig m -> LedgerState m -> Summary (HardForkIndices m)
forall blk.
HasHardForkHistory blk =>
LedgerConfig blk
-> LedgerState blk -> Summary (HardForkIndices blk)
hardForkSummary
        (DualLedgerConfig m a -> LedgerConfig m
forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigMain LedgerConfig (DualBlock m a)
DualLedgerConfig m a
cfg)
        (LedgerState (DualBlock m a) -> LedgerState m
forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain  LedgerState (DualBlock m a)
state)

{-------------------------------------------------------------------------------
  Querying the ledger
-------------------------------------------------------------------------------}

data instance BlockQuery (DualBlock m a) result
  deriving (Int -> BlockQuery (DualBlock m a) result -> ShowS
[BlockQuery (DualBlock m a) result] -> ShowS
BlockQuery (DualBlock m a) result -> String
(Int -> BlockQuery (DualBlock m a) result -> ShowS)
-> (BlockQuery (DualBlock m a) result -> String)
-> ([BlockQuery (DualBlock m a) result] -> ShowS)
-> Show (BlockQuery (DualBlock m a) result)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall m a result.
Int -> BlockQuery (DualBlock m a) result -> ShowS
forall m a result. [BlockQuery (DualBlock m a) result] -> ShowS
forall m a result. BlockQuery (DualBlock m a) result -> String
$cshowsPrec :: forall m a result.
Int -> BlockQuery (DualBlock m a) result -> ShowS
showsPrec :: Int -> BlockQuery (DualBlock m a) result -> ShowS
$cshow :: forall m a result. BlockQuery (DualBlock m a) result -> String
show :: BlockQuery (DualBlock m a) result -> String
$cshowList :: forall m a result. [BlockQuery (DualBlock m a) result] -> ShowS
showList :: [BlockQuery (DualBlock m a) result] -> ShowS
Show)

instance (Typeable m, Typeable a)
    => ShowProxy (BlockQuery (DualBlock m a)) where

-- | Not used in the tests: no constructors
instance Bridge m a => BlockSupportsLedgerQuery (DualBlock m a) where
  answerBlockQuery :: forall result.
ExtLedgerCfg (DualBlock m a)
-> BlockQuery (DualBlock m a) result
-> ExtLedgerState (DualBlock m a)
-> result
answerBlockQuery ExtLedgerCfg (DualBlock m a)
_ = \case {}
  blockQueryIsSupportedOnVersion :: forall result.
BlockQuery (DualBlock m a) result
-> BlockNodeToClientVersion (DualBlock m a) -> Bool
blockQueryIsSupportedOnVersion BlockQuery (DualBlock m a) result
qry BlockNodeToClientVersion (DualBlock m a)
_ = case BlockQuery (DualBlock m a) result
qry of {}

instance SameDepIndex (BlockQuery (DualBlock m a)) where
  sameDepIndex :: forall a b.
BlockQuery (DualBlock m a) a
-> BlockQuery (DualBlock m a) b -> Maybe (a :~: b)
sameDepIndex = \case {}

instance ShowQuery (BlockQuery (DualBlock m a)) where
  showResult :: forall result.
BlockQuery (DualBlock m a) result -> result -> String
showResult = \case {}

-- | Forward to the main ledger
instance Bridge m a => CommonProtocolParams (DualBlock m a) where
  maxHeaderSize :: LedgerState (DualBlock m a) -> Word32
maxHeaderSize = LedgerState m -> Word32
forall blk. CommonProtocolParams blk => LedgerState blk -> Word32
maxHeaderSize (LedgerState m -> Word32)
-> (LedgerState (DualBlock m a) -> LedgerState m)
-> LedgerState (DualBlock m a)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (DualBlock m a) -> LedgerState m
forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain
  maxTxSize :: LedgerState (DualBlock m a) -> Word32
maxTxSize     = LedgerState m -> Word32
forall blk. CommonProtocolParams blk => LedgerState blk -> Word32
maxTxSize     (LedgerState m -> Word32)
-> (LedgerState (DualBlock m a) -> LedgerState m)
-> LedgerState (DualBlock m a)
-> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (DualBlock m a) -> LedgerState m
forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain

{-------------------------------------------------------------------------------
  Mempool support
-------------------------------------------------------------------------------}

data DualGenTxErr m a = DualGenTxErr {
      forall m a. DualGenTxErr m a -> ApplyTxErr m
dualGenTxErrMain :: ApplyTxErr m
    , forall m a. DualGenTxErr m a -> ApplyTxErr a
dualGenTxErrAux  :: ApplyTxErr a
    }

instance (Typeable m, Typeable a)
    => ShowProxy (DualGenTxErr m a) where

data instance GenTx (DualBlock m a) = DualGenTx {
      forall m a. GenTx (DualBlock m a) -> GenTx m
dualGenTxMain   :: GenTx m
    , forall m a. GenTx (DualBlock m a) -> GenTx a
dualGenTxAux    :: GenTx a
    , forall m a. GenTx (DualBlock m a) -> BridgeTx m a
dualGenTxBridge :: BridgeTx m a
    }
  deriving Context -> GenTx (DualBlock m a) -> IO (Maybe ThunkInfo)
Proxy (GenTx (DualBlock m a)) -> String
(Context -> GenTx (DualBlock m a) -> IO (Maybe ThunkInfo))
-> (Context -> GenTx (DualBlock m a) -> IO (Maybe ThunkInfo))
-> (Proxy (GenTx (DualBlock m a)) -> String)
-> NoThunks (GenTx (DualBlock m a))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a.
Context -> GenTx (DualBlock m a) -> IO (Maybe ThunkInfo)
forall m a. Proxy (GenTx (DualBlock m a)) -> String
$cnoThunks :: forall m a.
Context -> GenTx (DualBlock m a) -> IO (Maybe ThunkInfo)
noThunks :: Context -> GenTx (DualBlock m a) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a.
Context -> GenTx (DualBlock m a) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> GenTx (DualBlock m a) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (GenTx (DualBlock m a)) -> String
showTypeOf :: Proxy (GenTx (DualBlock m a)) -> String
NoThunks via AllowThunk (GenTx (DualBlock m a))

data instance Validated (GenTx (DualBlock m a)) = ValidatedDualGenTx {
      forall m a.
Validated (GenTx (DualBlock m a)) -> Validated (GenTx m)
vDualGenTxMain   :: Validated (GenTx m)
    , forall m a.
Validated (GenTx (DualBlock m a)) -> Validated (GenTx a)
vDualGenTxAux    :: Validated (GenTx a)
    , forall m a. Validated (GenTx (DualBlock m a)) -> BridgeTx m a
vDualGenTxBridge :: BridgeTx m a
    }
  deriving Context
-> Validated (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
Proxy (Validated (GenTx (DualBlock m a))) -> String
(Context
 -> Validated (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo))
-> (Context
    -> Validated (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo))
-> (Proxy (Validated (GenTx (DualBlock m a))) -> String)
-> NoThunks (Validated (GenTx (DualBlock m a)))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a.
Context
-> Validated (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
forall m a. Proxy (Validated (GenTx (DualBlock m a))) -> String
$cnoThunks :: forall m a.
Context
-> Validated (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
noThunks :: Context
-> Validated (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a.
Context
-> Validated (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
wNoThunks :: Context
-> Validated (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (Validated (GenTx (DualBlock m a))) -> String
showTypeOf :: Proxy (Validated (GenTx (DualBlock m a))) -> String
NoThunks via AllowThunk (Validated (GenTx (DualBlock m a)))

instance (Typeable m, Typeable a)
    => ShowProxy (GenTx (DualBlock m a)) where

type instance ApplyTxErr (DualBlock m a) = DualGenTxErr m a

instance Bridge m a => LedgerSupportsMempool (DualBlock m a) where
  applyTx :: LedgerConfig (DualBlock m a)
-> WhetherToIntervene
-> SlotNo
-> GenTx (DualBlock m a)
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (ApplyTxErr (DualBlock m a))
     (Ticked (LedgerState (DualBlock m a)),
      Validated (GenTx (DualBlock m a)))
applyTx DualLedgerConfig{LedgerConfig m
LedgerConfig a
dualLedgerConfigMain :: forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigAux :: forall m a. DualLedgerConfig m a -> LedgerConfig a
dualLedgerConfigMain :: LedgerConfig m
dualLedgerConfigAux :: LedgerConfig a
..}
          WhetherToIntervene
wti
          SlotNo
slot
          DualGenTx{GenTx m
GenTx a
BridgeTx m a
dualGenTxMain :: forall m a. GenTx (DualBlock m a) -> GenTx m
dualGenTxAux :: forall m a. GenTx (DualBlock m a) -> GenTx a
dualGenTxBridge :: forall m a. GenTx (DualBlock m a) -> BridgeTx m a
dualGenTxMain :: GenTx m
dualGenTxAux :: GenTx a
dualGenTxBridge :: BridgeTx m a
..}
          TickedDualLedgerState{Ticked (LedgerState m)
Ticked (LedgerState a)
LedgerState a
BridgeLedger m a
tickedDualLedgerStateMain :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateAux :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState a)
tickedDualLedgerStateBridge :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> BridgeLedger m a
tickedDualLedgerStateAuxOrig :: forall m a. Ticked (LedgerState (DualBlock m a)) -> LedgerState a
tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateAuxOrig :: LedgerState a
..} = do
      ((Ticked (LedgerState m)
main', Validated (GenTx m)
mainVtx), (Ticked (LedgerState a)
aux', Validated (GenTx a)
auxVtx)) <-
        (ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a)
-> (Except
      (ApplyTxErr m) (Ticked (LedgerState m), Validated (GenTx m)),
    Except
      (ApplyTxErr a) (Ticked (LedgerState a), Validated (GenTx a)))
-> Except
     (DualGenTxErr m a)
     ((Ticked (LedgerState m), Validated (GenTx m)),
      (Ticked (LedgerState a), Validated (GenTx a)))
forall e e' err a b.
(Show e, Show e', HasCallStack) =>
(e -> e' -> err) -> (Except e a, Except e' b) -> Except err (a, b)
agreeOnError ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a
forall m a. ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a
DualGenTxErr (
            LedgerConfig m
-> WhetherToIntervene
-> SlotNo
-> GenTx m
-> Ticked (LedgerState m)
-> Except
     (ApplyTxErr m) (Ticked (LedgerState m), Validated (GenTx m))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> Except
     (ApplyTxErr blk) (Ticked (LedgerState blk), Validated (GenTx blk))
applyTx
              LedgerConfig m
dualLedgerConfigMain
              WhetherToIntervene
wti
              SlotNo
slot
              GenTx m
dualGenTxMain
              Ticked (LedgerState m)
tickedDualLedgerStateMain
          , LedgerConfig a
-> WhetherToIntervene
-> SlotNo
-> GenTx a
-> Ticked (LedgerState a)
-> Except
     (ApplyTxErr a) (Ticked (LedgerState a), Validated (GenTx a))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> Ticked (LedgerState blk)
-> Except
     (ApplyTxErr blk) (Ticked (LedgerState blk), Validated (GenTx blk))
applyTx
              LedgerConfig a
dualLedgerConfigAux
              WhetherToIntervene
wti
              SlotNo
slot
              GenTx a
dualGenTxAux
              Ticked (LedgerState a)
tickedDualLedgerStateAux
          )
      let vtx :: Validated (GenTx (DualBlock m a))
vtx = ValidatedDualGenTx {
                vDualGenTxMain :: Validated (GenTx m)
vDualGenTxMain   = Validated (GenTx m)
mainVtx
              , vDualGenTxAux :: Validated (GenTx a)
vDualGenTxAux    = Validated (GenTx a)
auxVtx
              , vDualGenTxBridge :: BridgeTx m a
vDualGenTxBridge = BridgeTx m a
dualGenTxBridge
              }
      (Ticked (LedgerState (DualBlock m a)),
 Validated (GenTx (DualBlock m a)))
-> ExceptT
     (DualGenTxErr m a)
     Identity
     (Ticked (LedgerState (DualBlock m a)),
      Validated (GenTx (DualBlock m a)))
forall a. a -> ExceptT (DualGenTxErr m a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Ticked (LedgerState (DualBlock m a)),
  Validated (GenTx (DualBlock m a)))
 -> ExceptT
      (DualGenTxErr m a)
      Identity
      (Ticked (LedgerState (DualBlock m a)),
       Validated (GenTx (DualBlock m a))))
-> (Ticked (LedgerState (DualBlock m a)),
    Validated (GenTx (DualBlock m a)))
-> ExceptT
     (DualGenTxErr m a)
     Identity
     (Ticked (LedgerState (DualBlock m a)),
      Validated (GenTx (DualBlock m a)))
forall a b. (a -> b) -> a -> b
$ (Ticked (LedgerState (DualBlock m a))
 -> Validated (GenTx (DualBlock m a))
 -> (Ticked (LedgerState (DualBlock m a)),
     Validated (GenTx (DualBlock m a))))
-> Validated (GenTx (DualBlock m a))
-> Ticked (LedgerState (DualBlock m a))
-> (Ticked (LedgerState (DualBlock m a)),
    Validated (GenTx (DualBlock m a)))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) Validated (GenTx (DualBlock m a))
vtx (Ticked (LedgerState (DualBlock m a))
 -> (Ticked (LedgerState (DualBlock m a)),
     Validated (GenTx (DualBlock m a))))
-> Ticked (LedgerState (DualBlock m a))
-> (Ticked (LedgerState (DualBlock m a)),
    Validated (GenTx (DualBlock m a)))
forall a b. (a -> b) -> a -> b
$ TickedDualLedgerState {
          tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateMain    = Ticked (LedgerState m)
main'
        , tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateAux     = Ticked (LedgerState a)
aux'
        , tickedDualLedgerStateAuxOrig :: LedgerState a
tickedDualLedgerStateAuxOrig = LedgerState a
tickedDualLedgerStateAuxOrig
        , tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateBridge  = Validated (GenTx (DualBlock m a))
-> BridgeLedger m a -> BridgeLedger m a
forall m a.
Bridge m a =>
Validated (GenTx (DualBlock m a))
-> BridgeLedger m a -> BridgeLedger m a
updateBridgeWithTx
                                           Validated (GenTx (DualBlock m a))
vtx
                                           BridgeLedger m a
tickedDualLedgerStateBridge
        }

  reapplyTx :: HasCallStack =>
LedgerConfig (DualBlock m a)
-> SlotNo
-> Validated (GenTx (DualBlock m a))
-> Ticked (LedgerState (DualBlock m a))
-> Except
     (ApplyTxErr (DualBlock m a)) (Ticked (LedgerState (DualBlock m a)))
reapplyTx DualLedgerConfig{LedgerConfig m
LedgerConfig a
dualLedgerConfigMain :: forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigAux :: forall m a. DualLedgerConfig m a -> LedgerConfig a
dualLedgerConfigMain :: LedgerConfig m
dualLedgerConfigAux :: LedgerConfig a
..}
            SlotNo
slot
            tx :: Validated (GenTx (DualBlock m a))
tx@ValidatedDualGenTx{Validated (GenTx m)
Validated (GenTx a)
BridgeTx m a
vDualGenTxMain :: forall m a.
Validated (GenTx (DualBlock m a)) -> Validated (GenTx m)
vDualGenTxAux :: forall m a.
Validated (GenTx (DualBlock m a)) -> Validated (GenTx a)
vDualGenTxBridge :: forall m a. Validated (GenTx (DualBlock m a)) -> BridgeTx m a
vDualGenTxMain :: Validated (GenTx m)
vDualGenTxAux :: Validated (GenTx a)
vDualGenTxBridge :: BridgeTx m a
..}
            TickedDualLedgerState{Ticked (LedgerState m)
Ticked (LedgerState a)
LedgerState a
BridgeLedger m a
tickedDualLedgerStateMain :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateAux :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState a)
tickedDualLedgerStateBridge :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> BridgeLedger m a
tickedDualLedgerStateAuxOrig :: forall m a. Ticked (LedgerState (DualBlock m a)) -> LedgerState a
tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateAuxOrig :: LedgerState a
..} = do
      (Ticked (LedgerState m)
main', Ticked (LedgerState a)
aux') <-
        (ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a)
-> (Except (ApplyTxErr m) (Ticked (LedgerState m)),
    Except (ApplyTxErr a) (Ticked (LedgerState a)))
-> Except
     (DualGenTxErr m a) (Ticked (LedgerState m), Ticked (LedgerState a))
forall e e' err a b.
(Show e, Show e', HasCallStack) =>
(e -> e' -> err) -> (Except e a, Except e' b) -> Except err (a, b)
agreeOnError ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a
forall m a. ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a
DualGenTxErr (
            LedgerConfig m
-> SlotNo
-> Validated (GenTx m)
-> Ticked (LedgerState m)
-> Except (ApplyTxErr m) (Ticked (LedgerState m))
forall blk.
(LedgerSupportsMempool blk, HasCallStack) =>
LedgerConfig blk
-> SlotNo
-> Validated (GenTx blk)
-> Ticked (LedgerState blk)
-> Except (ApplyTxErr blk) (Ticked (LedgerState blk))
reapplyTx
              LedgerConfig m
dualLedgerConfigMain
              SlotNo
slot
              Validated (GenTx m)
vDualGenTxMain
              Ticked (LedgerState m)
tickedDualLedgerStateMain
          , LedgerConfig a
-> SlotNo
-> Validated (GenTx a)
-> Ticked (LedgerState a)
-> Except (ApplyTxErr a) (Ticked (LedgerState a))
forall blk.
(LedgerSupportsMempool blk, HasCallStack) =>
LedgerConfig blk
-> SlotNo
-> Validated (GenTx blk)
-> Ticked (LedgerState blk)
-> Except (ApplyTxErr blk) (Ticked (LedgerState blk))
reapplyTx
              LedgerConfig a
dualLedgerConfigAux
              SlotNo
slot
              Validated (GenTx a)
vDualGenTxAux
              Ticked (LedgerState a)
tickedDualLedgerStateAux
          )
      Ticked (LedgerState (DualBlock m a))
-> ExceptT
     (DualGenTxErr m a) Identity (Ticked (LedgerState (DualBlock m a)))
forall a. a -> ExceptT (DualGenTxErr m a) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ticked (LedgerState (DualBlock m a))
 -> ExceptT
      (DualGenTxErr m a) Identity (Ticked (LedgerState (DualBlock m a))))
-> Ticked (LedgerState (DualBlock m a))
-> ExceptT
     (DualGenTxErr m a) Identity (Ticked (LedgerState (DualBlock m a)))
forall a b. (a -> b) -> a -> b
$ TickedDualLedgerState {
          tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateMain    = Ticked (LedgerState m)
main'
        , tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateAux     = Ticked (LedgerState a)
aux'
        , tickedDualLedgerStateAuxOrig :: LedgerState a
tickedDualLedgerStateAuxOrig = LedgerState a
tickedDualLedgerStateAuxOrig
        , tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateBridge  = Validated (GenTx (DualBlock m a))
-> BridgeLedger m a -> BridgeLedger m a
forall m a.
Bridge m a =>
Validated (GenTx (DualBlock m a))
-> BridgeLedger m a -> BridgeLedger m a
updateBridgeWithTx
                                           Validated (GenTx (DualBlock m a))
tx
                                           BridgeLedger m a
tickedDualLedgerStateBridge
        }

  txForgetValidated :: Validated (GenTx (DualBlock m a)) -> GenTx (DualBlock m a)
txForgetValidated Validated (GenTx (DualBlock m a))
vtx =
      DualGenTx {
          dualGenTxMain :: GenTx m
dualGenTxMain   = Validated (GenTx m) -> GenTx m
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated Validated (GenTx m)
vDualGenTxMain
        , dualGenTxAux :: GenTx a
dualGenTxAux    = Validated (GenTx a) -> GenTx a
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated Validated (GenTx a)
vDualGenTxAux
        , dualGenTxBridge :: BridgeTx m a
dualGenTxBridge = BridgeTx m a
vDualGenTxBridge
        }
    where
      ValidatedDualGenTx {
            Validated (GenTx m)
vDualGenTxMain :: forall m a.
Validated (GenTx (DualBlock m a)) -> Validated (GenTx m)
vDualGenTxMain :: Validated (GenTx m)
vDualGenTxMain
          , Validated (GenTx a)
vDualGenTxAux :: forall m a.
Validated (GenTx (DualBlock m a)) -> Validated (GenTx a)
vDualGenTxAux :: Validated (GenTx a)
vDualGenTxAux
          , BridgeTx m a
vDualGenTxBridge :: forall m a. Validated (GenTx (DualBlock m a)) -> BridgeTx m a
vDualGenTxBridge :: BridgeTx m a
vDualGenTxBridge
          } = Validated (GenTx (DualBlock m a))
vtx

instance Bridge m a => TxLimits (DualBlock m a) where
  type TxMeasure (DualBlock m a) = TxMeasure m

  txMeasure :: LedgerConfig (DualBlock m a)
-> TickedLedgerState (DualBlock m a)
-> GenTx (DualBlock m a)
-> Except (ApplyTxErr (DualBlock m a)) (TxMeasure (DualBlock m a))
txMeasure DualLedgerConfig{LedgerConfig m
LedgerConfig a
dualLedgerConfigMain :: forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigAux :: forall m a. DualLedgerConfig m a -> LedgerConfig a
dualLedgerConfigMain :: LedgerConfig m
dualLedgerConfigAux :: LedgerConfig a
..} TickedDualLedgerState{Ticked (LedgerState m)
Ticked (LedgerState a)
LedgerState a
BridgeLedger m a
tickedDualLedgerStateMain :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateAux :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState a)
tickedDualLedgerStateBridge :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> BridgeLedger m a
tickedDualLedgerStateAuxOrig :: forall m a. Ticked (LedgerState (DualBlock m a)) -> LedgerState a
tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateAuxOrig :: LedgerState a
..} DualGenTx{GenTx m
GenTx a
BridgeTx m a
dualGenTxMain :: forall m a. GenTx (DualBlock m a) -> GenTx m
dualGenTxAux :: forall m a. GenTx (DualBlock m a) -> GenTx a
dualGenTxBridge :: forall m a. GenTx (DualBlock m a) -> BridgeTx m a
dualGenTxMain :: GenTx m
dualGenTxAux :: GenTx a
dualGenTxBridge :: BridgeTx m a
..} = do
      (Either (ApplyTxErr m) (TxMeasure m)
 -> Either (DualGenTxErr m a) (TxMeasure m))
-> Except (ApplyTxErr m) (TxMeasure m)
-> Except (DualGenTxErr m a) (TxMeasure m)
forall e a e' b.
(Either e a -> Either e' b) -> Except e a -> Except e' b
mapExcept (ApplyTxErr m -> DualGenTxErr m a
forall {m} {a}. ApplyTxErr m -> DualGenTxErr m a
inj (ApplyTxErr m -> DualGenTxErr m a)
-> (TxMeasure m -> TxMeasure m)
-> Either (ApplyTxErr m) (TxMeasure m)
-> Either (DualGenTxErr m a) (TxMeasure m)
forall b c b' c'.
(b -> c) -> (b' -> c') -> Either b b' -> Either c c'
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ TxMeasure m -> TxMeasure m
forall a. a -> a
id)
    (Except (ApplyTxErr m) (TxMeasure m)
 -> Except (ApplyTxErr (DualBlock m a)) (TxMeasure (DualBlock m a)))
-> Except (ApplyTxErr m) (TxMeasure m)
-> Except (ApplyTxErr (DualBlock m a)) (TxMeasure (DualBlock m a))
forall a b. (a -> b) -> a -> b
$ LedgerConfig m
-> Ticked (LedgerState m)
-> GenTx m
-> Except (ApplyTxErr m) (TxMeasure m)
forall blk.
TxLimits blk =>
LedgerConfig blk
-> TickedLedgerState blk
-> GenTx blk
-> Except (ApplyTxErr blk) (TxMeasure blk)
txMeasure LedgerConfig m
dualLedgerConfigMain Ticked (LedgerState m)
tickedDualLedgerStateMain GenTx m
dualGenTxMain
    where
      inj :: ApplyTxErr m -> DualGenTxErr m a
inj ApplyTxErr m
m = ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a
forall m a. ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a
DualGenTxErr ApplyTxErr m
m (String -> ApplyTxErr a
forall a. HasCallStack => String -> a
error String
"ByronSpec has no tx-too-big error")

  blockCapacityTxMeasure :: LedgerConfig (DualBlock m a)
-> TickedLedgerState (DualBlock m a) -> TxMeasure (DualBlock m a)
blockCapacityTxMeasure DualLedgerConfig{LedgerConfig m
LedgerConfig a
dualLedgerConfigMain :: forall m a. DualLedgerConfig m a -> LedgerConfig m
dualLedgerConfigAux :: forall m a. DualLedgerConfig m a -> LedgerConfig a
dualLedgerConfigMain :: LedgerConfig m
dualLedgerConfigAux :: LedgerConfig a
..} TickedDualLedgerState{Ticked (LedgerState m)
Ticked (LedgerState a)
LedgerState a
BridgeLedger m a
tickedDualLedgerStateMain :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState m)
tickedDualLedgerStateAux :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> Ticked (LedgerState a)
tickedDualLedgerStateBridge :: forall m a.
Ticked (LedgerState (DualBlock m a)) -> BridgeLedger m a
tickedDualLedgerStateAuxOrig :: forall m a. Ticked (LedgerState (DualBlock m a)) -> LedgerState a
tickedDualLedgerStateMain :: Ticked (LedgerState m)
tickedDualLedgerStateAux :: Ticked (LedgerState a)
tickedDualLedgerStateBridge :: BridgeLedger m a
tickedDualLedgerStateAuxOrig :: LedgerState a
..} =
      LedgerConfig m -> Ticked (LedgerState m) -> TxMeasure m
forall blk.
TxLimits blk =>
LedgerConfig blk -> TickedLedgerState blk -> TxMeasure blk
blockCapacityTxMeasure LedgerConfig m
dualLedgerConfigMain Ticked (LedgerState m)
tickedDualLedgerStateMain

-- We don't need a pair of IDs, as long as we can unique ID the transaction
newtype instance TxId (GenTx (DualBlock m a)) = DualGenTxId {
      forall m a. TxId (GenTx (DualBlock m a)) -> GenTxId m
dualGenTxIdMain :: GenTxId m
    }
  deriving Context -> TxId (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
Proxy (TxId (GenTx (DualBlock m a))) -> String
(Context -> TxId (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo))
-> (Context
    -> TxId (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo))
-> (Proxy (TxId (GenTx (DualBlock m a))) -> String)
-> NoThunks (TxId (GenTx (DualBlock m a)))
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall m a.
Context -> TxId (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
forall m a. Proxy (TxId (GenTx (DualBlock m a))) -> String
$cnoThunks :: forall m a.
Context -> TxId (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxId (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall m a.
Context -> TxId (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxId (GenTx (DualBlock m a)) -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall m a. Proxy (TxId (GenTx (DualBlock m a))) -> String
showTypeOf :: Proxy (TxId (GenTx (DualBlock m a))) -> String
NoThunks via AllowThunk (TxId (GenTx (DualBlock m a)))

instance (Typeable m, Typeable a)
    => ShowProxy (TxId (GenTx (DualBlock m a))) where

instance Bridge m a => HasTxId (GenTx (DualBlock m a)) where
  txId :: GenTx (DualBlock m a) -> TxId (GenTx (DualBlock m a))
txId = TxId (GenTx m) -> TxId (GenTx (DualBlock m a))
forall m a. GenTxId m -> TxId (GenTx (DualBlock m a))
DualGenTxId (TxId (GenTx m) -> TxId (GenTx (DualBlock m a)))
-> (GenTx (DualBlock m a) -> TxId (GenTx m))
-> GenTx (DualBlock m a)
-> TxId (GenTx (DualBlock m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx m -> TxId (GenTx m)
forall tx. HasTxId tx => tx -> TxId tx
txId (GenTx m -> TxId (GenTx m))
-> (GenTx (DualBlock m a) -> GenTx m)
-> GenTx (DualBlock m a)
-> TxId (GenTx m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (DualBlock m a) -> GenTx m
forall m a. GenTx (DualBlock m a) -> GenTx m
dualGenTxMain

deriving instance Bridge m a => Show (GenTx (DualBlock m a))
deriving instance Bridge m a => Show (Validated (GenTx (DualBlock m a)))
deriving instance Bridge m a => Show (DualGenTxErr m a)

deriving instance Show (GenTxId m) => Show (TxId (GenTx (DualBlock m a)))
deriving instance Eq   (GenTxId m) => Eq   (TxId (GenTx (DualBlock m a)))
deriving instance Ord  (GenTxId m) => Ord  (TxId (GenTx (DualBlock m a)))

{-------------------------------------------------------------------------------
  Nested contents

  Since we only have a single header, we just delegate to the main block.
-------------------------------------------------------------------------------}

newtype instance NestedCtxt_ (DualBlock m a) f x where
    CtxtDual :: NestedCtxt_ m f x -> NestedCtxt_ (DualBlock m a) f x

deriving instance Show (NestedCtxt_ m f x)
               => Show (NestedCtxt_ (DualBlock m a) f x)

instance SameDepIndex (NestedCtxt_ m f)
      => SameDepIndex (NestedCtxt_ (DualBlock m a) f) where
  sameDepIndex :: forall a b.
NestedCtxt_ (DualBlock m a) f a
-> NestedCtxt_ (DualBlock m a) f b -> Maybe (a :~: b)
sameDepIndex (CtxtDual NestedCtxt_ m f a
ctxt) (CtxtDual NestedCtxt_ m f b
ctxt') =
     NestedCtxt_ m f a -> NestedCtxt_ m f b -> Maybe (a :~: b)
forall a b.
NestedCtxt_ m f a -> NestedCtxt_ m f b -> Maybe (a :~: b)
forall (f :: * -> *) a b.
SameDepIndex f =>
f a -> f b -> Maybe (a :~: b)
sameDepIndex NestedCtxt_ m f a
ctxt NestedCtxt_ m f b
ctxt'

ctxtDualMain :: NestedCtxt_ (DualBlock m a) f x -> NestedCtxt_ m f x
ctxtDualMain :: forall m a (f :: * -> *) x.
NestedCtxt_ (DualBlock m a) f x -> NestedCtxt_ m f x
ctxtDualMain (CtxtDual NestedCtxt_ m f x
ctxtMain) = NestedCtxt_ m f x
ctxtMain

instance HasNestedContent Header m
      => HasNestedContent Header (DualBlock m a) where
  unnest :: Header (DualBlock m a)
-> DepPair (NestedCtxt Header (DualBlock m a))
unnest = (forall a.
 NestedCtxt Header m a -> NestedCtxt Header (DualBlock m a) a)
-> GenDepPair I (NestedCtxt Header m)
-> DepPair (NestedCtxt Header (DualBlock m a))
forall (f :: * -> *) (f' :: * -> *) (g :: * -> *).
(forall a. f a -> f' a) -> GenDepPair g f -> GenDepPair g f'
depPairFirst ((NestedCtxt_ m Header a -> NestedCtxt_ (DualBlock m a) Header a)
-> NestedCtxt Header m a -> NestedCtxt Header (DualBlock m a) a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ m Header a -> NestedCtxt_ (DualBlock m a) Header a
forall m (f :: * -> *) x a.
NestedCtxt_ m f x -> NestedCtxt_ (DualBlock m a) f x
CtxtDual) (GenDepPair I (NestedCtxt Header m)
 -> DepPair (NestedCtxt Header (DualBlock m a)))
-> (Header (DualBlock m a) -> GenDepPair I (NestedCtxt Header m))
-> Header (DualBlock m a)
-> DepPair (NestedCtxt Header (DualBlock m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header m -> GenDepPair I (NestedCtxt Header m)
forall (f :: * -> *) blk.
HasNestedContent f blk =>
f blk -> DepPair (NestedCtxt f blk)
unnest (Header m -> GenDepPair I (NestedCtxt Header m))
-> (Header (DualBlock m a) -> Header m)
-> Header (DualBlock m a)
-> GenDepPair I (NestedCtxt Header m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (DualBlock m a) -> Header m
forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain
  nest :: DepPair (NestedCtxt Header (DualBlock m a))
-> Header (DualBlock m a)
nest   = Header m -> Header (DualBlock m a)
forall m a. Header m -> Header (DualBlock m a)
DualHeader (Header m -> Header (DualBlock m a))
-> (DepPair (NestedCtxt Header (DualBlock m a)) -> Header m)
-> DepPair (NestedCtxt Header (DualBlock m a))
-> Header (DualBlock m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenDepPair I (NestedCtxt Header m) -> Header m
forall (f :: * -> *) blk.
HasNestedContent f blk =>
DepPair (NestedCtxt f blk) -> f blk
nest (GenDepPair I (NestedCtxt Header m) -> Header m)
-> (DepPair (NestedCtxt Header (DualBlock m a))
    -> GenDepPair I (NestedCtxt Header m))
-> DepPair (NestedCtxt Header (DualBlock m a))
-> Header m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a.
 NestedCtxt Header (DualBlock m a) a -> NestedCtxt Header m a)
-> DepPair (NestedCtxt Header (DualBlock m a))
-> GenDepPair I (NestedCtxt Header m)
forall (f :: * -> *) (f' :: * -> *) (g :: * -> *).
(forall a. f a -> f' a) -> GenDepPair g f -> GenDepPair g f'
depPairFirst ((NestedCtxt_ (DualBlock m a) Header a -> NestedCtxt_ m Header a)
-> NestedCtxt Header (DualBlock m a) a -> NestedCtxt Header m a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ (DualBlock m a) Header a -> NestedCtxt_ m Header a
forall m a (f :: * -> *) x.
NestedCtxt_ (DualBlock m a) f x -> NestedCtxt_ m f x
ctxtDualMain)

instance ReconstructNestedCtxt Header m
      => ReconstructNestedCtxt Header (DualBlock m a) where
  reconstructPrefixLen :: forall (proxy :: * -> *).
proxy (Header (DualBlock m a)) -> PrefixLen
reconstructPrefixLen proxy (Header (DualBlock m a))
_ =
      -- Account for the outer @encodeListLen 3@
      Word8
1 Word8 -> PrefixLen -> PrefixLen
`addPrefixLen` Proxy (Header m) -> PrefixLen
forall (proxy :: * -> *). proxy (Header m) -> PrefixLen
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk) -> PrefixLen
reconstructPrefixLen (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Header m))
  reconstructNestedCtxt :: forall (proxy :: * -> *).
proxy (Header (DualBlock m a))
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) (DualBlock m a)
reconstructNestedCtxt proxy (Header (DualBlock m a))
_ ShortByteString
prefix SizeInBytes
size =
      case Proxy (Header m)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) m
forall (proxy :: * -> *).
proxy (Header m)
-> ShortByteString
-> SizeInBytes
-> SomeSecond (NestedCtxt Header) m
forall (f :: * -> *) blk (proxy :: * -> *).
ReconstructNestedCtxt f blk =>
proxy (f blk)
-> ShortByteString -> SizeInBytes -> SomeSecond (NestedCtxt f) blk
reconstructNestedCtxt (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Header m)) ShortByteString
prefixMain SizeInBytes
size of
        SomeSecond NestedCtxt Header m b
ctxt -> NestedCtxt Header (DualBlock m a) b
-> SomeSecond (NestedCtxt Header) (DualBlock m a)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond ((NestedCtxt_ m Header b -> NestedCtxt_ (DualBlock m a) Header b)
-> NestedCtxt Header m b -> NestedCtxt Header (DualBlock m a) b
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ m Header b -> NestedCtxt_ (DualBlock m a) Header b
forall m (f :: * -> *) x a.
NestedCtxt_ m f x -> NestedCtxt_ (DualBlock m a) f x
CtxtDual NestedCtxt Header m b
ctxt)
    where
      prefixMain :: ShortByteString
prefixMain = [Word8] -> ShortByteString
Short.pack ([Word8] -> ShortByteString)
-> (ShortByteString -> [Word8])
-> ShortByteString
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop Int
1 ([Word8] -> [Word8])
-> (ShortByteString -> [Word8]) -> ShortByteString -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> [Word8]
Short.unpack (ShortByteString -> ShortByteString)
-> ShortByteString -> ShortByteString
forall a b. (a -> b) -> a -> b
$ ShortByteString
prefix

instance EncodeDiskDepIx (NestedCtxt Header) m
      => EncodeDiskDepIx (NestedCtxt Header) (DualBlock m a) where
  encodeDiskDepIx :: CodecConfig (DualBlock m a)
-> SomeSecond (NestedCtxt Header) (DualBlock m a) -> Encoding
encodeDiskDepIx CodecConfig (DualBlock m a)
ccfg (SomeSecond NestedCtxt Header (DualBlock m a) b
ctxt) =
      CodecConfig m -> SomeSecond (NestedCtxt Header) m -> Encoding
forall (f :: * -> * -> *) blk.
EncodeDiskDepIx f blk =>
CodecConfig blk -> SomeSecond f blk -> Encoding
encodeDiskDepIx
        (CodecConfig (DualBlock m a) -> CodecConfig m
forall m a. CodecConfig (DualBlock m a) -> CodecConfig m
dualCodecConfigMain CodecConfig (DualBlock m a)
ccfg)
        (NestedCtxt Header m b -> SomeSecond (NestedCtxt Header) m
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond ((NestedCtxt_ (DualBlock m a) Header b -> NestedCtxt_ m Header b)
-> NestedCtxt Header (DualBlock m a) b -> NestedCtxt Header m b
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ (DualBlock m a) Header b -> NestedCtxt_ m Header b
forall m a (f :: * -> *) x.
NestedCtxt_ (DualBlock m a) f x -> NestedCtxt_ m f x
ctxtDualMain NestedCtxt Header (DualBlock m a) b
ctxt))

instance EncodeDiskDep (NestedCtxt Header) m
      => EncodeDiskDep (NestedCtxt Header) (DualBlock m a) where
  encodeDiskDep :: forall a.
CodecConfig (DualBlock m a)
-> NestedCtxt Header (DualBlock m a) a -> a -> Encoding
encodeDiskDep CodecConfig (DualBlock m a)
ccfg NestedCtxt Header (DualBlock m a) a
ctxt =
      CodecConfig m -> NestedCtxt Header m a -> a -> Encoding
forall a. CodecConfig m -> NestedCtxt Header m a -> a -> Encoding
forall (f :: * -> * -> *) blk a.
EncodeDiskDep f blk =>
CodecConfig blk -> f blk a -> a -> Encoding
encodeDiskDep
        (CodecConfig (DualBlock m a) -> CodecConfig m
forall m a. CodecConfig (DualBlock m a) -> CodecConfig m
dualCodecConfigMain CodecConfig (DualBlock m a)
ccfg)
        ((NestedCtxt_ (DualBlock m a) Header a -> NestedCtxt_ m Header a)
-> NestedCtxt Header (DualBlock m a) a -> NestedCtxt Header m a
forall blk (f :: * -> *) a blk' (f' :: * -> *) a'.
(NestedCtxt_ blk f a -> NestedCtxt_ blk' f' a')
-> NestedCtxt f blk a -> NestedCtxt f' blk' a'
mapNestedCtxt NestedCtxt_ (DualBlock m a) Header a -> NestedCtxt_ m Header a
forall m a (f :: * -> *) x.
NestedCtxt_ (DualBlock m a) f x -> NestedCtxt_ m f x
ctxtDualMain NestedCtxt Header (DualBlock m a) a
ctxt)

{-------------------------------------------------------------------------------
  HasBinaryBlockInfo
-------------------------------------------------------------------------------}

-- | The binary info just refers to the main block
--
-- This is sufficient, because we never need just the header of the auxiliary.
instance HasBinaryBlockInfo m => HasBinaryBlockInfo (DualBlock m a) where
  getBinaryBlockInfo :: DualBlock m a -> BinaryBlockInfo
getBinaryBlockInfo DualBlock{m
Maybe a
BridgeBlock m a
dualBlockMain :: forall m a. DualBlock m a -> m
dualBlockAux :: forall m a. DualBlock m a -> Maybe a
dualBlockBridge :: forall m a. DualBlock m a -> BridgeBlock m a
dualBlockMain :: m
dualBlockAux :: Maybe a
dualBlockBridge :: BridgeBlock m a
..} =
      BinaryBlockInfo {
          headerSize :: Word16
headerSize   = BinaryBlockInfo -> Word16
headerSize   BinaryBlockInfo
mainBinaryBlockInfo
        , headerOffset :: Word16
headerOffset = BinaryBlockInfo -> Word16
headerOffset BinaryBlockInfo
mainBinaryBlockInfo Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1
        }
    where
      mainBinaryBlockInfo :: BinaryBlockInfo
      mainBinaryBlockInfo :: BinaryBlockInfo
mainBinaryBlockInfo = m -> BinaryBlockInfo
forall blk. HasBinaryBlockInfo blk => blk -> BinaryBlockInfo
getBinaryBlockInfo m
dualBlockMain

{-------------------------------------------------------------------------------
  Inspection
-------------------------------------------------------------------------------}

-- | 'InspectLedger' just refers to the main block
--
-- 'InspectLedger' is intended to check the ledger state against the node's
-- configuration, and hence takes a full 'TopLevelConfig'. However, we cannot
-- construct that for the auxiliary block, since we have no protocol config
-- for it. We therefore just use the main block.
instance InspectLedger m => InspectLedger (DualBlock m a) where
  type LedgerWarning (DualBlock m a) = LedgerWarning m
  type LedgerUpdate  (DualBlock m a) = LedgerUpdate  m

  inspectLedger :: TopLevelConfig (DualBlock m a)
-> LedgerState (DualBlock m a)
-> LedgerState (DualBlock m a)
-> [LedgerEvent (DualBlock m a)]
inspectLedger TopLevelConfig (DualBlock m a)
cfg LedgerState (DualBlock m a)
before LedgerState (DualBlock m a)
after = (LedgerEvent m -> LedgerEvent (DualBlock m a))
-> [LedgerEvent m] -> [LedgerEvent (DualBlock m a)]
forall a b. (a -> b) -> [a] -> [b]
map LedgerEvent m -> LedgerEvent (DualBlock m a)
forall blk blk'.
(LedgerWarning blk ~ LedgerWarning blk',
 LedgerUpdate blk ~ LedgerUpdate blk') =>
LedgerEvent blk -> LedgerEvent blk'
castLedgerEvent ([LedgerEvent m] -> [LedgerEvent (DualBlock m a)])
-> [LedgerEvent m] -> [LedgerEvent (DualBlock m a)]
forall a b. (a -> b) -> a -> b
$
      TopLevelConfig m
-> LedgerState m -> LedgerState m -> [LedgerEvent m]
forall blk.
InspectLedger blk =>
TopLevelConfig blk
-> LedgerState blk -> LedgerState blk -> [LedgerEvent blk]
inspectLedger
        (TopLevelConfig (DualBlock m a) -> TopLevelConfig m
forall m a. TopLevelConfig (DualBlock m a) -> TopLevelConfig m
dualTopLevelConfigMain TopLevelConfig (DualBlock m a)
cfg)
        (LedgerState (DualBlock m a) -> LedgerState m
forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain    LedgerState (DualBlock m a)
before)
        (LedgerState (DualBlock m a) -> LedgerState m
forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain    LedgerState (DualBlock m a)
after)


{-------------------------------------------------------------------------------
  PeerSelection
-------------------------------------------------------------------------------}

instance LedgerSupportsPeerSelection m
      => LedgerSupportsPeerSelection (DualBlock m a) where
  getPeers :: LedgerState (DualBlock m a)
-> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers = LedgerState m -> [(PoolStake, NonEmpty StakePoolRelay)]
forall blk.
LedgerSupportsPeerSelection blk =>
LedgerState blk -> [(PoolStake, NonEmpty StakePoolRelay)]
getPeers (LedgerState m -> [(PoolStake, NonEmpty StakePoolRelay)])
-> (LedgerState (DualBlock m a) -> LedgerState m)
-> LedgerState (DualBlock m a)
-> [(PoolStake, NonEmpty StakePoolRelay)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (DualBlock m a) -> LedgerState m
forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateMain

{-------------------------------------------------------------------------------
  Forging
-------------------------------------------------------------------------------}

type instance CannotForge           (DualBlock m a) = CannotForge           m
type instance ForgeStateInfo        (DualBlock m a) = ForgeStateInfo        m
type instance ForgeStateUpdateError (DualBlock m a) = ForgeStateUpdateError m

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

-- | Lift 'applyLedgerBlock' to @Maybe blk@
--
-- Returns state unchanged on 'Nothing'
applyMaybeBlock :: UpdateLedger blk
                => ComputeLedgerEvents
                -> LedgerConfig blk
                -> Maybe blk
                -> TickedLedgerState blk
                -> LedgerState blk
                -> Except (LedgerError blk) (LedgerState blk)
applyMaybeBlock :: forall blk.
UpdateLedger blk =>
ComputeLedgerEvents
-> LedgerConfig blk
-> Maybe blk
-> TickedLedgerState blk
-> LedgerState blk
-> Except (LedgerError blk) (LedgerState blk)
applyMaybeBlock ComputeLedgerEvents
_    LedgerConfig blk
_   Maybe blk
Nothing      TickedLedgerState blk
_   LedgerState blk
st = LedgerState blk
-> ExceptT (LedgerErr (LedgerState blk)) Identity (LedgerState blk)
forall a. a -> ExceptT (LedgerErr (LedgerState blk)) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return LedgerState blk
st
applyMaybeBlock ComputeLedgerEvents
opts LedgerConfig blk
cfg (Just blk
block) TickedLedgerState blk
tst LedgerState blk
_  = ComputeLedgerEvents
-> LedgerConfig blk
-> blk
-> TickedLedgerState blk
-> ExceptT (LedgerErr (LedgerState blk)) Identity (LedgerState blk)
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents
-> LedgerCfg l -> blk -> Ticked l -> Except (LedgerErr l) l
applyLedgerBlock ComputeLedgerEvents
opts LedgerConfig blk
cfg blk
block TickedLedgerState blk
tst

-- | Lift 'reapplyLedgerBlock' to @Maybe blk@
--
-- See also 'applyMaybeBlock'
reapplyMaybeBlock :: UpdateLedger blk
                  => ComputeLedgerEvents
                  -> LedgerConfig blk
                  -> Maybe blk
                  -> TickedLedgerState blk
                  -> LedgerState blk
                  -> LedgerState blk
reapplyMaybeBlock :: forall blk.
UpdateLedger blk =>
ComputeLedgerEvents
-> LedgerConfig blk
-> Maybe blk
-> TickedLedgerState blk
-> LedgerState blk
-> LedgerState blk
reapplyMaybeBlock ComputeLedgerEvents
_   LedgerConfig blk
_   Maybe blk
Nothing      TickedLedgerState blk
_   LedgerState blk
st = LedgerState blk
st
reapplyMaybeBlock ComputeLedgerEvents
evs LedgerConfig blk
cfg (Just blk
block) TickedLedgerState blk
tst LedgerState blk
_  = ComputeLedgerEvents
-> LedgerConfig blk
-> blk
-> TickedLedgerState blk
-> LedgerState blk
forall l blk.
(ApplyBlock l blk, HasCallStack) =>
ComputeLedgerEvents -> LedgerCfg l -> blk -> Ticked l -> l
reapplyLedgerBlock ComputeLedgerEvents
evs LedgerConfig blk
cfg blk
block TickedLedgerState blk
tst

-- | Used when the concrete and abstract implementation should agree on errors
--
-- The abstract-versus-concrete tests from the ledger folks tests precisely
-- this, so if this fails, it indicates a bug somewhere and we error out.
agreeOnError :: (Show e, Show e', HasCallStack)
             => (e -> e' -> err)
             -> (Except e a, Except e' b)
             -> Except err (a, b)
agreeOnError :: forall e e' err a b.
(Show e, Show e', HasCallStack) =>
(e -> e' -> err) -> (Except e a, Except e' b) -> Except err (a, b)
agreeOnError e -> e' -> err
f (Except e a
ma, Except e' b
mb) =
    case (Except e a -> Either e a
forall e a. Except e a -> Either e a
runExcept Except e a
ma, Except e' b -> Either e' b
forall e a. Except e a -> Either e a
runExcept Except e' b
mb) of
      (Left e
e, Left e'
e') ->
        err -> Except err (a, b)
forall a. err -> ExceptT err Identity a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (err -> Except err (a, b)) -> err -> Except err (a, b)
forall a b. (a -> b) -> a -> b
$ e -> e' -> err
f e
e e'
e'
      (Left e
e, Right b
_) ->
        String -> Except err (a, b)
forall a. HasCallStack => String -> a
error (String -> Except err (a, b)) -> String -> Except err (a, b)
forall a b. (a -> b) -> a -> b
$ String
"agreeOnError: unexpected error " String -> ShowS
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
e
      (Right a
_, Left e'
e') ->
        String -> Except err (a, b)
forall a. HasCallStack => String -> a
error (String -> Except err (a, b)) -> String -> Except err (a, b)
forall a b. (a -> b) -> a -> b
$ String
"agreeOnError: unexpected error " String -> ShowS
forall a. [a] -> [a] -> [a]
++ e' -> String
forall a. Show a => a -> String
show e'
e'
      (Right a
a, Right b
b) ->
        (a, b) -> Except err (a, b)
forall a. a -> ExceptT err Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, b
b)

{-------------------------------------------------------------------------------
  Serialisation

  For now we just require 'Serialise' for the auxiliary block.
-------------------------------------------------------------------------------}

encodeDualLedgerConfig :: (LedgerCfg (LedgerState m) -> Encoding)
                       -> (LedgerCfg (LedgerState a) -> Encoding)
                       -> DualLedgerConfig m a
                       -> Encoding
encodeDualLedgerConfig :: forall m a.
(LedgerCfg (LedgerState m) -> Encoding)
-> (LedgerCfg (LedgerState a) -> Encoding)
-> DualLedgerConfig m a
-> Encoding
encodeDualLedgerConfig LedgerCfg (LedgerState m) -> Encoding
encodeM LedgerCfg (LedgerState a) -> Encoding
encodeA (DualLedgerConfig LedgerCfg (LedgerState m)
m LedgerCfg (LedgerState a)
a) = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
encodeListLen Word
2
    , LedgerCfg (LedgerState m) -> Encoding
encodeM LedgerCfg (LedgerState m)
m
    , LedgerCfg (LedgerState a) -> Encoding
encodeA LedgerCfg (LedgerState a)
a
    ]

decodeDualLedgerConfig :: Decoder s (LedgerCfg (LedgerState m))
                       -> Decoder s (LedgerCfg (LedgerState a))
                       -> Decoder s (DualLedgerConfig m a)
decodeDualLedgerConfig :: forall s m a.
Decoder s (LedgerCfg (LedgerState m))
-> Decoder s (LedgerCfg (LedgerState a))
-> Decoder s (DualLedgerConfig m a)
decodeDualLedgerConfig Decoder s (LedgerCfg (LedgerState m))
decodeM Decoder s (LedgerCfg (LedgerState a))
decodeA = do
  Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"DualLedgerConfig" Int
2
  LedgerCfg (LedgerState m)
-> LedgerCfg (LedgerState a) -> DualLedgerConfig m a
forall m a.
LedgerConfig m -> LedgerConfig a -> DualLedgerConfig m a
DualLedgerConfig
    (LedgerCfg (LedgerState m)
 -> LedgerCfg (LedgerState a) -> DualLedgerConfig m a)
-> Decoder s (LedgerCfg (LedgerState m))
-> Decoder s (LedgerCfg (LedgerState a) -> DualLedgerConfig m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (LedgerCfg (LedgerState m))
decodeM
    Decoder s (LedgerCfg (LedgerState a) -> DualLedgerConfig m a)
-> Decoder s (LedgerCfg (LedgerState a))
-> Decoder s (DualLedgerConfig m a)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (LedgerCfg (LedgerState a))
decodeA

encodeDualBlock :: (Bridge m a, Serialise a)
                => (m -> Encoding)
                -> DualBlock m a -> Encoding
encodeDualBlock :: forall m a.
(Bridge m a, Serialise a) =>
(m -> Encoding) -> DualBlock m a -> Encoding
encodeDualBlock m -> Encoding
encodeMain DualBlock{m
Maybe a
BridgeBlock m a
dualBlockMain :: forall m a. DualBlock m a -> m
dualBlockAux :: forall m a. DualBlock m a -> Maybe a
dualBlockBridge :: forall m a. DualBlock m a -> BridgeBlock m a
dualBlockMain :: m
dualBlockAux :: Maybe a
dualBlockBridge :: BridgeBlock m a
..} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
        Word -> Encoding
encodeListLen Word
3
      , m -> Encoding
encodeMain m
dualBlockMain
      , Maybe a -> Encoding
forall a. Serialise a => a -> Encoding
encode Maybe a
dualBlockAux
      , BridgeBlock m a -> Encoding
forall a. Serialise a => a -> Encoding
encode BridgeBlock m a
dualBlockBridge
      ]

decodeDualBlock :: (Bridge m a, Serialise a)
                => Decoder s (Lazy.ByteString -> m)
                -> Decoder s (Lazy.ByteString -> DualBlock m a)
decodeDualBlock :: forall m a s.
(Bridge m a, Serialise a) =>
Decoder s (ByteString -> m)
-> Decoder s (ByteString -> DualBlock m a)
decodeDualBlock Decoder s (ByteString -> m)
decodeMain = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"DualBlock" Int
3
    (ByteString -> m)
-> Maybe a -> BridgeBlock m a -> ByteString -> DualBlock m a
forall m a.
(ByteString -> m)
-> Maybe a -> BridgeBlock m a -> ByteString -> DualBlock m a
dualBlock
      ((ByteString -> m)
 -> Maybe a -> BridgeBlock m a -> ByteString -> DualBlock m a)
-> Decoder s (ByteString -> m)
-> Decoder
     s (Maybe a -> BridgeBlock m a -> ByteString -> DualBlock m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ByteString -> m)
decodeMain
      Decoder
  s (Maybe a -> BridgeBlock m a -> ByteString -> DualBlock m a)
-> Decoder s (Maybe a)
-> Decoder s (BridgeBlock m a -> ByteString -> DualBlock m a)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Maybe a)
forall s. Decoder s (Maybe a)
forall a s. Serialise a => Decoder s a
decode
      Decoder s (BridgeBlock m a -> ByteString -> DualBlock m a)
-> Decoder s (BridgeBlock m a)
-> Decoder s (ByteString -> DualBlock m a)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (BridgeBlock m a)
forall s. Decoder s (BridgeBlock m a)
forall a s. Serialise a => Decoder s a
decode
  where
    dualBlock :: (Lazy.ByteString -> m)
              -> Maybe a
              -> BridgeBlock m a
              -> (Lazy.ByteString -> DualBlock m a)
    dualBlock :: forall m a.
(ByteString -> m)
-> Maybe a -> BridgeBlock m a -> ByteString -> DualBlock m a
dualBlock ByteString -> m
conc Maybe a
abst BridgeBlock m a
bridge ByteString
bs = m -> Maybe a -> BridgeBlock m a -> DualBlock m a
forall m a. m -> Maybe a -> BridgeBlock m a -> DualBlock m a
DualBlock (ByteString -> m
conc ByteString
bs) Maybe a
abst BridgeBlock m a
bridge

encodeDualHeader :: (Header m -> Encoding)
                 -> Header (DualBlock m a) -> Encoding
encodeDualHeader :: forall m a.
(Header m -> Encoding) -> Header (DualBlock m a) -> Encoding
encodeDualHeader Header m -> Encoding
encodeMain DualHeader{Header m
dualHeaderMain :: forall m a. Header (DualBlock m a) -> Header m
dualHeaderMain :: Header m
..} = Header m -> Encoding
encodeMain Header m
dualHeaderMain

decodeDualHeader :: Decoder s (Lazy.ByteString -> Header m)
                 -> Decoder s (Lazy.ByteString -> Header (DualBlock m a))
decodeDualHeader :: forall s m a.
Decoder s (ByteString -> Header m)
-> Decoder s (ByteString -> Header (DualBlock m a))
decodeDualHeader Decoder s (ByteString -> Header m)
decodeMain =
    (ByteString -> Header m) -> ByteString -> Header (DualBlock m a)
forall m a.
(ByteString -> Header m) -> ByteString -> Header (DualBlock m a)
dualHeader ((ByteString -> Header m) -> ByteString -> Header (DualBlock m a))
-> Decoder s (ByteString -> Header m)
-> Decoder s (ByteString -> Header (DualBlock m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ByteString -> Header m)
decodeMain
  where
    dualHeader :: (Lazy.ByteString -> Header m)
               -> (Lazy.ByteString -> Header (DualBlock m a))
    dualHeader :: forall m a.
(ByteString -> Header m) -> ByteString -> Header (DualBlock m a)
dualHeader ByteString -> Header m
conc ByteString
bs = Header m -> Header (DualBlock m a)
forall m a. Header m -> Header (DualBlock m a)
DualHeader (ByteString -> Header m
conc ByteString
bs)

encodeDualGenTx :: (Bridge m a, Serialise (GenTx a))
                => (GenTx m -> Encoding)
                -> GenTx (DualBlock m a) -> Encoding
encodeDualGenTx :: forall m a.
(Bridge m a, Serialise (GenTx a)) =>
(GenTx m -> Encoding) -> GenTx (DualBlock m a) -> Encoding
encodeDualGenTx GenTx m -> Encoding
encodeMain DualGenTx{GenTx m
GenTx a
BridgeTx m a
dualGenTxMain :: forall m a. GenTx (DualBlock m a) -> GenTx m
dualGenTxAux :: forall m a. GenTx (DualBlock m a) -> GenTx a
dualGenTxBridge :: forall m a. GenTx (DualBlock m a) -> BridgeTx m a
dualGenTxMain :: GenTx m
dualGenTxAux :: GenTx a
dualGenTxBridge :: BridgeTx m a
..} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
encodeListLen Word
3
    , GenTx m -> Encoding
encodeMain GenTx m
dualGenTxMain
    , GenTx a -> Encoding
forall a. Serialise a => a -> Encoding
encode     GenTx a
dualGenTxAux
    , BridgeTx m a -> Encoding
forall a. Serialise a => a -> Encoding
encode     BridgeTx m a
dualGenTxBridge
    ]

decodeDualGenTx :: (Bridge m a, Serialise (GenTx a))
                => Decoder s (GenTx m)
                -> Decoder s (GenTx (DualBlock m a))
decodeDualGenTx :: forall m a s.
(Bridge m a, Serialise (GenTx a)) =>
Decoder s (GenTx m) -> Decoder s (GenTx (DualBlock m a))
decodeDualGenTx Decoder s (GenTx m)
decodeMain = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"DualGenTx" Int
3
    GenTx m -> GenTx a -> BridgeTx m a -> GenTx (DualBlock m a)
forall m a.
GenTx m -> GenTx a -> BridgeTx m a -> GenTx (DualBlock m a)
DualGenTx
      (GenTx m -> GenTx a -> BridgeTx m a -> GenTx (DualBlock m a))
-> Decoder s (GenTx m)
-> Decoder s (GenTx a -> BridgeTx m a -> GenTx (DualBlock m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (GenTx m)
decodeMain
      Decoder s (GenTx a -> BridgeTx m a -> GenTx (DualBlock m a))
-> Decoder s (GenTx a)
-> Decoder s (BridgeTx m a -> GenTx (DualBlock m a))
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (GenTx a)
forall s. Decoder s (GenTx a)
forall a s. Serialise a => Decoder s a
decode
      Decoder s (BridgeTx m a -> GenTx (DualBlock m a))
-> Decoder s (BridgeTx m a) -> Decoder s (GenTx (DualBlock m a))
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (BridgeTx m a)
forall s. Decoder s (BridgeTx m a)
forall a s. Serialise a => Decoder s a
decode

encodeDualGenTxId :: (GenTxId m -> Encoding)
                  -> GenTxId (DualBlock m a) -> Encoding
encodeDualGenTxId :: forall m a.
(GenTxId m -> Encoding) -> GenTxId (DualBlock m a) -> Encoding
encodeDualGenTxId GenTxId m -> Encoding
encodeMain = GenTxId m -> Encoding
encodeMain (GenTxId m -> Encoding)
-> (GenTxId (DualBlock m a) -> GenTxId m)
-> GenTxId (DualBlock m a)
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTxId (DualBlock m a) -> GenTxId m
forall m a. TxId (GenTx (DualBlock m a)) -> GenTxId m
dualGenTxIdMain

decodeDualGenTxId :: Decoder s (GenTxId m)
                  -> Decoder s (GenTxId (DualBlock m a))
decodeDualGenTxId :: forall s m a.
Decoder s (GenTxId m) -> Decoder s (GenTxId (DualBlock m a))
decodeDualGenTxId Decoder s (GenTxId m)
decodeMain = GenTxId m -> TxId (GenTx (DualBlock m a))
forall m a. GenTxId m -> TxId (GenTx (DualBlock m a))
DualGenTxId (GenTxId m -> TxId (GenTx (DualBlock m a)))
-> Decoder s (GenTxId m)
-> Decoder s (TxId (GenTx (DualBlock m a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (GenTxId m)
decodeMain

encodeDualGenTxErr :: Serialise (ApplyTxErr a)
                   => (ApplyTxErr m -> Encoding)
                   -> ApplyTxErr (DualBlock m a) -> Encoding
encodeDualGenTxErr :: forall a m.
Serialise (ApplyTxErr a) =>
(ApplyTxErr m -> Encoding)
-> ApplyTxErr (DualBlock m a) -> Encoding
encodeDualGenTxErr ApplyTxErr m -> Encoding
encodeMain DualGenTxErr{ApplyTxErr a
ApplyTxErr m
dualGenTxErrMain :: forall m a. DualGenTxErr m a -> ApplyTxErr m
dualGenTxErrAux :: forall m a. DualGenTxErr m a -> ApplyTxErr a
dualGenTxErrMain :: ApplyTxErr m
dualGenTxErrAux :: ApplyTxErr a
..} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
encodeListLen Word
2
    , ApplyTxErr m -> Encoding
encodeMain ApplyTxErr m
dualGenTxErrMain
    , ApplyTxErr a -> Encoding
forall a. Serialise a => a -> Encoding
encode     ApplyTxErr a
dualGenTxErrAux
    ]

decodeDualGenTxErr :: Serialise (ApplyTxErr a)
                   => Decoder s (ApplyTxErr m)
                   -> Decoder s (ApplyTxErr (DualBlock m a))
decodeDualGenTxErr :: forall a s m.
Serialise (ApplyTxErr a) =>
Decoder s (ApplyTxErr m) -> Decoder s (ApplyTxErr (DualBlock m a))
decodeDualGenTxErr Decoder s (ApplyTxErr m)
decodeMain = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"DualGenTxErr" Int
2
    ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a
forall m a. ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a
DualGenTxErr
      (ApplyTxErr m -> ApplyTxErr a -> DualGenTxErr m a)
-> Decoder s (ApplyTxErr m)
-> Decoder s (ApplyTxErr a -> DualGenTxErr m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (ApplyTxErr m)
decodeMain
      Decoder s (ApplyTxErr a -> DualGenTxErr m a)
-> Decoder s (ApplyTxErr a) -> Decoder s (DualGenTxErr m a)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (ApplyTxErr a)
forall s. Decoder s (ApplyTxErr a)
forall a s. Serialise a => Decoder s a
decode

encodeDualLedgerState :: (Bridge m a, Serialise (LedgerState a))
                      => (LedgerState m -> Encoding)
                      -> LedgerState (DualBlock m a) -> Encoding
encodeDualLedgerState :: forall m a.
(Bridge m a, Serialise (LedgerState a)) =>
(LedgerState m -> Encoding)
-> LedgerState (DualBlock m a) -> Encoding
encodeDualLedgerState LedgerState m -> Encoding
encodeMain DualLedgerState{LedgerState m
LedgerState a
BridgeLedger m a
dualLedgerStateMain :: forall m a. LedgerState (DualBlock m a) -> LedgerState m
dualLedgerStateAux :: forall m a. LedgerState (DualBlock m a) -> LedgerState a
dualLedgerStateBridge :: forall m a. LedgerState (DualBlock m a) -> BridgeLedger m a
dualLedgerStateMain :: LedgerState m
dualLedgerStateAux :: LedgerState a
dualLedgerStateBridge :: BridgeLedger m a
..} = [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
      Word -> Encoding
encodeListLen Word
3
    , LedgerState m -> Encoding
encodeMain LedgerState m
dualLedgerStateMain
    , LedgerState a -> Encoding
forall a. Serialise a => a -> Encoding
encode     LedgerState a
dualLedgerStateAux
    , BridgeLedger m a -> Encoding
forall a. Serialise a => a -> Encoding
encode     BridgeLedger m a
dualLedgerStateBridge
    ]

decodeDualLedgerState :: (Bridge m a, Serialise (LedgerState a))
                      => Decoder s (LedgerState m)
                      -> Decoder s (LedgerState (DualBlock m a))
decodeDualLedgerState :: forall m a s.
(Bridge m a, Serialise (LedgerState a)) =>
Decoder s (LedgerState m)
-> Decoder s (LedgerState (DualBlock m a))
decodeDualLedgerState Decoder s (LedgerState m)
decodeMain = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"DualLedgerState" Int
3
    LedgerState m
-> LedgerState a -> BridgeLedger m a -> LedgerState (DualBlock m a)
forall m a.
LedgerState m
-> LedgerState a -> BridgeLedger m a -> LedgerState (DualBlock m a)
DualLedgerState
      (LedgerState m
 -> LedgerState a
 -> BridgeLedger m a
 -> LedgerState (DualBlock m a))
-> Decoder s (LedgerState m)
-> Decoder
     s
     (LedgerState a -> BridgeLedger m a -> LedgerState (DualBlock m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (LedgerState m)
decodeMain
      Decoder
  s
  (LedgerState a -> BridgeLedger m a -> LedgerState (DualBlock m a))
-> Decoder s (LedgerState a)
-> Decoder s (BridgeLedger m a -> LedgerState (DualBlock m a))
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (LedgerState a)
forall s. Decoder s (LedgerState a)
forall a s. Serialise a => Decoder s a
decode
      Decoder s (BridgeLedger m a -> LedgerState (DualBlock m a))
-> Decoder s (BridgeLedger m a)
-> Decoder s (LedgerState (DualBlock m a))
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (BridgeLedger m a)
forall s. Decoder s (BridgeLedger m a)
forall a s. Serialise a => Decoder s a
decode