{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.ThreadNet.TxGen.Cardano (CardanoTxGenExtra (..)) where

import qualified Cardano.Chain.Common as Byron
import Cardano.Chain.Genesis (GeneratedSecrets (..))
import Cardano.Crypto (toVerification)
import qualified Cardano.Crypto.DSIGN as DSIGN
import qualified Cardano.Crypto.Signing as Byron
import qualified Cardano.Crypto.VRF as VRF
import qualified Cardano.Ledger.Address as SL (BootstrapAddress (..))
import qualified Cardano.Ledger.Hashes as SL
import Cardano.Ledger.Keys (DSIGN)
import qualified Cardano.Ledger.Keys.Bootstrap as SL (makeBootstrapWitness)
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.Core as SL
import Cardano.Ledger.Val ((<->))
import Cardano.Protocol.Crypto (VRF)
import Control.Exception (assert)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (maybeToList)
import Data.SOP.Strict
import Data.SOP.Telescope as Tele
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Lens.Micro
import Ouroboros.Consensus.Block (SlotNo (..))
import Ouroboros.Consensus.Cardano
import Ouroboros.Consensus.Cardano.Block
  ( CardanoEras
  , GenTx (..)
  , ShelleyEra
  )
import Ouroboros.Consensus.Cardano.Node (CardanoHardForkConstraints)
import Ouroboros.Consensus.Config
import Ouroboros.Consensus.HardFork.Combinator.Ledger
  ( getFlipTickedLedgerState
  , tickedHardForkLedgerStatePerEra
  )
import Ouroboros.Consensus.HardFork.Combinator.State.Types
  ( currentState
  , getHardForkState
  )
import Ouroboros.Consensus.Ledger.Basics
  ( ComputeLedgerEvents (..)
  , LedgerConfig
  , LedgerState
  , TickedLedgerState
  , applyChainTick
  )
import Ouroboros.Consensus.Ledger.Tables (ValuesMK)
import Ouroboros.Consensus.Ledger.Tables.Utils
  ( applyDiffs
  , forgetLedgerTables
  )
import Ouroboros.Consensus.NodeId (CoreNodeId (..))
import Ouroboros.Consensus.Protocol.TPraos (TPraos)
import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, mkShelleyTx)
import Ouroboros.Consensus.Shelley.Ledger.Ledger
  ( tickedShelleyLedgerState
  )
import qualified Test.Cardano.Ledger.Core.KeyPair as TL (mkWitnessVKey)
import qualified Test.ThreadNet.Infra.Shelley as Shelley
import Test.ThreadNet.TxGen

data CardanoTxGenExtra c = CardanoTxGenExtra
  { forall c. CardanoTxGenExtra c -> GeneratedSecrets
ctgeByronGenesisKeys :: GeneratedSecrets
  , forall c. CardanoTxGenExtra c -> NetworkMagic
ctgeNetworkMagic :: Byron.NetworkMagic
  , forall c. CardanoTxGenExtra c -> [CoreNode c]
ctgeShelleyCoreNodes :: [Shelley.CoreNode c]
  }

instance CardanoHardForkConstraints c => TxGen (CardanoBlock c) where
  type TxGenExtra (CardanoBlock c) = CardanoTxGenExtra c

  -- TODO also generate " typical " Byron and Shelley transactions
  testGenTxs :: CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig (CardanoBlock c)
-> TxGenExtra (CardanoBlock c)
-> LedgerState (CardanoBlock c) ValuesMK
-> Gen [GenTx (CardanoBlock c)]
testGenTxs (CoreNodeId Word64
i) NumCoreNodes
_ncn SlotNo
curSlot TopLevelConfig (CardanoBlock c)
cfg TxGenExtra (CardanoBlock c)
extra LedgerState (CardanoBlock c) ValuesMK
ls =
    [GenTx (CardanoBlock c)] -> Gen [GenTx (CardanoBlock c)]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([GenTx (CardanoBlock c)] -> Gen [GenTx (CardanoBlock c)])
-> [GenTx (CardanoBlock c)] -> Gen [GenTx (CardanoBlock c)]
forall a b. (a -> b) -> a -> b
$ Maybe (GenTx (CardanoBlock c)) -> [GenTx (CardanoBlock c)]
forall a. Maybe a -> [a]
maybeToList (Maybe (GenTx (CardanoBlock c)) -> [GenTx (CardanoBlock c)])
-> Maybe (GenTx (CardanoBlock c)) -> [GenTx (CardanoBlock c)]
forall a b. (a -> b) -> a -> b
$ MigrationInfo c
-> SlotNo
-> LedgerConfig (CardanoBlock c)
-> LedgerState (CardanoBlock c) ValuesMK
-> Maybe (GenTx (CardanoBlock c))
forall c.
CardanoHardForkConstraints c =>
MigrationInfo c
-> SlotNo
-> LedgerConfig (CardanoBlock c)
-> LedgerState (CardanoBlock c) ValuesMK
-> Maybe (GenTx (CardanoBlock c))
migrateUTxO MigrationInfo c
migrationInfo SlotNo
curSlot LedgerConfig (CardanoBlock c)
lcfg LedgerState (CardanoBlock c) ValuesMK
ls
   where
    lcfg :: LedgerConfig (CardanoBlock c)
