{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.ByronDual.Ledger
  ( -- * Shorthand
    DualByronBlock
  , DualByronBridge

    -- * Bridge
  , ByronSpecBridge (..)
  , SpecToImplIds (..)
  , bridgeToSpecKey
  , bridgeTransactionIds
  , initByronSpecBridge
  , specToImplTx

    -- * Block forging
  , forgeDualByronBlock
  ) where

import qualified Byron.Spec.Ledger.Core as Spec
import qualified Byron.Spec.Ledger.UTxO as Spec
import qualified Cardano.Chain.UTxO as Impl
import Cardano.Crypto.DSIGN.Class
import Codec.Serialise
import Data.ByteString (ByteString)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import GHC.Generics (Generic)
import GHC.Stack
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Byron.Crypto.DSIGN
import Ouroboros.Consensus.Byron.Ledger
import Ouroboros.Consensus.Byron.Protocol
import Ouroboros.Consensus.ByronSpec.Ledger
import Ouroboros.Consensus.Ledger.Dual
import Ouroboros.Consensus.Protocol.PBFT
import qualified Test.Cardano.Chain.Elaboration.Block as Spec.Test
import qualified Test.Cardano.Chain.Elaboration.Keys as Spec.Test

{-------------------------------------------------------------------------------
  Shorthand
-------------------------------------------------------------------------------}

type DualByronBlock = DualBlock ByronBlock ByronSpecBlock
type DualByronBridge = BridgeLedger ByronBlock ByronSpecBlock

{-------------------------------------------------------------------------------
  Map transaction Ids (part of the bridge)
-------------------------------------------------------------------------------}

newtype SpecToImplIds = SpecToImplIds
  { SpecToImplIds -> AbstractToConcreteIdMaps
getSpecToImplIds :: Spec.Test.AbstractToConcreteIdMaps
  }
  deriving (Int -> SpecToImplIds -> ShowS
[SpecToImplIds] -> ShowS
SpecToImplIds -> String
(Int -> SpecToImplIds -> ShowS)
-> (SpecToImplIds -> String)
-> ([SpecToImplIds] -> ShowS)
-> Show SpecToImplIds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecToImplIds -> ShowS
showsPrec :: Int -> SpecToImplIds -> ShowS
$cshow :: SpecToImplIds -> String
show :: SpecToImplIds -> String
$cshowList :: [SpecToImplIds] -> ShowS
showList :: [SpecToImplIds] -> ShowS
Show, SpecToImplIds -> SpecToImplIds -> Bool
(SpecToImplIds -> SpecToImplIds -> Bool)
-> (SpecToImplIds -> SpecToImplIds -> Bool) -> Eq SpecToImplIds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecToImplIds -> SpecToImplIds -> Bool
== :: SpecToImplIds -> SpecToImplIds -> Bool
$c/= :: SpecToImplIds -> SpecToImplIds -> Bool
/= :: SpecToImplIds -> SpecToImplIds -> Bool
Eq, (forall x. SpecToImplIds -> Rep SpecToImplIds x)
-> (forall x. Rep SpecToImplIds x -> SpecToImplIds)
-> Generic SpecToImplIds
forall x. Rep SpecToImplIds x -> SpecToImplIds
forall x. SpecToImplIds -> Rep SpecToImplIds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SpecToImplIds -> Rep SpecToImplIds x
from :: forall x. SpecToImplIds -> Rep SpecToImplIds x
$cto :: forall x. Rep SpecToImplIds x -> SpecToImplIds
to :: forall x. Rep SpecToImplIds x -> SpecToImplIds
Generic, [SpecToImplIds] -> Encoding
SpecToImplIds -> Encoding
(SpecToImplIds -> Encoding)
-> (forall s. Decoder s SpecToImplIds)
-> ([SpecToImplIds] -> Encoding)
-> (forall s. Decoder s [SpecToImplIds])
-> Serialise SpecToImplIds
forall s. Decoder s [SpecToImplIds]
forall s. Decoder s SpecToImplIds
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: SpecToImplIds -> Encoding
encode :: SpecToImplIds -> Encoding
$cdecode :: forall s. Decoder s SpecToImplIds
decode :: forall s. Decoder s SpecToImplIds
$cencodeList :: [SpecToImplIds] -> Encoding
encodeList :: [SpecToImplIds] -> Encoding
$cdecodeList :: forall s. Decoder s [SpecToImplIds]
decodeList :: forall s. Decoder s [SpecToImplIds]
Serialise)

instance Semigroup SpecToImplIds where
  SpecToImplIds AbstractToConcreteIdMaps
a <> :: SpecToImplIds -> SpecToImplIds -> SpecToImplIds
<> SpecToImplIds AbstractToConcreteIdMaps
b =
    AbstractToConcreteIdMaps -> SpecToImplIds
SpecToImplIds (AbstractToConcreteIdMaps -> SpecToImplIds)
-> AbstractToConcreteIdMaps -> SpecToImplIds
forall a b. (a -> b) -> a -> b
$
      Spec.Test.AbstractToConcreteIdMaps
        { transactionIds :: Map TxId TxId
transactionIds = (AbstractToConcreteIdMaps -> Map TxId TxId) -> Map TxId TxId
forall x. Semigroup x => (AbstractToConcreteIdMaps -> x) -> x
combine AbstractToConcreteIdMaps -> Map TxId TxId
Spec.Test.transactionIds
        , proposalIds :: Map UpId UpId
proposalIds = (AbstractToConcreteIdMaps -> Map UpId UpId) -> Map UpId UpId
forall x. Semigroup x => (AbstractToConcreteIdMaps -> x) -> x
combine AbstractToConcreteIdMaps -> Map UpId UpId
Spec.Test.proposalIds
        }
   where
    combine :: Semigroup x => (Spec.Test.AbstractToConcreteIdMaps -> x) -> x
    combine :: forall x. Semigroup x => (AbstractToConcreteIdMaps -> x) -> x
combine AbstractToConcreteIdMaps -> x
f = AbstractToConcreteIdMaps -> x
f AbstractToConcreteIdMaps
a x -> x -> x
forall a. Semigroup a => a -> a -> a
<> AbstractToConcreteIdMaps -> x
f AbstractToConcreteIdMaps
b

instance Monoid SpecToImplIds where
  mempty :: SpecToImplIds
mempty =
    AbstractToConcreteIdMaps -> SpecToImplIds
SpecToImplIds
      Spec.Test.AbstractToConcreteIdMaps
        { transactionIds :: Map TxId TxId
transactionIds = Map TxId TxId
forall a. Monoid a => a
mempty
        , proposalIds :: Map UpId UpId
proposalIds = Map UpId UpId
forall a. Monoid a => a
mempty
        }

-- | Construct singleton 'SpecToImplIds' for a transaction
specToImplTx :: Spec.Tx -> Impl.ATxAux ByteString -> SpecToImplIds
specToImplTx :: Tx -> ATxAux ByteString -> SpecToImplIds
specToImplTx Tx
spec ATxAux ByteString
impl =
  AbstractToConcreteIdMaps -> SpecToImplIds
SpecToImplIds (AbstractToConcreteIdMaps -> SpecToImplIds)
-> AbstractToConcreteIdMaps -> SpecToImplIds
forall a b. (a -> b) -> a -> b
$
    Spec.Test.AbstractToConcreteIdMaps
      { transactionIds :: Map TxId TxId
transactionIds = TxId -> TxId -> Map TxId TxId
forall k a. k -> a -> Map k a
Map.singleton (Tx -> TxId
specTxId Tx
spec) (ATxAux ByteString -> TxId
byronIdTx ATxAux ByteString
impl)
      , proposalIds :: Map UpId UpId
proposalIds = Map UpId UpId
forall k a. Map k a
Map.empty
      }
 where
  specTxId :: Spec.Tx -> Spec.TxId
  specTxId :: Tx -> TxId
specTxId = TxBody -> TxId
Spec.txid (TxBody -> TxId) -> (Tx -> TxBody) -> Tx -> TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> TxBody
Spec.body

{-------------------------------------------------------------------------------
  Bridge
-------------------------------------------------------------------------------}

-- | Bridge the gap between the Byron implementation and specification
--
-- The relation between the Byron implementation and specification for the
-- /linear/ case is tested in the Byron implementation itself, specifically
-- in 'ts_prop_generatedChainsAreValidated'. The main goal of the consensus
-- DualByron tests is to lift these tests to the general consensus setting,
-- where time is not linear but branching.
--
-- In the linear case, the tests maintain some state linking the spec and
-- the implementation. In the consensus case, this state cannot be maintained
-- like this, and so it has to become part of transactions, blocks, and the
-- ledger state itself.
data ByronSpecBridge = ByronSpecBridge
  { ByronSpecBridge -> Map (PBftVerKeyHash PBftByronCrypto) VKey
toSpecKeys :: Map (PBftVerKeyHash PBftByronCrypto) Spec.VKey
  -- ^ Map between keys
  --
  -- Some observations:
  --
  -- * The abstract chain environment contains a set of allowed delegators
  --   (of type @Set VKeyGenesis@), which gets translated to
  --   'gdGenesisKeyHashes' (of type @Set Common.KeyHash@) in the concrete
  --   genesis config.
  --
  -- * During the translation from abstract blocks to concrete blocks, the
  --   'VKey' of the block is translated to a concrete 'SigningKey' (as well
  --   as a 'VerificationKey') in 'elaborateKeyPair'.
  --
  -- * Although this translation is deterministic, it doesn't have an
  --   easily definable inverse. For this reason, we maintain an opposite
  --   mapping as part of the ledger state.
  , ByronSpecBridge -> SpecToImplIds
toImplIds :: SpecToImplIds
  -- ^ Mapping between abstract and concrete Ids
  --
  -- We need to maintain this mapping so that we can use the abstract state
  -- generators and then elaborate to concrete values.
  }
  deriving (Int -> ByronSpecBridge -> ShowS
[ByronSpecBridge] -> ShowS
ByronSpecBridge -> String
(Int -> ByronSpecBridge -> ShowS)
-> (ByronSpecBridge -> String)
-> ([ByronSpecBridge] -> ShowS)
-> Show ByronSpecBridge
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronSpecBridge -> ShowS
showsPrec :: Int -> ByronSpecBridge -> ShowS
$cshow :: ByronSpecBridge -> String
show :: ByronSpecBridge -> String
$cshowList :: [ByronSpecBridge] -> ShowS
showList :: [ByronSpecBridge] -> ShowS
Show, ByronSpecBridge -> ByronSpecBridge -> Bool
(ByronSpecBridge -> ByronSpecBridge -> Bool)
-> (ByronSpecBridge -> ByronSpecBridge -> Bool)
-> Eq ByronSpecBridge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByronSpecBridge -> ByronSpecBridge -> Bool
== :: ByronSpecBridge -> ByronSpecBridge -> Bool
$c/= :: ByronSpecBridge -> ByronSpecBridge -> Bool
/= :: ByronSpecBridge -> ByronSpecBridge -> Bool
Eq, (forall x. ByronSpecBridge -> Rep ByronSpecBridge x)
-> (forall x. Rep ByronSpecBridge x -> ByronSpecBridge)
-> Generic ByronSpecBridge
forall x. Rep ByronSpecBridge x -> ByronSpecBridge
forall x. ByronSpecBridge -> Rep ByronSpecBridge x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByronSpecBridge -> Rep ByronSpecBridge x
from :: forall x. ByronSpecBridge -> Rep ByronSpecBridge x
$cto :: forall x. Rep ByronSpecBridge x -> ByronSpecBridge
to :: forall x. Rep ByronSpecBridge x -> ByronSpecBridge
Generic, [ByronSpecBridge] -> Encoding
ByronSpecBridge -> Encoding
(ByronSpecBridge -> Encoding)
-> (forall s. Decoder s ByronSpecBridge)
-> ([ByronSpecBridge] -> Encoding)
-> (forall s. Decoder s [ByronSpecBridge])
-> Serialise ByronSpecBridge
forall s. Decoder s [ByronSpecBridge]
forall s. Decoder s ByronSpecBridge
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: ByronSpecBridge -> Encoding
encode :: ByronSpecBridge -> Encoding
$cdecode :: forall s. Decoder s ByronSpecBridge
decode :: forall s. Decoder s ByronSpecBridge
$cencodeList :: [ByronSpecBridge] -> Encoding
encodeList :: [ByronSpecBridge] -> Encoding
$cdecodeList :: forall s. Decoder s [ByronSpecBridge]
decodeList :: forall s. Decoder s [ByronSpecBridge]
Serialise)

instance Bridge ByronBlock ByronSpecBlock where
  type BridgeLedger ByronBlock ByronSpecBlock = ByronSpecBridge
  type BridgeBlock ByronBlock ByronSpecBlock = SpecToImplIds
  type BridgeTx ByronBlock ByronSpecBlock = SpecToImplIds

  -- TODO: Once we generate delegation certificates,
  -- we should update 'toSpecKeys' also,

  updateBridgeWithBlock :: DualBlock ByronBlock ByronSpecBlock
-> BridgeLedger ByronBlock ByronSpecBlock
-> BridgeLedger ByronBlock ByronSpecBlock
updateBridgeWithBlock DualBlock ByronBlock ByronSpecBlock
block BridgeLedger ByronBlock ByronSpecBlock
bridge =
    BridgeLedger ByronBlock ByronSpecBlock
bridge
      { toImplIds = toImplIds bridge <> dualBlockBridge block
      }

  updateBridgeWithTx :: Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
-> BridgeLedger ByronBlock ByronSpecBlock
-> BridgeLedger ByronBlock ByronSpecBlock
updateBridgeWithTx Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
genTx BridgeLedger ByronBlock ByronSpecBlock
bridge =
    BridgeLedger ByronBlock ByronSpecBlock
bridge
      { toImplIds = toImplIds bridge <> vDualGenTxBridge genTx
      }

{-------------------------------------------------------------------------------
  Bridge initialization
-------------------------------------------------------------------------------}

initByronSpecBridge ::
  ByronSpecGenesis ->
  -- | Mapping for the transaction in the initial UTxO
  Map Spec.TxId Impl.TxId ->
  ByronSpecBridge
initByronSpecBridge :: ByronSpecGenesis -> Map TxId TxId -> ByronSpecBridge
initByronSpecBridge ByronSpecGenesis{Natural
BlockCount
PParams
UTxO
Set VKeyGenesis
byronSpecGenesisDelegators :: Set VKeyGenesis
byronSpecGenesisInitUtxo :: UTxO
byronSpecGenesisInitPParams :: PParams
byronSpecGenesisSecurityParam :: BlockCount
byronSpecGenesisSlotLength :: Natural
byronSpecGenesisDelegators :: ByronSpecGenesis -> Set VKeyGenesis
byronSpecGenesisInitPParams :: ByronSpecGenesis -> PParams
byronSpecGenesisInitUtxo :: ByronSpecGenesis -> UTxO
byronSpecGenesisSecurityParam :: ByronSpecGenesis -> BlockCount
byronSpecGenesisSlotLength :: ByronSpecGenesis -> Natural
..} Map TxId TxId
txIdMap =
  ByronSpecBridge
    { toSpecKeys :: Map (PBftVerKeyHash PBftByronCrypto) VKey
toSpecKeys =
        [(PBftVerKeyHash PBftByronCrypto, VKey)]
-> Map (PBftVerKeyHash PBftByronCrypto) VKey
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PBftVerKeyHash PBftByronCrypto, VKey)]
 -> Map (PBftVerKeyHash PBftByronCrypto) VKey)
