{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# 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.Signing as Byron
import qualified Cardano.Ledger.Address as SL (BootstrapAddress (..))
import qualified Cardano.Ledger.Hashes as SL
import qualified Cardano.Ledger.Keys.Bootstrap as SL (makeBootstrapWitness)
import qualified Cardano.Ledger.SafeHash as SL
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.Core as SL
import Cardano.Ledger.Val ((<->))
import Control.Exception (assert)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (maybeToList)
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Data.SOP.BasicFunctors
import Data.SOP.Strict
import Data.SOP.Telescope as Tele
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
(tickedHardForkLedgerStatePerEra)
import Ouroboros.Consensus.HardFork.Combinator.State.Types
(currentState, getHardForkState)
import Ouroboros.Consensus.Ledger.Basics (LedgerConfig, LedgerState,
applyChainTick)
import Ouroboros.Consensus.NodeId (CoreNodeId (..))
import Ouroboros.Consensus.Protocol.TPraos (TPraos)
import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, mkShelleyTx)
import Ouroboros.Consensus.Shelley.Ledger.Ledger (Ticked,
tickedShelleyLedgerState)
import qualified Test.Cardano.Ledger.Core.KeyPair as TL (mkWitnessVKey)
import qualified Test.ThreadNet.Infra.Shelley as Shelley
import Test.ThreadNet.TxGen
data c =
{ 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 (CardanoBlock c) = CardanoTxGenExtra c
testGenTxs :: CoreNodeId
-> NumCoreNodes
-> SlotNo
-> TopLevelConfig (CardanoBlock c)
-> TxGenExtra (CardanoBlock c)
-> LedgerState (CardanoBlock c)
-> Gen [GenTx (CardanoBlock c)]
testGenTxs (CoreNodeId Word64
i) NumCoreNodes
_ncn SlotNo
curSlot TopLevelConfig (CardanoBlock c)
cfg TxGenExtra (CardanoBlock c)
extra LedgerState (CardanoBlock c)
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)
-> Maybe (GenTx (CardanoBlock c))
forall c.
CardanoHardForkConstraints c =>
MigrationInfo c
-> SlotNo
-> LedgerConfig (CardanoBlock c)
-> LedgerState (CardanoBlock c)
-> Maybe (GenTx (CardanoBlock c))
migrateUTxO MigrationInfo c
migrationInfo SlotNo
curSlot LedgerConfig (CardanoBlock c)
lcfg LedgerState (CardanoBlock c)
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 c
paymentSK :: SignKeyDSIGN c
paymentSK :: SignKeyDSIGN c
paymentSK
, SignKeyDSIGN c
poolSK :: SignKeyDSIGN c
poolSK :: SignKeyDSIGN c
poolSK
, SignKeyDSIGN c
stakingSK :: SignKeyDSIGN c
stakingSK :: SignKeyDSIGN c
stakingSK
, SignKeyVRF c
vrfSK :: SignKeyVRF c
vrfSK :: SignKeyVRF 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 c
Shelley.cnDelegateKey = SignKeyDSIGN c
paymentSK
, cnStakingKey :: forall c. CoreNode c -> SignKeyDSIGN c
Shelley.cnStakingKey = SignKeyDSIGN c
stakingSK
, cnVRF :: forall c. CoreNode c -> SignKeyVRF c
Shelley.cnVRF = SignKeyVRF 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
poolSK :: SL.SignKeyDSIGN c
poolSK :: SignKeyDSIGN c
poolSK = SignKeyDSIGN c
paymentSK
data MigrationInfo c = MigrationInfo
{ forall c. MigrationInfo c -> NetworkMagic
byronMagic :: Byron.NetworkMagic
, forall c. MigrationInfo c -> SigningKey
byronSK :: Byron.SigningKey
, forall c. MigrationInfo c -> SignKeyDSIGN c
paymentSK :: SL.SignKeyDSIGN c
, forall c. MigrationInfo c -> SignKeyDSIGN c
poolSK :: SL.SignKeyDSIGN c
, forall c. MigrationInfo c -> SignKeyDSIGN c
stakingSK :: SL.SignKeyDSIGN c
, forall c. MigrationInfo c -> SignKeyVRF c
vrfSK :: SL.SignKeyVRF c
}
migrateUTxO ::
forall c. CardanoHardForkConstraints c
=> MigrationInfo c
-> SlotNo
-> LedgerConfig (CardanoBlock c)
-> LedgerState (CardanoBlock c)
-> Maybe (GenTx (CardanoBlock c))
migrateUTxO :: forall c.
CardanoHardForkConstraints c =>
MigrationInfo c
-> SlotNo
-> LedgerConfig (CardanoBlock c)
-> LedgerState (CardanoBlock c)
-> Maybe (GenTx (CardanoBlock c))
migrateUTxO MigrationInfo c
migrationInfo SlotNo
curSlot LedgerConfig (CardanoBlock c)
lcfg LedgerState (CardanoBlock c)
lst
| Just UTxO (ShelleyEra c)
utxo <- Maybe (UTxO (ShelleyEra c))
mbUTxO =
let picked :: Map (SL.TxIn c) (SL.TxOut (ShelleyEra c))
picked :: Map (TxIn c) (TxOut (ShelleyEra c))
picked = (TxOut (ShelleyEra c) -> Bool)
-> Map (TxIn c) (TxOut (ShelleyEra c))
-> Map (TxIn c) (TxOut (ShelleyEra c))
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter TxOut (ShelleyEra c) -> Bool
ShelleyTxOut (ShelleyEra c) -> 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 c) (TxOut (ShelleyEra c))
-> Map (TxIn c) (TxOut (ShelleyEra c)))
-> Map (TxIn c) (TxOut (ShelleyEra c))
-> Map (TxIn c) (TxOut (ShelleyEra c))
forall a b. (a -> b) -> a -> b
$ UTxO (ShelleyEra c)
-> Map (TxIn (EraCrypto (ShelleyEra c))) (TxOut (ShelleyEra c))
forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
SL.unUTxO UTxO (ShelleyEra c)
utxo
where
pick :: ShelleyTxOut era -> Bool
pick (SL.ShelleyTxOut Addr (EraCrypto era)
addr Value era
_) =
Addr (EraCrypto era)
addr Addr (EraCrypto era) -> Addr (EraCrypto era) -> Bool
forall a. Eq a => a -> a -> Bool
== BootstrapAddress (EraCrypto era) -> Addr (EraCrypto era)
forall c. BootstrapAddress c -> Addr c
SL.AddrBootstrap (Address -> BootstrapAddress (EraCrypto era)
forall c. Address -> BootstrapAddress c
SL.BootstrapAddress Address
byronAddr)
pickedCoin :: SL.Coin
pickedCoin :: Coin
pickedCoin = (ShelleyTxOut (ShelleyEra c) -> Coin)
-> Map (TxIn c) (ShelleyTxOut (ShelleyEra c)) -> Coin
forall m a. Monoid m => (a -> m) -> Map (TxIn c) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(SL.ShelleyTxOut Addr (EraCrypto (ShelleyEra c))
_ Value (ShelleyEra c)
coin) -> Value (ShelleyEra c)
Coin
coin) Map (TxIn c) (TxOut (ShelleyEra c))
Map (TxIn c) (ShelleyTxOut (ShelleyEra c))
picked
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 (ShelleyEra c)
body :: TxBody (ShelleyEra c)
body = TxBody (ShelleyEra c)
forall era. EraTxBody era => TxBody era
SL.mkBasicTxBody
TxBody (ShelleyEra c)
-> (TxBody (ShelleyEra c) -> TxBody (ShelleyEra c))
-> TxBody (ShelleyEra c)
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxCert (ShelleyEra c))
-> Identity (StrictSeq (TxCert (ShelleyEra c))))
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody (ShelleyEra c)) (StrictSeq (TxCert (ShelleyEra c)))
SL.certsTxBodyL ((StrictSeq (TxCert (ShelleyEra c))
-> Identity (StrictSeq (TxCert (ShelleyEra c))))
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c)))
-> StrictSeq (TxCert (ShelleyEra c))
-> TxBody (ShelleyEra c)
-> TxBody (ShelleyEra c)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxCert (ShelleyEra c)] -> StrictSeq (TxCert (ShelleyEra c))
forall a. [a] -> StrictSeq a
StrictSeq.fromList
[ StakeCredential (EraCrypto (ShelleyEra c)) -> TxCert (ShelleyEra c)
forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
SL.RegTxCert (StakeCredential (EraCrypto (ShelleyEra c))
-> TxCert (ShelleyEra c))
-> StakeCredential (EraCrypto (ShelleyEra c))
-> TxCert (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN (EraCrypto (ShelleyEra c))
-> StakeCredential (EraCrypto (ShelleyEra c))
forall c (r :: KeyRole).
Crypto c =>
SignKeyDSIGN c -> Credential r c
Shelley.mkCredential SignKeyDSIGN c
SignKeyDSIGN (EraCrypto (ShelleyEra c))
stakingSK
, PoolParams (EraCrypto (ShelleyEra c)) -> TxCert (ShelleyEra c)
forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
SL.RegPoolTxCert (PoolParams (EraCrypto (ShelleyEra c)) -> TxCert (ShelleyEra c))
-> PoolParams (EraCrypto (ShelleyEra c)) -> TxCert (ShelleyEra c)
forall a b. (a -> b) -> a -> b
$ Coin -> PoolParams c
poolParams Coin
unspentCoin
, StakeCredential (EraCrypto (ShelleyEra c))
-> KeyHash 'StakePool (EraCrypto (ShelleyEra c))
-> TxCert (ShelleyEra c)
forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era)
-> KeyHash 'StakePool (EraCrypto era) -> TxCert era
SL.DelegStakeTxCert
(SignKeyDSIGN c -> Credential 'Staking c
forall c (r :: KeyRole).
Crypto c =>
SignKeyDSIGN c -> Credential r c
Shelley.mkCredential SignKeyDSIGN c
stakingSK) (SignKeyDSIGN c -> KeyHash 'StakePool c
forall c (r :: KeyRole). Crypto c => SignKeyDSIGN c -> KeyHash r c
Shelley.mkKeyHash SignKeyDSIGN c
poolSK)
]
TxBody (ShelleyEra c)
-> (TxBody (ShelleyEra c) -> TxBody (ShelleyEra c))
-> TxBody (ShelleyEra c)
forall a b. a -> (a -> b) -> b
& (Set (TxIn (EraCrypto (ShelleyEra c))) -> Identity (Set (TxIn c)))
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c))
(Set (TxIn (EraCrypto (ShelleyEra c)))
-> Identity (Set (TxIn (EraCrypto (ShelleyEra c)))))
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
(TxBody (ShelleyEra c)) (Set (TxIn (EraCrypto (ShelleyEra c))))
SL.inputsTxBodyL ((Set (TxIn (EraCrypto (ShelleyEra c))) -> Identity (Set (TxIn c)))
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c)))
-> Set (TxIn c) -> TxBody (ShelleyEra c) -> TxBody (ShelleyEra c)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (TxIn c) (ShelleyTxOut (ShelleyEra c)) -> Set (TxIn c)
forall k a. Map k a -> Set k
Map.keysSet Map (TxIn c) (TxOut (ShelleyEra c))
Map (TxIn c) (ShelleyTxOut (ShelleyEra c))
picked
TxBody (ShelleyEra c)
-> (TxBody (ShelleyEra c) -> TxBody (ShelleyEra c))
-> TxBody (ShelleyEra c)
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut (ShelleyEra c))
-> Identity (StrictSeq (TxOut (ShelleyEra c))))
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c))
(StrictSeq (TxOut (ShelleyEra c))
-> Identity (StrictSeq (ShelleyTxOut (ShelleyEra c))))
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody (ShelleyEra c)) (StrictSeq (TxOut (ShelleyEra c)))
SL.outputsTxBodyL ((StrictSeq (TxOut (ShelleyEra c))
-> Identity (StrictSeq (ShelleyTxOut (ShelleyEra c))))
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c)))
-> StrictSeq (ShelleyTxOut (ShelleyEra c))
-> TxBody (ShelleyEra c)
-> TxBody (ShelleyEra c)
forall s t a b. ASetter s t a b -> b -> s -> t
.~
ShelleyTxOut (ShelleyEra c)
-> StrictSeq (ShelleyTxOut (ShelleyEra c))
forall a. a -> StrictSeq a
StrictSeq.singleton (Addr (EraCrypto (ShelleyEra c))
-> Value (ShelleyEra c) -> ShelleyTxOut (ShelleyEra c)
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
SL.ShelleyTxOut Addr c
Addr (EraCrypto (ShelleyEra c))
shelleyAddr Value (ShelleyEra c)
Coin
unspentCoin)
TxBody (ShelleyEra c)
-> (TxBody (ShelleyEra c) -> TxBody (ShelleyEra c))
-> TxBody (ShelleyEra c)
forall a b. a -> (a -> b) -> b
& (SlotNo -> Identity SlotNo)
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c))
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody era) SlotNo
Lens' (TxBody (ShelleyEra c)) SlotNo
SL.ttlTxBodyL ((SlotNo -> Identity SlotNo)
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c)))
-> SlotNo -> TxBody (ShelleyEra c) -> TxBody (ShelleyEra c)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word64 -> SlotNo
SlotNo Word64
forall a. Bounded a => a
maxBound
TxBody (ShelleyEra c)
-> (TxBody (ShelleyEra c) -> ShelleyTxBody (ShelleyEra c))
-> ShelleyTxBody (ShelleyEra c)
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> TxBody (ShelleyEra c) -> Identity (TxBody (ShelleyEra c))
(Coin -> Identity Coin)
-> TxBody (ShelleyEra c) -> Identity (ShelleyTxBody (ShelleyEra c))
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody (ShelleyEra c)) Coin
SL.feeTxBodyL ((Coin -> Identity Coin)
-> TxBody (ShelleyEra c)
-> Identity (ShelleyTxBody (ShelleyEra c)))
-> Coin -> TxBody (ShelleyEra c) -> ShelleyTxBody (ShelleyEra c)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
fee
bodyHash :: SL.SafeHash c SL.EraIndependentTxBody
bodyHash :: SafeHash c EraIndependentTxBody
bodyHash = ShelleyTxBody (ShelleyEra c) -> SafeHash c EraIndependentTxBody
forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
SL.hashAnnotated TxBody (ShelleyEra c)
ShelleyTxBody (ShelleyEra c)
body
byronWit :: SL.BootstrapWitness c
byronWit :: BootstrapWitness c
byronWit =
Hash (HASH c) EraIndependentTxBody
-> SigningKey -> Attributes AddrAttributes -> BootstrapWitness c
forall c.
(DSIGN c ~ Ed25519DSIGN, Crypto c) =>
Hash c EraIndependentTxBody
-> SigningKey -> Attributes AddrAttributes -> BootstrapWitness c
SL.makeBootstrapWitness (SafeHash c EraIndependentTxBody
-> Hash (HASH c) EraIndependentTxBody
forall c i. SafeHash c i -> Hash (HASH c) i
SL.extractHash SafeHash c EraIndependentTxBody
bodyHash) SigningKey
byronSK (Attributes AddrAttributes -> BootstrapWitness c)
-> Attributes AddrAttributes -> BootstrapWitness c
forall a b. (a -> b) -> a -> b
$
Address -> Attributes AddrAttributes
Byron.addrAttributes Address
byronAddr
delegWit :: SL.WitVKey 'SL.Witness c
delegWit :: WitVKey 'Witness c
delegWit =
SafeHash c EraIndependentTxBody
-> KeyPair Any c -> WitVKey 'Witness c
forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
TL.mkWitnessVKey
SafeHash c EraIndependentTxBody
bodyHash
(SignKeyDSIGN c -> KeyPair Any c
forall c (r :: KeyRole). Crypto c => SignKeyDSIGN c -> KeyPair r c
Shelley.mkKeyPair SignKeyDSIGN c
stakingSK)
poolWit :: SL.WitVKey 'SL.Witness c
poolWit :: WitVKey 'Witness c
poolWit =
SafeHash c EraIndependentTxBody
-> KeyPair Any c -> WitVKey 'Witness c
forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
TL.mkWitnessVKey
SafeHash c EraIndependentTxBody
bodyHash
(SignKeyDSIGN c -> KeyPair Any c
forall c (r :: KeyRole). Crypto c => SignKeyDSIGN c -> KeyPair r c
Shelley.mkKeyPair SignKeyDSIGN c
poolSK)
in
if Map (TxIn c) (ShelleyTxOut (ShelleyEra c)) -> Bool
forall k a. Map k a -> Bool
Map.null Map (TxIn c) (TxOut (ShelleyEra c))
Map (TxIn c) (ShelleyTxOut (ShelleyEra c))
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)))
-> (ShelleyTx (ShelleyEra c) -> GenTx (CardanoBlock c))
-> ShelleyTx (ShelleyEra c)
-> Maybe (GenTx (CardanoBlock c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenTx (ShelleyBlock (TPraos c) (ShelleyEra c))
-> GenTx (CardanoBlock c)
forall c.
GenTx (ShelleyBlock (TPraos c) (ShelleyEra c)) -> CardanoGenTx c
GenTxShelley(GenTx (ShelleyBlock (TPraos c) (ShelleyEra c))
-> GenTx (CardanoBlock c))
-> (ShelleyTx (ShelleyEra c)
-> GenTx (ShelleyBlock (TPraos c) (ShelleyEra c)))
-> ShelleyTx (ShelleyEra c)
-> GenTx (CardanoBlock c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx (ShelleyEra c) -> GenTx (ShelleyBlock (TPraos c) (ShelleyEra c))
ShelleyTx (ShelleyEra c)
-> GenTx (ShelleyBlock (TPraos c) (ShelleyEra c))
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx) (ShelleyTx (ShelleyEra c) -> Maybe (GenTx (CardanoBlock c)))
-> ShelleyTx (ShelleyEra c) -> Maybe (GenTx (CardanoBlock c))
forall a b. (a -> b) -> a -> b
$
SL.ShelleyTx
{ body :: TxBody (ShelleyEra c)
SL.body = TxBody (ShelleyEra c)
body
, auxiliaryData :: StrictMaybe (TxAuxData (ShelleyEra c))
SL.auxiliaryData = StrictMaybe (TxAuxData (ShelleyEra c))
StrictMaybe (ShelleyTxAuxData (ShelleyEra c))
forall a. StrictMaybe a
SL.SNothing
, wits :: TxWits (ShelleyEra c)
SL.wits = TxWits (ShelleyEra c)
forall era. EraTxWits era => TxWits era
SL.mkBasicTxWits
TxWits (ShelleyEra c)
-> (TxWits (ShelleyEra c) -> TxWits (ShelleyEra c))
-> TxWits (ShelleyEra c)
forall a b. a -> (a -> b) -> b
& (Set (WitVKey 'Witness (EraCrypto (ShelleyEra c)))
-> Identity (Set (WitVKey 'Witness c)))
-> TxWits (ShelleyEra c) -> Identity (TxWits (ShelleyEra c))
(Set (WitVKey 'Witness (EraCrypto (ShelleyEra c)))
-> Identity (Set (WitVKey 'Witness (EraCrypto (ShelleyEra c)))))
-> TxWits (ShelleyEra c) -> Identity (TxWits (ShelleyEra c))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness (EraCrypto era)))
Lens'
(TxWits (ShelleyEra c))
(Set (WitVKey 'Witness (EraCrypto (ShelleyEra c))))
SL.addrTxWitsL ((Set (WitVKey 'Witness (EraCrypto (ShelleyEra c)))
-> Identity (Set (WitVKey 'Witness c)))
-> TxWits (ShelleyEra c) -> Identity (TxWits (ShelleyEra c)))
-> Set (WitVKey 'Witness c)
-> TxWits (ShelleyEra c)
-> TxWits (ShelleyEra c)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [WitVKey 'Witness c] -> Set (WitVKey 'Witness c)
forall a. Ord a => [a] -> Set a
Set.fromList [WitVKey 'Witness c
delegWit, WitVKey 'Witness c
poolWit]
TxWits (ShelleyEra c)
-> (TxWits (ShelleyEra c) -> ShelleyTxWits (ShelleyEra c))
-> ShelleyTxWits (ShelleyEra c)
forall a b. a -> (a -> b) -> b
& (Set (BootstrapWitness (EraCrypto (ShelleyEra c)))
-> Identity (Set (BootstrapWitness c)))
-> TxWits (ShelleyEra c) -> Identity (ShelleyTxWits (ShelleyEra c))
(Set (BootstrapWitness (EraCrypto (ShelleyEra c)))
-> Identity (Set (BootstrapWitness (EraCrypto (ShelleyEra c)))))
-> TxWits (ShelleyEra c) -> Identity (TxWits (ShelleyEra c))
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (BootstrapWitness (EraCrypto era)))
Lens'
(TxWits (ShelleyEra c))
(Set (BootstrapWitness (EraCrypto (ShelleyEra c))))
SL.bootAddrTxWitsL ((Set (BootstrapWitness (EraCrypto (ShelleyEra c)))
-> Identity (Set (BootstrapWitness c)))
-> TxWits (ShelleyEra c)
-> Identity (ShelleyTxWits (ShelleyEra c)))
-> Set (BootstrapWitness c)
-> TxWits (ShelleyEra c)
-> ShelleyTxWits (ShelleyEra c)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ BootstrapWitness c -> Set (BootstrapWitness c)
forall a. a -> Set a
Set.singleton BootstrapWitness c
byronWit
}
| Bool
otherwise = Maybe (GenTx (CardanoBlock c))
forall a. Maybe a
Nothing
where
mbUTxO :: Maybe (SL.UTxO (ShelleyEra c))
mbUTxO :: Maybe (UTxO (ShelleyEra c))
mbUTxO =
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)))
-> UTxO (ShelleyEra c))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
-> Maybe (UTxO (ShelleyEra c))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)))
-> UTxO (ShelleyEra c)
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> UTxO era
getUTxOShelley (Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
-> Maybe (UTxO (ShelleyEra c)))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
-> Maybe (UTxO (ShelleyEra c))
forall a b. (a -> b) -> a -> b
$
Ticked (LedgerState (CardanoBlock c))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
forall c.
Ticked (LedgerState (CardanoBlock c))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
ejectShelleyTickedLedgerState (Ticked (LedgerState (CardanoBlock c))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)))))
-> Ticked (LedgerState (CardanoBlock c))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
forall a b. (a -> b) -> a -> b
$
LedgerConfig (CardanoBlock c)
-> SlotNo
-> LedgerState (CardanoBlock c)
-> Ticked (LedgerState (CardanoBlock c))
forall l. IsLedger l => LedgerCfg l -> SlotNo -> l -> Ticked l
applyChainTick LedgerConfig (CardanoBlock c)
lcfg SlotNo
curSlot (LedgerState (CardanoBlock c)
-> Ticked (LedgerState (CardanoBlock c)))
-> LedgerState (CardanoBlock c)
-> Ticked (LedgerState (CardanoBlock c))
forall a b. (a -> b) -> a -> b
$
LedgerState (CardanoBlock c)
lst
MigrationInfo
{ NetworkMagic
byronMagic :: forall c. MigrationInfo c -> NetworkMagic
byronMagic :: NetworkMagic
byronMagic
, SigningKey
byronSK :: forall c. MigrationInfo c -> SigningKey
byronSK :: SigningKey
byronSK
, SignKeyDSIGN c
paymentSK :: forall c. MigrationInfo c -> SignKeyDSIGN c
paymentSK :: SignKeyDSIGN c
paymentSK
, SignKeyDSIGN c
poolSK :: forall c. MigrationInfo c -> SignKeyDSIGN c
poolSK :: SignKeyDSIGN c
poolSK
, SignKeyDSIGN c
stakingSK :: forall c. MigrationInfo c -> SignKeyDSIGN c
stakingSK :: SignKeyDSIGN c
stakingSK
, SignKeyVRF c
vrfSK :: forall c. MigrationInfo c -> SignKeyVRF c
vrfSK :: SignKeyVRF 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
shelleyAddr :: SL.Addr c
shelleyAddr :: Addr c
shelleyAddr =
Network -> PaymentCredential c -> StakeReference c -> Addr c
forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
SL.Addr Network
Shelley.networkId
(SignKeyDSIGN c -> PaymentCredential c
forall c (r :: KeyRole).
Crypto c =>
SignKeyDSIGN c -> Credential r c
Shelley.mkCredential SignKeyDSIGN c
paymentSK)
(Credential 'Staking c -> StakeReference c
forall c. StakeCredential c -> StakeReference c
SL.StakeRefBase (Credential 'Staking c -> StakeReference c)
-> Credential 'Staking c -> StakeReference c
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN c -> Credential 'Staking c
forall c (r :: KeyRole).
Crypto c =>
SignKeyDSIGN c -> Credential r c
Shelley.mkCredential SignKeyDSIGN c
stakingSK)
poolParams :: SL.Coin -> SL.PoolParams c
poolParams :: Coin -> PoolParams c
poolParams Coin
pledge = SL.PoolParams
{ ppCost :: Coin
SL.ppCost = Integer -> Coin
SL.Coin Integer
1
, ppMetadata :: StrictMaybe PoolMetadata
SL.ppMetadata = StrictMaybe PoolMetadata
forall a. StrictMaybe a
SL.SNothing
, ppMargin :: UnitInterval
SL.ppMargin = UnitInterval
forall a. Bounded a => a
minBound
, ppOwners :: Set (KeyHash 'Staking c)
SL.ppOwners = KeyHash 'Staking c -> Set (KeyHash 'Staking c)
forall a. a -> Set a
Set.singleton (KeyHash 'Staking c -> Set (KeyHash 'Staking c))
-> KeyHash 'Staking c -> Set (KeyHash 'Staking c)
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN c -> KeyHash 'Staking c
forall c (r :: KeyRole). Crypto c => SignKeyDSIGN c -> KeyHash r c
Shelley.mkKeyHash SignKeyDSIGN c
poolSK
, ppPledge :: Coin
SL.ppPledge = Coin
pledge
, ppId :: KeyHash 'StakePool c
SL.ppId = SignKeyDSIGN c -> KeyHash 'StakePool c
forall c (r :: KeyRole). Crypto c => SignKeyDSIGN c -> KeyHash r c
Shelley.mkKeyHash SignKeyDSIGN c
poolSK
, ppRewardAccount :: RewardAccount c
SL.ppRewardAccount =
Network -> Credential 'Staking c -> RewardAccount c
forall c. Network -> Credential 'Staking c -> RewardAccount c
SL.RewardAccount Network
Shelley.networkId (Credential 'Staking c -> RewardAccount c)
-> Credential 'Staking c -> RewardAccount c
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN c -> Credential 'Staking c
forall c (r :: KeyRole).
Crypto c =>
SignKeyDSIGN c -> Credential r c
Shelley.mkCredential SignKeyDSIGN c
poolSK
, ppRelays :: StrictSeq StakePoolRelay
SL.ppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
StrictSeq.empty
, ppVrf :: Hash c (VerKeyVRF c)
SL.ppVrf = SignKeyVRF c -> Hash Blake2b_256 (VerKeyVRF c)
forall h vrf.
(HashAlgorithm h, VRFAlgorithm vrf) =>
SignKeyVRF vrf -> Hash h (VerKeyVRF vrf)
Shelley.mkKeyHashVrf SignKeyVRF c
vrfSK
}
ejectShelleyNS ::
NS f (CardanoEras c)
-> Maybe (f (ShelleyBlock (TPraos c) (ShelleyEra c)))
ejectShelleyNS :: forall (f :: * -> *) c.
NS f (CardanoEras c)
-> Maybe (f (ShelleyBlock (TPraos c) (ShelleyEra c)))
ejectShelleyNS = \case
S (Z f x
x) -> f (ShelleyBlock (TPraos c) (ShelleyEra c))
-> Maybe (f (ShelleyBlock (TPraos c) (ShelleyEra c)))
forall a. a -> Maybe a
Just f x
f (ShelleyBlock (TPraos c) (ShelleyEra c))
x
NS f (CardanoEras c)
_ -> Maybe (f (ShelleyBlock (TPraos c) (ShelleyEra c)))
forall a. Maybe a
Nothing
getUTxOShelley :: Ticked (LedgerState (ShelleyBlock proto era))
-> SL.UTxO era
getUTxOShelley :: forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> UTxO era
getUTxOShelley Ticked (LedgerState (ShelleyBlock proto era))
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
$
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
forall proto era.
Ticked (LedgerState (ShelleyBlock proto era)) -> NewEpochState era
tickedShelleyLedgerState Ticked (LedgerState (ShelleyBlock proto era))
tls
ejectShelleyTickedLedgerState ::
Ticked (LedgerState (CardanoBlock c))
-> Maybe (Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
ejectShelleyTickedLedgerState :: forall c.
Ticked (LedgerState (CardanoBlock c))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
ejectShelleyTickedLedgerState Ticked (LedgerState (CardanoBlock c))
ls =
(Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c))
-> Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
-> Maybe
(Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c)))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((:.:) Ticked LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
-> Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)))
forall {l} {k} (f :: l -> *) (g :: k -> l) (p :: k).
(:.:) f g p -> f (g p)
unComp ((:.:) Ticked LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
-> Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
-> (Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c))
-> (:.:)
Ticked LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)))
-> Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c))
-> Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c))
-> (:.:)
Ticked LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))
forall (f :: * -> *) blk. Current f blk -> f blk
currentState) (Maybe
(Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c)))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c)))))
-> Maybe
(Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c)))
-> Maybe
(Ticked (LedgerState (ShelleyBlock (TPraos c) (ShelleyEra c))))
forall a b. (a -> b) -> a -> b
$
NS (Current (Ticked :.: LedgerState)) (CardanoEras c)
-> Maybe
(Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c)))
forall (f :: * -> *) c.
NS f (CardanoEras c)
-> Maybe (f (ShelleyBlock (TPraos c) (ShelleyEra c)))
ejectShelleyNS (NS (Current (Ticked :.: LedgerState)) (CardanoEras c)
-> Maybe
(Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c))))
-> NS (Current (Ticked :.: LedgerState)) (CardanoEras c)
-> Maybe
(Current
(Ticked :.: LedgerState) (ShelleyBlock (TPraos c) (ShelleyEra c)))
forall a b. (a -> b) -> a -> b
$
Telescope
(K Past) (Current (Ticked :.: LedgerState)) (CardanoEras c)
-> NS (Current (Ticked :.: LedgerState)) (CardanoEras c)
forall {k} (g :: k -> *) (f :: k -> *) (xs :: [k]).
Telescope g f xs -> NS f xs
Tele.tip (Telescope
(K Past) (Current (Ticked :.: LedgerState)) (CardanoEras c)
-> NS (Current (Ticked :.: LedgerState)) (CardanoEras c))
-> Telescope
(K Past) (Current (Ticked :.: LedgerState)) (CardanoEras c)
-> NS (Current (Ticked :.: LedgerState)) (CardanoEras c)
forall a b. (a -> b) -> a -> b
$
HardForkState (Ticked :.: LedgerState) (CardanoEras c)
-> Telescope
(K Past) (Current (Ticked :.: LedgerState)) (CardanoEras c)
forall (f :: * -> *) (xs :: [*]).
HardForkState f xs -> Telescope (K Past) (Current f) xs
getHardForkState (HardForkState (Ticked :.: LedgerState) (CardanoEras c)
-> Telescope
(K Past) (Current (Ticked :.: LedgerState)) (CardanoEras c))
-> HardForkState (Ticked :.: LedgerState) (CardanoEras c)
-> Telescope
(K Past) (Current (Ticked :.: LedgerState)) (CardanoEras c)
forall a b. (a -> b) -> a -> b
$
Ticked (LedgerState (CardanoBlock c))
-> HardForkState (Ticked :.: LedgerState) (CardanoEras c)
forall (xs :: [*]).
Ticked (LedgerState (HardForkBlock xs))
-> HardForkState (Ticked :.: LedgerState) xs
tickedHardForkLedgerStatePerEra (Ticked (LedgerState (CardanoBlock c))
-> HardForkState (Ticked :.: LedgerState) (CardanoEras c))
-> Ticked (LedgerState (CardanoBlock c))
-> HardForkState (Ticked :.: LedgerState) (CardanoEras c)
forall a b. (a -> b) -> a -> b
$
Ticked (LedgerState (CardanoBlock c))
ls