lcfg = TopLevelConfig (CardanoBlock c) -> LedgerConfig (CardanoBlock c)
forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger TopLevelConfig (CardanoBlock c)
cfg

    CardanoTxGenExtra
      { GeneratedSecrets
ctgeByronGenesisKeys :: forall c. CardanoTxGenExtra c -> GeneratedSecrets
ctgeByronGenesisKeys :: GeneratedSecrets
ctgeByronGenesisKeys
      , NetworkMagic
ctgeNetworkMagic :: forall c. CardanoTxGenExtra c -> NetworkMagic
ctgeNetworkMagic :: NetworkMagic
ctgeNetworkMagic
      , [CoreNode c]
ctgeShelleyCoreNodes :: forall c. CardanoTxGenExtra c -> [CoreNode c]
ctgeShelleyCoreNodes :: [CoreNode c]
ctgeShelleyCoreNodes
      } = TxGenExtra (CardanoBlock c)
extra

    GeneratedSecrets
      { [SigningKey]
gsRichSecrets :: [SigningKey]
gsRichSecrets :: GeneratedSecrets -> [SigningKey]
gsRichSecrets
      } = GeneratedSecrets
ctgeByronGenesisKeys

    migrationInfo :: MigrationInfo c
migrationInfo =
      MigrationInfo
        { byronMagic :: NetworkMagic
byronMagic = NetworkMagic
ctgeNetworkMagic
        , SigningKey
byronSK :: SigningKey
byronSK :: SigningKey
byronSK
        , SignKeyDSIGN DSIGN
paymentSK :: SignKeyDSIGN DSIGN
paymentSK :: SignKeyDSIGN DSIGN
paymentSK
        , SignKeyDSIGN DSIGN
poolSK :: SignKeyDSIGN DSIGN
poolSK :: SignKeyDSIGN DSIGN
poolSK
        , SignKeyDSIGN DSIGN
stakingSK :: SignKeyDSIGN DSIGN
stakingSK :: SignKeyDSIGN DSIGN
stakingSK
        , SignKeyVRF (VRF c)
vrfSK :: SignKeyVRF (VRF c)
vrfSK :: SignKeyVRF (VRF c)
vrfSK
        }

    byronSK :: Byron.SigningKey
    byronSK :: SigningKey
byronSK = [SigningKey]
gsRichSecrets [SigningKey] -> Int -> SigningKey
forall a. HasCallStack => [a] -> Int -> a
!! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

    Shelley.CoreNode
      { cnDelegateKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
Shelley.cnDelegateKey = SignKeyDSIGN DSIGN
paymentSK
      , cnStakingKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
Shelley.cnStakingKey = SignKeyDSIGN DSIGN
stakingSK
      , cnVRF :: forall c. CoreNode c -> SignKeyVRF (VRF c)
Shelley.cnVRF = SignKeyVRF (VRF c)
vrfSK
      } = [CoreNode c]
ctgeShelleyCoreNodes [CoreNode c] -> Int -> CoreNode c
forall a. HasCallStack => [a] -> Int -> a
!! Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i

    -- Reuse the payment key as the pool key, since it's an individual
    -- stake pool and the namespaces are separate.
    poolSK :: DSIGN.SignKeyDSIGN DSIGN
    poolSK :: SignKeyDSIGN DSIGN
poolSK = SignKeyDSIGN DSIGN
paymentSK

-- | See 'migrateUTxO'
data MigrationInfo c = MigrationInfo
  { forall c. MigrationInfo c -> NetworkMagic
byronMagic :: Byron.NetworkMagic
  -- ^ Needed for creating a Byron address.
  , forall c. MigrationInfo c -> SigningKey
byronSK :: Byron.SigningKey
  -- ^ The core node's Byron secret.
  , forall c. MigrationInfo c -> SignKeyDSIGN DSIGN
paymentSK :: DSIGN.SignKeyDSIGN DSIGN
  , forall c. MigrationInfo c -> SignKeyDSIGN DSIGN
poolSK :: DSIGN.SignKeyDSIGN DSIGN
  , forall c. MigrationInfo c -> SignKeyDSIGN DSIGN
stakingSK :: DSIGN.SignKeyDSIGN DSIGN
  , forall c. MigrationInfo c -> SignKeyVRF (VRF c)
vrfSK :: VRF.SignKeyVRF (VRF c)
  -- ^ To be re-used by the individual pool.
  }