-> [(PBftVerKeyHash PBftByronCrypto, VKey)]
-> Map (PBftVerKeyHash PBftByronCrypto) VKey
forall a b. (a -> b) -> a -> b
$
          (VKeyGenesis -> (PBftVerKeyHash PBftByronCrypto, VKey))
-> [VKeyGenesis] -> [(PBftVerKeyHash PBftByronCrypto, VKey)]
forall a b. (a -> b) -> [a] -> [b]
map VKeyGenesis -> (PBftVerKeyHash PBftByronCrypto, VKey)
mapKey ([VKeyGenesis] -> [(PBftVerKeyHash PBftByronCrypto, VKey)])
-> [VKeyGenesis] -> [(PBftVerKeyHash PBftByronCrypto, VKey)]
forall a b. (a -> b) -> a -> b
$
            Set VKeyGenesis -> [VKeyGenesis]
forall a. Set a -> [a]
Set.toList Set VKeyGenesis
byronSpecGenesisDelegators
    , toImplIds :: SpecToImplIds
toImplIds =
        AbstractToConcreteIdMaps -> SpecToImplIds
SpecToImplIds
          Spec.Test.AbstractToConcreteIdMaps
            { transactionIds :: Map TxId TxId
transactionIds = Map TxId TxId
txIdMap
            , proposalIds :: Map UpId UpId
proposalIds = Map UpId UpId
forall k a. Map k a
Map.empty
            }
    }
 where
  -- The abstract spec maps the allowed delegators to themselves initially
  mapKey :: Spec.VKeyGenesis -> (PBftVerKeyHash PBftByronCrypto, Spec.VKey)
  mapKey :: VKeyGenesis -> (PBftVerKeyHash PBftByronCrypto, VKey)
mapKey (Spec.VKeyGenesis VKey
vkey) =
    ( VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
forall c.
PBftCrypto c =>
VerKeyDSIGN (PBftDSIGN c) -> PBftVerKeyHash c
hashVerKey (VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
 -> PBftVerKeyHash PBftByronCrypto)
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
forall a b. (a -> b) -> a -> b
$ VerificationKey -> VerKeyDSIGN ByronDSIGN
VerKeyByronDSIGN (VKey -> VerificationKey
Spec.Test.elaborateVKey VKey
vkey)
    , VKey
vkey
    )

{-------------------------------------------------------------------------------
  Using the bridge
-------------------------------------------------------------------------------}

-- | Translate issuer key
--
-- We get a proof from PBFT that we are the leader, including a signing key (of
-- type 'SigningKey'). In order to produce the corresponding abstract block, we
-- need a 'VKey'.
bridgeToSpecKey ::
  DualByronBridge ->
  PBftVerKeyHash PBftByronCrypto ->
  Spec.VKey
bridgeToSpecKey :: BridgeLedger ByronBlock ByronSpecBlock
-> PBftVerKeyHash PBftByronCrypto -> VKey
bridgeToSpecKey ByronSpecBridge{Map (PBftVerKeyHash PBftByronCrypto) VKey
SpecToImplIds
toSpecKeys :: ByronSpecBridge -> Map (PBftVerKeyHash PBftByronCrypto) VKey
toImplIds :: ByronSpecBridge -> SpecToImplIds
toSpecKeys :: Map (PBftVerKeyHash PBftByronCrypto) VKey
toImplIds :: SpecToImplIds
..} PBftVerKeyHash PBftByronCrypto
keyHash =
  case KeyHash -> Map KeyHash VKey -> Maybe VKey
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash
PBftVerKeyHash PBftByronCrypto
keyHash Map KeyHash VKey
Map (PBftVerKeyHash PBftByronCrypto) VKey
toSpecKeys of
    Just VKey