-- | Convert a core node's utxo from Byron to an active Shelley stake pool.
--
-- Returns a transaction that registers a staking key, registers an individual
-- stake pool, delegates that stake key to that stake pool, and transfers all
-- utxo from the Byron 'byronAddr' to the Shelley address corresponding to the
-- pair of 'paymentSK' and 'stakingSK'.
--
-- It returns 'Nothing' if the core node does not have any utxo in its
-- 'byronAddr' (eg if this transaction has already been applied).
migrateUTxO ::
  forall c.
  CardanoHardForkConstraints c =>
  MigrationInfo c ->
  SlotNo ->
  LedgerConfig (CardanoBlock c) ->
  LedgerState (CardanoBlock c) ValuesMK ->
  Maybe (GenTx (CardanoBlock c))
migrateUTxO :: forall c.
CardanoHardForkConstraints c =>
MigrationInfo c
-> SlotNo
-> LedgerConfig (CardanoBlock c)
-> LedgerState (CardanoBlock c) ValuesMK
-> Maybe (GenTx (CardanoBlock c))
migrateUTxO MigrationInfo c
migrationInfo SlotNo
curSlot LedgerConfig (CardanoBlock c)
lcfg LedgerState (CardanoBlock c) ValuesMK
lst
  | Just UTxO ShelleyEra
utxo <- Maybe (UTxO ShelleyEra)
mbUTxO =
      let picked :: Map SL.TxIn (SL.TxOut ShelleyEra)
          picked :: Map TxIn (TxOut ShelleyEra)
picked = (TxOut ShelleyEra -> Bool)
-> Map TxIn (TxOut ShelleyEra) -> Map TxIn (TxOut ShelleyEra)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter TxOut ShelleyEra -> Bool
ShelleyTxOut ShelleyEra -> Bool
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Era era, Val (Value era)) =>
ShelleyTxOut era -> Bool
pick (Map TxIn (TxOut ShelleyEra) -> Map TxIn (TxOut ShelleyEra))
-> Map TxIn (TxOut ShelleyEra) -> Map TxIn (TxOut ShelleyEra)
forall a b. (a -> b) -> a -> b
$ UTxO ShelleyEra -> Map TxIn (TxOut ShelleyEra)
forall era. UTxO era -> Map TxIn (TxOut era)
SL.unUTxO UTxO ShelleyEra
utxo
           where
            pick :: ShelleyTxOut era -> Bool
pick (SL.ShelleyTxOut Addr
addr Value era
_) =
              Addr
addr Addr -> Addr -> Bool
forall a. Eq a => a -> a -> Bool
== BootstrapAddress -> Addr
SL.AddrBootstrap (Address -> BootstrapAddress
SL.BootstrapAddress Address
byronAddr)

          -- Total held by 'byronAddr'
          pickedCoin :: SL.Coin
          pickedCoin :: Coin
pickedCoin = (ShelleyTxOut ShelleyEra -> Coin)
-> Map TxIn (ShelleyTxOut ShelleyEra) -> Coin
forall m a. Monoid m => (a -> m) -> Map TxIn a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(SL.ShelleyTxOut Addr
_ Value ShelleyEra
coin) -> Value ShelleyEra
Coin
coin) Map TxIn (TxOut ShelleyEra)
Map TxIn (ShelleyTxOut ShelleyEra)
picked

          -- NOTE: The Cardano ThreadNet tests use the
          -- ouroboros-consensus-shelley-test infra's genesis config, which sets
          -- relevant protocol params to 0.
          fee, deposits, spentCoin :: SL.Coin
          fee :: Coin
fee = Integer -> Coin
SL.Coin Integer
0
          deposits :: Coin
deposits = Integer -> Coin
SL.Coin Integer
0
          spentCoin :: Coin
spentCoin = Coin
deposits Coin -> Coin -> Coin
forall a. Semigroup a => a -> a -> a
<> Coin
fee

          unspentCoin :: SL.Coin
          unspentCoin :: Coin
unspentCoin =
            Bool -> Coin -> Coin
forall a. HasCallStack => Bool -> a -> a
assert (Coin
pickedCoin Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
> Coin
spentCoin) (Coin -> Coin) -> Coin -> Coin
forall a b. (a -> b) -> a -> b
$
              Coin