vkey -> VKey
vkey
    Maybe VKey
Nothing -> String -> VKey
forall a. HasCallStack => String -> a
error (String -> VKey) -> String -> VKey
forall a b. (a -> b) -> a -> b
$ String
"toSpecKey: unknown key " String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyHash -> String
forall a. Show a => a -> String
show KeyHash
PBftVerKeyHash PBftByronCrypto
keyHash

bridgeTransactionIds :: DualByronBridge -> Map Spec.TxId Impl.TxId
bridgeTransactionIds :: BridgeLedger ByronBlock ByronSpecBlock -> Map TxId TxId
bridgeTransactionIds =
  AbstractToConcreteIdMaps -> Map TxId TxId
Spec.Test.transactionIds
    (AbstractToConcreteIdMaps -> Map TxId TxId)
-> (ByronSpecBridge -> AbstractToConcreteIdMaps)
-> ByronSpecBridge
-> Map TxId TxId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecToImplIds -> AbstractToConcreteIdMaps
getSpecToImplIds
    (SpecToImplIds -> AbstractToConcreteIdMaps)
-> (ByronSpecBridge -> SpecToImplIds)
-> ByronSpecBridge
-> AbstractToConcreteIdMaps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByronSpecBridge -> SpecToImplIds
toImplIds

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

forgeDualByronBlock ::
  HasCallStack =>
  ForgeBlockArgs DualByronBlock ->
  DualByronBlock
forgeDualByronBlock :: HasCallStack =>
ForgeBlockArgs (DualBlock ByronBlock ByronSpecBlock)
-> DualBlock ByronBlock ByronSpecBlock
forgeDualByronBlock ForgeBlockArgs{[Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))]
Maybe (PerasCert (DualBlock ByronBlock ByronSpecBlock))
BlockNo
SlotNo
TickedLedgerState (DualBlock ByronBlock ByronSpecBlock) EmptyMK
IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
TopLevelConfig (DualBlock ByronBlock ByronSpecBlock)
fbConfig :: TopLevelConfig (DualBlock ByronBlock ByronSpecBlock)
fbCurrentBlockNo :: BlockNo
fbCurrentSlotNo :: SlotNo
fbPerasCert :: Maybe (PerasCert (DualBlock ByronBlock ByronSpecBlock))
fbCurrentTickedLedgerState :: TickedLedgerState (DualBlock ByronBlock ByronSpecBlock) EmptyMK
fbTxs :: [Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))]
fbIsLeader :: IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
fbConfig :: forall blk. ForgeBlockArgs blk -> TopLevelConfig blk
fbCurrentBlockNo :: forall blk. ForgeBlockArgs blk -> BlockNo
fbCurrentSlotNo :: forall blk. ForgeBlockArgs blk -> SlotNo
fbCurrentTickedLedgerState :: forall blk. ForgeBlockArgs blk -> TickedLedgerState blk EmptyMK
fbIsLeader :: forall blk. ForgeBlockArgs blk -> IsLeader (BlockProtocol blk)
fbPerasCert :: forall blk. ForgeBlockArgs blk -> Maybe (PerasCert blk)
fbTxs :: forall blk. ForgeBlockArgs blk -> [Validated (GenTx blk)]
..} =
  -- NOTE: We do not /elaborate/ the real Byron block from the spec one, but
  -- instead we /forge/ it. This is important, because we want to test that
  -- codepath. This does mean that we do not get any kind of "bridge" between
  -- the two blocks (which we would have gotten if we would have elaborated
  -- the block instead). Fortunately, this is okay, since the bridge for the
  -- block can be computed from the bridge information of all of the txs.
  DualBlock
    { dualBlockMain :: ByronBlock
dualBlockMain = ByronBlock
main
    , dualBlockAux :: Maybe ByronSpecBlock
dualBlockAux = ByronSpecBlock -> Maybe ByronSpecBlock
forall a. a -> Maybe a
Just ByronSpecBlock
aux
    , dualBlockBridge :: BridgeBlock ByronBlock ByronSpecBlock
dualBlockBridge = [BridgeBlock ByronBlock ByronSpecBlock]
-> BridgeBlock ByronBlock ByronSpecBlock
forall a. Monoid a => [a] -> a
mconcat ([BridgeBlock ByronBlock ByronSpecBlock]
 -> BridgeBlock ByronBlock ByronSpecBlock)
-> [BridgeBlock ByronBlock ByronSpecBlock]
-> BridgeBlock ByronBlock ByronSpecBlock
forall a b. (a -> b) -> a -> b
$ (Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
 -> BridgeBlock ByronBlock ByronSpecBlock)
-> [Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))]
-> [BridgeBlock ByronBlock ByronSpecBlock]
forall a b. (a -> b) -> [a] -> [b]
map Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
-> BridgeBlock ByronBlock ByronSpecBlock
Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
-> BridgeTx ByronBlock ByronSpecBlock
forall m a. Validated (GenTx (DualBlock m a)) -> BridgeTx m a
vDualGenTxBridge [Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))]
fbTxs
    }
 where
  main :: ByronBlock
  main :: ByronBlock