pickedCoin Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> Coin
spentCoin

          body :: SL.TxBody SL.TopTx ShelleyEra
          body :: TxBody TopTx ShelleyEra
body =
            TxBody TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l ShelleyEra
SL.mkBasicTxBody
              TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert ShelleyEra)
 -> Identity (StrictSeq (TxCert ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxCert ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxCert ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxCert ShelleyEra))
SL.certsTxBodyL
                ((StrictSeq (ShelleyTxCert ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxCert ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxCert ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ShelleyTxCert ShelleyEra] -> StrictSeq (ShelleyTxCert ShelleyEra)
forall a. [a] -> StrictSeq a
StrictSeq.fromList
                  [ Credential Staking -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential Staking -> TxCert era
SL.RegTxCert (Credential Staking -> TxCert ShelleyEra)
-> Credential Staking -> TxCert ShelleyEra
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> Credential Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
Shelley.mkCredential SignKeyDSIGN DSIGN
stakingSK
                  , StakePoolParams -> TxCert ShelleyEra
forall era. EraTxCert era => StakePoolParams -> TxCert era
SL.RegPoolTxCert (StakePoolParams -> TxCert ShelleyEra)
-> StakePoolParams -> TxCert ShelleyEra
forall a b. (a -> b) -> a -> b
$ Coin -> StakePoolParams
poolParams Coin
unspentCoin
                  , Credential Staking -> KeyHash StakePool -> TxCert ShelleyEra
forall era.
ShelleyEraTxCert era =>
Credential Staking -> KeyHash StakePool -> TxCert era
SL.DelegStakeTxCert
                      (SignKeyDSIGN DSIGN -> Credential Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
Shelley.mkCredential SignKeyDSIGN DSIGN
stakingSK)
                      (SignKeyDSIGN DSIGN -> KeyHash StakePool
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyHash r
Shelley.mkKeyHash SignKeyDSIGN DSIGN
poolSK)
                  ]
              TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ShelleyEra) (Set TxIn)
SL.inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map TxIn (ShelleyTxOut ShelleyEra) -> Set TxIn
forall k a. Map k a -> Set k
Map.keysSet Map TxIn (TxOut ShelleyEra)
Map TxIn (ShelleyTxOut ShelleyEra)
picked
              TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut ShelleyEra)
 -> Identity (StrictSeq (TxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxOut ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxOut ShelleyEra))