main =
    HasCallStack => ForgeBlockArgs ByronBlock -> ByronBlock
ForgeBlockArgs ByronBlock -> ByronBlock
forgeByronBlock (ForgeBlockArgs ByronBlock -> ByronBlock)
-> ForgeBlockArgs ByronBlock -> ByronBlock
forall a b. (a -> b) -> a -> b
$
      ForgeBlockArgs
        { fbConfig :: TopLevelConfig ByronBlock
fbConfig = TopLevelConfig (DualBlock ByronBlock ByronSpecBlock)
-> TopLevelConfig ByronBlock
forall m a. TopLevelConfig (DualBlock m a) -> TopLevelConfig m
dualTopLevelConfigMain TopLevelConfig (DualBlock ByronBlock ByronSpecBlock)
fbConfig
        , BlockNo
fbCurrentBlockNo :: BlockNo
fbCurrentBlockNo :: BlockNo
fbCurrentBlockNo
        , SlotNo
fbCurrentSlotNo :: SlotNo
fbCurrentSlotNo :: SlotNo
fbCurrentSlotNo
        , fbPerasCert :: Maybe (PerasCert ByronBlock)
fbPerasCert = Maybe (VoidPerasCert ByronBlock)
Maybe (PerasCert ByronBlock)
forall a. Maybe a
Nothing -- Doesn't support Peras
        , fbCurrentTickedLedgerState :: TickedLedgerState ByronBlock EmptyMK
fbCurrentTickedLedgerState = TickedLedgerState (DualBlock ByronBlock ByronSpecBlock) EmptyMK
-> TickedLedgerState ByronBlock EmptyMK
forall m a (mk :: * -> * -> *).
Ticked LedgerState (DualBlock m a) mk -> Ticked LedgerState m mk
tickedDualLedgerStateMain TickedLedgerState (DualBlock ByronBlock ByronSpecBlock) EmptyMK
fbCurrentTickedLedgerState
        , fbTxs :: [Validated (GenTx ByronBlock)]
fbTxs = (Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
 -> Validated (GenTx ByronBlock))
-> [Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))]
-> [Validated (GenTx ByronBlock)]
forall a b. (a -> b) -> [a] -> [b]
map Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
-> Validated (GenTx ByronBlock)
forall m a.
Validated (GenTx (DualBlock m a)) -> Validated (GenTx m)
vDualGenTxMain [Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))]
fbTxs
        , IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
IsLeader (BlockProtocol ByronBlock)
fbIsLeader :: IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
fbIsLeader :: IsLeader (BlockProtocol ByronBlock)
fbIsLeader
        }

  aux :: ByronSpecBlock
  aux :: ByronSpecBlock
aux =
    BlockNo
-> SlotNo
-> Ticked LedgerState ByronSpecBlock ValuesMK
-> [Validated (GenTx ByronSpecBlock)]
-> VKey
-> ByronSpecBlock
forall (mk :: * -> * -> *).
BlockNo
-> SlotNo
-> Ticked LedgerState ByronSpecBlock mk
-> [Validated (GenTx ByronSpecBlock)]
-> VKey
-> ByronSpecBlock
forgeByronSpecBlock
      BlockNo
fbCurrentBlockNo
      SlotNo
fbCurrentSlotNo
      (TickedLedgerState (DualBlock ByronBlock ByronSpecBlock) EmptyMK
-> Ticked LedgerState ByronSpecBlock ValuesMK
forall m a (mk :: * -> * -> *).
Ticked LedgerState (DualBlock m a) mk
-> Ticked LedgerState a ValuesMK
tickedDualLedgerStateAux TickedLedgerState (DualBlock ByronBlock ByronSpecBlock) EmptyMK
fbCurrentTickedLedgerState)
      ((Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
 -> Validated (GenTx ByronSpecBlock))
-> [Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))]
-> [Validated (GenTx ByronSpecBlock)]
forall a b. (a -> b) -> [a] -> [b]
map Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))
-> Validated (GenTx ByronSpecBlock)
forall m a.
Validated (GenTx (DualBlock m a)) -> Validated (GenTx a)
vDualGenTxAux [Validated (GenTx (DualBlock ByronBlock ByronSpecBlock))]
fbTxs)
      ( BridgeLedger ByronBlock ByronSpecBlock
-> PBftVerKeyHash PBftByronCrypto -> VKey
bridgeToSpecKey
          (TickedLedgerState (DualBlock ByronBlock ByronSpecBlock) EmptyMK
-> BridgeLedger ByronBlock ByronSpecBlock
forall m a (mk :: * -> * -> *).
Ticked LedgerState (DualBlock m a) mk -> BridgeLedger m a
tickedDualLedgerStateBridge TickedLedgerState (DualBlock ByronBlock ByronSpecBlock) EmptyMK
fbCurrentTickedLedgerState)
          (VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> PBftVerKeyHash PBftByronCrypto
forall c.
PBftCrypto c =>
VerKeyDSIGN (PBftDSIGN c) -> PBftVerKeyHash c
hashVerKey (VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
 -> PBftVerKeyHash PBftByronCrypto)
-> (IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
    -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto))
-> IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
-> PBftVerKeyHash PBftByronCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
 -> VerKeyDSIGN (PBftDSIGN PBftByronCrypto))
-> (PBftIsLeader PBftByronCrypto
    -> SignKeyDSIGN (PBftDSIGN PBftByronCrypto))
-> PBftIsLeader PBftByronCrypto
-> VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBftIsLeader PBftByronCrypto
-> SignKeyDSIGN (PBftDSIGN PBftByronCrypto)
forall c. PBftIsLeader c -> SignKeyDSIGN (PBftDSIGN c)
pbftIsLeaderSignKey (IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
 -> PBftVerKeyHash PBftByronCrypto)
-> IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
-> PBftVerKeyHash PBftByronCrypto
forall a b. (a -> b) -> a -> b
$ IsLeader (BlockProtocol (DualBlock ByronBlock ByronSpecBlock))
fbIsLeader)
      )