SL.outputsTxBodyL
                ((StrictSeq (ShelleyTxOut ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxOut ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyTxOut ShelleyEra -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. a -> StrictSeq a
StrictSeq.singleton (Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
SL.ShelleyTxOut Addr
shelleyAddr Value ShelleyEra
Coin
unspentCoin)
              TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (SlotNo -> Identity SlotNo)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody TopTx era) SlotNo
Lens' (TxBody TopTx ShelleyEra) SlotNo
SL.ttlTxBodyL ((SlotNo -> Identity SlotNo)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> SlotNo -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64 -> SlotNo
SlotNo Word64
forall a. Bounded a => a
maxBound
              TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx ShelleyEra) Coin
SL.feeTxBodyL ((Coin -> Identity Coin)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Coin -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee

          bodyHash :: SL.SafeHash SL.EraIndependentTxBody
          bodyHash :: SafeHash EraIndependentTxBody
bodyHash = TxBody TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
SL.hashAnnotated TxBody TopTx ShelleyEra
body

          -- Witness the use of bootstrap address's utxo.
          byronWit :: SL.BootstrapWitness
          byronWit :: BootstrapWitness
byronWit =
            Hash HASH EraIndependentTxBody
-> SigningKey -> Attributes AddrAttributes -> BootstrapWitness
SL.makeBootstrapWitness (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
SL.extractHash SafeHash EraIndependentTxBody
bodyHash) SigningKey
byronSK (Attributes AddrAttributes -> BootstrapWitness)
-> Attributes AddrAttributes -> BootstrapWitness
forall a b. (a -> b) -> a -> b
$
              Address -> Attributes AddrAttributes
Byron.addrAttributes Address
byronAddr

          -- Witness the stake delegation.
          delegWit :: SL.WitVKey SL.Witness
          delegWit :: WitVKey Witness
delegWit =
            SafeHash EraIndependentTxBody
-> KeyPair (ZonkAny 0) -> WitVKey Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey Witness
TL.mkWitnessVKey
              SafeHash EraIndependentTxBody
bodyHash
              (SignKeyDSIGN DSIGN -> KeyPair (ZonkAny 0)
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyPair r
Shelley.mkKeyPair SignKeyDSIGN DSIGN
stakingSK)

          -- Witness the pool registration.
          poolWit :: SL.WitVKey SL.Witness
          poolWit :: WitVKey Witness
poolWit =
            SafeHash EraIndependentTxBody
-> KeyPair (ZonkAny 1) -> WitVKey Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey Witness
TL.mkWitnessVKey
              SafeHash EraIndependentTxBody
bodyHash
              (SignKeyDSIGN DSIGN -> KeyPair (ZonkAny 1)
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyPair r
Shelley.mkKeyPair SignKeyDSIGN DSIGN
poolSK)
       in if Map TxIn (ShelleyTxOut ShelleyEra) -> Bool
forall k a. Map k a -> Bool
Map.null Map TxIn (TxOut ShelleyEra)
Map TxIn (ShelleyTxOut ShelleyEra)
picked
            then Maybe (GenTx (CardanoBlock c))
forall a. Maybe a
Nothing
            else
              (GenTx (CardanoBlock c) -> Maybe (GenTx (CardanoBlock c))
forall a. a -> Maybe a
Just (GenTx (CardanoBlock c) -> Maybe (GenTx (CardanoBlock c)))
-> (Tx TopTx ShelleyEra -> GenTx (CardanoBlock c))
-> Tx TopTx ShelleyEra
-> Maybe (GenTx (CardanoBlock c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (ShelleyBlock (TPraos c) ShelleyEra)
-> GenTx (CardanoBlock c)
forall c.
GenTx (ShelleyBlock (TPraos c) ShelleyEra) -> CardanoGenTx c
GenTxShelley (GenTx (ShelleyBlock (TPraos c) ShelleyEra)
 -> GenTx (CardanoBlock c))
-> (Tx TopTx ShelleyEra
    -> GenTx (ShelleyBlock (TPraos c) ShelleyEra))
-> Tx TopTx ShelleyEra
-> GenTx (CardanoBlock c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx TopTx ShelleyEra -> GenTx (ShelleyBlock (TPraos c) ShelleyEra)
forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx) (Tx TopTx ShelleyEra -> Maybe (GenTx (CardanoBlock c)))
-> Tx TopTx ShelleyEra -> Maybe (GenTx (CardanoBlock c))
forall a b. (a -> b) -> a -> b
$
                TxBody TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l ShelleyEra -> Tx l ShelleyEra
SL.mkBasicTx TxBody TopTx ShelleyEra
body
                  Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
(ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ShelleyEra) (TxWits ShelleyEra)
SL.witsTxL ((ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
    -> ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> Tx TopTx ShelleyEra
-> Identity (Tx TopTx ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (TxWits ShelleyEra)
(Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits ShelleyEra) (Set (WitVKey Witness))
SL.addrTxWitsL ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> Set (WitVKey Witness)
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WitVKey Witness] -> Set (WitVKey Witness)
forall a. Ord a => [a] -> Set a
Set.fromList [WitVKey Witness
delegWit, WitVKey Witness
poolWit]
                  Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
(ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ShelleyEra) (TxWits ShelleyEra)
SL.witsTxL ((ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
    -> ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> Tx TopTx ShelleyEra
-> Identity (Tx TopTx ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> TxWits ShelleyEra -> Identity (TxWits ShelleyEra)
(Set BootstrapWitness -> Identity (Set BootstrapWitness))
-> ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set BootstrapWitness)
Lens' (TxWits ShelleyEra) (Set BootstrapWitness)
SL.bootAddrTxWitsL ((Set BootstrapWitness -> Identity (Set BootstrapWitness))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> Set BootstrapWitness
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BootstrapWitness -> Set BootstrapWitness
forall a. a -> Set a
Set.singleton BootstrapWitness
byronWit
  | Bool
otherwise = Maybe (GenTx (CardanoBlock c))
forall a. Maybe a
Nothing
 where
  mbUTxO :: Maybe (SL.UTxO ShelleyEra)
  mbUTxO :: Maybe (UTxO ShelleyEra)
mbUTxO =
    (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) ValuesMK
 -> UTxO ShelleyEra)
-> Maybe
     (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) ValuesMK)
-> Maybe (UTxO ShelleyEra)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) ValuesMK
-> UTxO ShelleyEra
forall proto era (mk :: MapKind).
TickedLedgerState (ShelleyBlock proto era) mk -> UTxO era
getUTxOShelley
      (Maybe
   (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) ValuesMK)
 -> Maybe (UTxO ShelleyEra))
-> (LedgerState (CardanoBlock c) ValuesMK
    -> Maybe
         (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) ValuesMK))
-> LedgerState (CardanoBlock c) ValuesMK
-> Maybe (UTxO ShelleyEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TickedLedgerState (CardanoBlock c) ValuesMK
-> Maybe
     (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) ValuesMK)
forall c (mk :: MapKind).
TickedLedgerState (CardanoBlock c) mk
-> Maybe
     (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk)
ejectShelleyTickedLedgerState
      (TickedLedgerState (CardanoBlock c) ValuesMK
 -> Maybe
      (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) ValuesMK))
-> (LedgerState (CardanoBlock c) ValuesMK
    -> TickedLedgerState (CardanoBlock c) ValuesMK)
-> LedgerState (CardanoBlock c) ValuesMK
-> Maybe
     (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) ValuesMK)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (CardanoBlock c) ValuesMK
-> Ticked (LedgerState (CardanoBlock c)) DiffMK
-> TickedLedgerState (CardanoBlock c) ValuesMK
forall (l :: MapKind -> *) (l' :: MapKind -> *).
(SameUtxoTypes l l', HasLedgerTables l, HasLedgerTables l') =>
l ValuesMK -> l' DiffMK -> l' ValuesMK
applyDiffs LedgerState (CardanoBlock c) ValuesMK
lst
      (Ticked (LedgerState (CardanoBlock c)) DiffMK
 -> TickedLedgerState (CardanoBlock c) ValuesMK)
-> (LedgerState (CardanoBlock c) ValuesMK
    -> Ticked (LedgerState (CardanoBlock c)) DiffMK)
-> LedgerState (CardanoBlock c) ValuesMK
-> TickedLedgerState (CardanoBlock c) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ComputeLedgerEvents
-> LedgerConfig (CardanoBlock c)
-> SlotNo
-> LedgerState (CardanoBlock c) EmptyMK
-> Ticked (LedgerState (CardanoBlock c)) DiffMK
forall (l :: MapKind -> *).
IsLedger l =>
ComputeLedgerEvents
-> LedgerCfg l -> SlotNo -> l EmptyMK -> Ticked l DiffMK
applyChainTick ComputeLedgerEvents
OmitLedgerEvents LedgerConfig (CardanoBlock c)
lcfg SlotNo
curSlot
      (LedgerState (CardanoBlock c) EmptyMK
 -> Ticked (LedgerState (CardanoBlock c)) DiffMK)
-> (LedgerState (CardanoBlock c) ValuesMK
    -> LedgerState (CardanoBlock c) EmptyMK)
-> LedgerState (CardanoBlock c) ValuesMK
-> Ticked (LedgerState (CardanoBlock c)) DiffMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (CardanoBlock c) ValuesMK
-> LedgerState (CardanoBlock c) EmptyMK
forall (l :: MapKind -> *) (mk :: MapKind).
HasLedgerTables l =>
l mk -> l EmptyMK
forgetLedgerTables
      (LedgerState (CardanoBlock c) ValuesMK -> Maybe (UTxO ShelleyEra))
-> LedgerState (CardanoBlock c) ValuesMK -> Maybe (UTxO ShelleyEra)
forall a b. (a -> b) -> a -> b
$ LedgerState (CardanoBlock c) ValuesMK
lst

  MigrationInfo
    { NetworkMagic
byronMagic :: forall c. MigrationInfo c -> NetworkMagic
byronMagic :: NetworkMagic
byronMagic
    , SigningKey
byronSK :: forall c. MigrationInfo c -> SigningKey
byronSK :: SigningKey
byronSK
    , SignKeyDSIGN DSIGN
paymentSK :: forall c. MigrationInfo c -> SignKeyDSIGN DSIGN
paymentSK :: SignKeyDSIGN DSIGN
paymentSK
    , SignKeyDSIGN DSIGN
poolSK :: forall c. MigrationInfo c -> SignKeyDSIGN DSIGN
poolSK :: SignKeyDSIGN DSIGN
poolSK
    , SignKeyDSIGN DSIGN
stakingSK :: forall c. MigrationInfo c -> SignKeyDSIGN DSIGN
stakingSK :: SignKeyDSIGN DSIGN
stakingSK
    , SignKeyVRF (VRF c)
vrfSK :: forall c. MigrationInfo c -> SignKeyVRF (VRF c)
vrfSK :: SignKeyVRF (VRF c)
vrfSK
    } = MigrationInfo c
migrationInfo

  byronAddr :: Byron.Address
  byronAddr :: Address
byronAddr =
    NetworkMagic -> VerificationKey -> Address
Byron.makeVerKeyAddress NetworkMagic
byronMagic (VerificationKey -> Address) -> VerificationKey -> Address
forall a b. (a -> b) -> a -> b
$ SigningKey -> VerificationKey
toVerification SigningKey
byronSK

  -- We use a base reference for the stake so that we can refer to it in the
  -- same tx that registers it.
  shelleyAddr :: SL.Addr
  shelleyAddr :: Addr
shelleyAddr =
    Network -> Credential Payment -> StakeReference -> Addr
SL.Addr
      Network
Shelley.networkId
      (SignKeyDSIGN DSIGN -> Credential Payment
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
Shelley.mkCredential SignKeyDSIGN DSIGN
paymentSK)
      (Credential Staking -> StakeReference
SL.StakeRefBase (Credential Staking -> StakeReference)
-> Credential Staking -> StakeReference
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> Credential Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
Shelley.mkCredential SignKeyDSIGN DSIGN
stakingSK)

  -- A simplistic individual pool
  poolParams :: SL.Coin -> SL.StakePoolParams
  poolParams :: Coin -> StakePoolParams
poolParams Coin
pledge =
    SL.StakePoolParams
      { sppCost :: Coin
SL.sppCost = Integer -> Coin
SL.Coin Integer
1
      , sppMetadata :: StrictMaybe PoolMetadata
SL.sppMetadata = StrictMaybe PoolMetadata
forall a. StrictMaybe a
SL.SNothing
      , sppMargin :: UnitInterval
SL.sppMargin = UnitInterval
forall a. Bounded a => a
minBound
      , sppOwners :: Set (KeyHash Staking)
SL.sppOwners = KeyHash Staking -> Set (KeyHash Staking)
forall a. a -> Set a
Set.singleton (KeyHash Staking -> Set (KeyHash Staking))
-> KeyHash Staking -> Set (KeyHash Staking)
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> KeyHash Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyHash r
Shelley.mkKeyHash SignKeyDSIGN DSIGN
poolSK
      , sppPledge :: Coin
SL.sppPledge = Coin
pledge
      , sppId :: KeyHash StakePool
SL.sppId = SignKeyDSIGN DSIGN -> KeyHash StakePool
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyHash r
Shelley.mkKeyHash SignKeyDSIGN DSIGN
poolSK
      , sppAccountAddress :: AccountAddress
SL.sppAccountAddress =
          Network -> AccountId -> AccountAddress
SL.AccountAddress Network
Shelley.networkId (AccountId -> AccountAddress) -> AccountId -> AccountAddress
forall a b. (a -> b) -> a -> b
$ Credential Staking -> AccountId
SL.AccountId (SignKeyDSIGN DSIGN -> Credential Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
Shelley.mkCredential SignKeyDSIGN DSIGN
poolSK)
      , sppRelays :: StrictSeq StakePoolRelay
SL.sppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
StrictSeq.empty
      , sppVrf :: VRFVerKeyHash StakePoolVRF
SL.sppVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
SignKeyVRF (VRF c) -> VRFVerKeyHash r
Shelley.mkKeyHashVrf @c SignKeyVRF (VRF c)
vrfSK
      }

-----

ejectShelleyNS ::
  NS f (CardanoEras c) ->
  Maybe (f (ShelleyBlock (TPraos c) ShelleyEra))
ejectShelleyNS :: forall (f :: * -> *) c.
NS f (CardanoEras c)
-> Maybe (f (ShelleyBlock (TPraos c) ShelleyEra))
ejectShelleyNS = \case
  S (Z f x
x) -> f (ShelleyBlock (TPraos c) ShelleyEra)
-> Maybe (f (ShelleyBlock (TPraos c) ShelleyEra))
forall a. a -> Maybe a
Just f x
f (ShelleyBlock (TPraos c) ShelleyEra)
x
  NS f (CardanoEras c)
_ -> Maybe (f (ShelleyBlock (TPraos c) ShelleyEra))
forall a. Maybe a
Nothing

getUTxOShelley ::
  TickedLedgerState (ShelleyBlock proto era) mk ->
  SL.UTxO era
getUTxOShelley :: forall proto era (mk :: MapKind).
TickedLedgerState (ShelleyBlock proto era) mk -> UTxO era
getUTxOShelley TickedLedgerState (ShelleyBlock proto era) mk
tls =
  UTxOState era -> UTxO era
forall era. UTxOState era -> UTxO era
SL.utxosUtxo (UTxOState era -> UTxO era) -> UTxOState era -> UTxO era
forall a b. (a -> b) -> a -> b
$
    LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
SL.lsUTxOState (LedgerState era -> UTxOState era)
-> LedgerState era -> UTxOState era
forall a b. (a -> b) -> a -> b
$
      EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
SL.esLState (EpochState era -> LedgerState era)
-> EpochState era -> LedgerState era
forall a b. (a -> b) -> a -> b
$
        NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
SL.nesEs (NewEpochState era -> EpochState era)
-> NewEpochState era -> EpochState era
forall a b. (a -> b) -> a -> b
$
          TickedLedgerState (ShelleyBlock proto era) mk -> NewEpochState era
forall proto era (mk :: MapKind).
Ticked (LedgerState (ShelleyBlock proto era)) mk
-> NewEpochState era
tickedShelleyLedgerState TickedLedgerState (ShelleyBlock proto era) mk
tls

ejectShelleyTickedLedgerState ::
  TickedLedgerState (CardanoBlock c) mk ->
  Maybe (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk)
ejectShelleyTickedLedgerState :: forall c (mk :: MapKind).
TickedLedgerState (CardanoBlock c) mk
-> Maybe
     (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk)
ejectShelleyTickedLedgerState TickedLedgerState (CardanoBlock c) mk
ls =
  (Current
   (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra)
 -> TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk)
-> Maybe
     (Current
        (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra))
-> Maybe
     (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FlipTickedLedgerState mk (ShelleyBlock (TPraos c) ShelleyEra)
-> TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk
forall (mk :: MapKind) blk.
FlipTickedLedgerState mk blk -> Ticked (LedgerState blk) mk
getFlipTickedLedgerState (FlipTickedLedgerState mk (ShelleyBlock (TPraos c) ShelleyEra)
 -> TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk)
-> (Current
      (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra)
    -> FlipTickedLedgerState mk (ShelleyBlock (TPraos c) ShelleyEra))
-> Current
     (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra)
-> TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
  (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra)
-> FlipTickedLedgerState mk (ShelleyBlock (TPraos c) ShelleyEra)
forall (f :: * -> *) blk. Current f blk -> f blk
currentState) (Maybe
   (Current
      (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra))
 -> Maybe
      (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk))
-> Maybe
     (Current
        (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra))
-> Maybe
     (TickedLedgerState (ShelleyBlock (TPraos c) ShelleyEra) mk)
forall a b. (a -> b) -> a -> b
$
    NS (Current (FlipTickedLedgerState mk)) (CardanoEras c)
-> Maybe
     (Current
        (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra))
forall (f :: * -> *) c.
NS f (CardanoEras c)
-> Maybe (f (ShelleyBlock (TPraos c) ShelleyEra))
ejectShelleyNS (NS (Current (FlipTickedLedgerState mk)) (CardanoEras c)
 -> Maybe
      (Current
         (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra)))
-> NS (Current (FlipTickedLedgerState mk)) (CardanoEras c)
-> Maybe
     (Current
        (FlipTickedLedgerState mk) (ShelleyBlock (TPraos c) ShelleyEra))
forall a b. (a -> b) -> a -> b
$
      Telescope
  (K Past) (Current (FlipTickedLedgerState mk)) (CardanoEras c)
-> NS (Current (FlipTickedLedgerState mk)) (CardanoEras c)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Tele.tip (Telescope
   (K Past) (Current (FlipTickedLedgerState mk)) (CardanoEras c)
 -> NS (Current (FlipTickedLedgerState mk)) (CardanoEras c))
-> Telescope
     (K Past) (Current (FlipTickedLedgerState mk)) (CardanoEras c)
-> NS (Current (FlipTickedLedgerState mk)) (CardanoEras c)
forall a b. (a -> b) -> a -> b
$
        HardForkState (FlipTickedLedgerState mk) (CardanoEras c)
-> Telescope
     (K Past) (Current (FlipTickedLedgerState mk)) (CardanoEras c)
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState (HardForkState (FlipTickedLedgerState mk) (CardanoEras c)
 -> Telescope
      (K Past) (Current (FlipTickedLedgerState mk)) (CardanoEras c))
-> HardForkState (FlipTickedLedgerState mk) (CardanoEras c)
-> Telescope
     (K Past) (Current (FlipTickedLedgerState mk)) (CardanoEras c)
forall a b. (a -> b) -> a -> b
$
          TickedLedgerState (CardanoBlock c) mk
-> HardForkState (FlipTickedLedgerState mk) (CardanoEras c)
forall (xs :: [*]) (mk :: MapKind).
Ticked (LedgerState (HardForkBlock xs)) mk
-> HardForkState (FlipTickedLedgerState mk) xs
tickedHardForkLedgerStatePerEra (TickedLedgerState (CardanoBlock c) mk
 -> HardForkState (FlipTickedLedgerState mk) (CardanoEras c))
-> TickedLedgerState (CardanoBlock c) mk
-> HardForkState (FlipTickedLedgerState mk) (CardanoEras c)
forall a b. (a -> b) -> a -> b
$
            TickedLedgerState (CardanoBlock c) mk
ls