{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Shelley.Examples.Consensus where

import Cardano.Crypto.DSIGN as DSIGN
import Cardano.Crypto.Hash as Hash
import Cardano.Crypto.Seed as Seed
import Cardano.Crypto.VRF as VRF
import Cardano.Ledger.AuxiliaryData
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin
import Cardano.Ledger.Crypto
import Cardano.Ledger.EpochBoundary
import Cardano.Ledger.Keys hiding (KeyPair, vKey)
import Cardano.Ledger.PoolDistr
import Cardano.Ledger.SafeHash
import Cardano.Ledger.Shelley (Shelley)
import Cardano.Ledger.Shelley.API hiding (KeyPair, vKey)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Rules
import Cardano.Ledger.Shelley.Translation (emptyFromByronTranslationContext)
import Cardano.Ledger.Shelley.TxWits
import Cardano.Protocol.TPraos.API
import Cardano.Protocol.TPraos.BHeader
import Cardano.Protocol.TPraos.OCert
import Cardano.Protocol.TPraos.Rules.Prtcl
import Cardano.Protocol.TPraos.Rules.Tickn
import Cardano.Slotting.EpochInfo
import qualified Data.ByteString as Strict
import Data.Coerce (coerce)
import Data.Default.Class
import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromJust)
import Data.Proxy
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (pack)
import Data.Time
import Data.Word (Word64, Word8)
import Lens.Micro ((&), (.~))
import Test.Cardano.Ledger.Binary.Random (mkDummyHash)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkWitnessesVKey)
import Test.Cardano.Ledger.Shelley.Generator.Core
import Test.Cardano.Ledger.Shelley.Utils hiding (mkVRFKeyPair)

type KeyPairWits era = [KeyPair 'Witness (EraCrypto era)]

{-------------------------------------------------------------------------------
  ShelleyLedgerExamples
-------------------------------------------------------------------------------}

data ShelleyResultExamples era = ShelleyResultExamples
  { forall era. ShelleyResultExamples era -> PParams era
srePParams :: PParams era
  , forall era. ShelleyResultExamples era -> ProposedPPUpdates era
sreProposedPPUpdates :: ProposedPPUpdates era
  , forall era. ShelleyResultExamples era -> PoolDistr (EraCrypto era)
srePoolDistr :: PoolDistr (EraCrypto era)
  , forall era.
ShelleyResultExamples era
-> Map
     (Either Coin (Credential 'Staking (EraCrypto era)))
     (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
sreNonMyopicRewards ::
      Map
        (Either Coin (Credential 'Staking (EraCrypto era)))
        (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
  , forall era.
ShelleyResultExamples era -> ShelleyGenesis (EraCrypto era)
sreShelleyGenesis :: ShelleyGenesis (EraCrypto era)
  }

deriving instance
  ( Eq (PParams era)
  , Eq (PParamsUpdate era)
  , Era era
  ) =>
  Eq (ShelleyResultExamples era)

data ShelleyLedgerExamples era = ShelleyLedgerExamples
  { forall era.
ShelleyLedgerExamples era -> Block (BHeader (EraCrypto era)) era
sleBlock :: Block (BHeader (EraCrypto era)) era
  , forall era. ShelleyLedgerExamples era -> HashHeader (EraCrypto era)
sleHashHeader :: HashHeader (EraCrypto era)
  , forall era. ShelleyLedgerExamples era -> Tx era
sleTx :: Tx era
  , forall era. ShelleyLedgerExamples era -> ApplyTxError era
sleApplyTxError :: ApplyTxError era
  , forall era.
ShelleyLedgerExamples era
-> Set (Either Coin (Credential 'Staking (EraCrypto era)))
sleRewardsCredentials :: Set (Either Coin (Credential 'Staking (EraCrypto era)))
  , forall era. ShelleyLedgerExamples era -> ShelleyResultExamples era
sleResultExamples :: ShelleyResultExamples era
  , forall era. ShelleyLedgerExamples era -> NewEpochState era
sleNewEpochState :: NewEpochState era
  , forall era.
ShelleyLedgerExamples era -> ChainDepState (EraCrypto era)
sleChainDepState :: ChainDepState (EraCrypto era)
  , forall era. ShelleyLedgerExamples era -> TranslationContext era
sleTranslationContext :: TranslationContext era
  }

deriving instance
  ( EraTx era
  , EraGov era
  , Eq (TxSeq era)
  , Eq (PredicateFailure (EraRule "LEDGER" era))
  , Eq (StashedAVVMAddresses era)
  , Eq (TranslationContext era)
  ) =>
  Eq (ShelleyLedgerExamples era)

{-------------------------------------------------------------------------------
  Default constructor
-------------------------------------------------------------------------------}

type ShelleyBasedEra' era =
  (PraosCrypto (EraCrypto era))

defaultShelleyLedgerExamples ::
  forall era.
  ( ShelleyBasedEra' era
  , EraSegWits era
  , EraGov era
  , PredicateFailure (EraRule "DELEGS" era) ~ ShelleyDelegsPredFailure era
  , PredicateFailure (EraRule "LEDGER" era) ~ ShelleyLedgerPredFailure era
  , Default (StashedAVVMAddresses era)
  , ProtVerAtMost era 4
  ) =>
  (TxBody era -> KeyPairWits era -> TxWits era) ->
  (ShelleyTx era -> Tx era) ->
  Value era ->
  TxBody era ->
  TxAuxData era ->
  TranslationContext era ->
  ShelleyLedgerExamples era
defaultShelleyLedgerExamples :: forall era.
(ShelleyBasedEra' era, EraSegWits era, EraGov era,
 PredicateFailure (EraRule "DELEGS" era)
 ~ ShelleyDelegsPredFailure era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ ShelleyLedgerPredFailure era,
 Default (StashedAVVMAddresses era), ProtVerAtMost era 4) =>
(TxBody era -> KeyPairWits era -> TxWits era)
-> (ShelleyTx era -> Tx era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> ShelleyLedgerExamples era
defaultShelleyLedgerExamples TxBody era -> KeyPairWits era -> TxWits era
mkWitnesses ShelleyTx era -> Tx era
mkAlonzoTx Value era
value TxBody era
txBody TxAuxData era
auxData TranslationContext era
translationContext =
  ShelleyLedgerExamples
    { sleBlock :: Block (BHeader (EraCrypto era)) era
sleBlock = forall era.
(EraSegWits era, PraosCrypto (EraCrypto era)) =>
Tx era -> Block (BHeader (EraCrypto era)) era
exampleShelleyLedgerBlock (ShelleyTx era -> Tx era
mkAlonzoTx ShelleyTx era
tx)
    , sleHashHeader :: HashHeader (EraCrypto era)
sleHashHeader = forall era.
ShelleyBasedEra' era =>
Proxy era -> HashHeader (EraCrypto era)
exampleHashHeader (forall {k} (t :: k). Proxy t
Proxy @era)
    , sleTx :: Tx era
sleTx = ShelleyTx era -> Tx era
mkAlonzoTx ShelleyTx era
tx
    , sleApplyTxError :: ApplyTxError era
sleApplyTxError =
        forall era.
NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ApplyTxError era
ApplyTxError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
PredicateFailure (EraRule "DELEGS" era)
-> ShelleyLedgerPredFailure era
DelegsFailure forall a b. (a -> b) -> a -> b
$
          forall era.
KeyHash 'StakePool (EraCrypto era) -> ShelleyDelegsPredFailure era
DelegateeNotRegisteredDELEG @era (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
1)
    , sleRewardsCredentials :: Set (Either Coin (Credential 'Staking (EraCrypto era)))
sleRewardsCredentials =
        forall a. Ord a => [a] -> Set a
Set.fromList
          [ forall a b. a -> Either a b
Left (Integer -> Coin
Coin Integer
100)
          , forall a b. b -> Either a b
Right (forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj (forall c. Crypto c => Int -> ScriptHash c
mkScriptHash Int
1))
          , forall a b. b -> Either a b
Right (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
2))
          ]
    , sleResultExamples :: ShelleyResultExamples era
sleResultExamples = ShelleyResultExamples era
resultExamples
    , sleNewEpochState :: NewEpochState era
sleNewEpochState =
        forall era.
(EraTxOut era, EraGov era, ShelleyBasedEra' era,
 Default (StashedAVVMAddresses era)) =>
Value era -> PParams era -> PParams era -> NewEpochState era
exampleNewEpochState
          Value era
value
          forall era. EraPParams era => PParams era
emptyPParams
          (forall era. EraPParams era => PParams era
emptyPParams forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1)
    , sleChainDepState :: ChainDepState (EraCrypto era)
sleChainDepState = forall c. Crypto c => Word64 -> ChainDepState c
exampleLedgerChainDepState Word64
1
    , sleTranslationContext :: TranslationContext era
sleTranslationContext = TranslationContext era
translationContext
    }
  where
    tx :: ShelleyTx era
tx = forall era.
EraTx era =>
(TxBody era -> KeyPairWits era -> TxWits era)
-> TxBody era -> TxAuxData era -> ShelleyTx era
exampleTx TxBody era -> KeyPairWits era -> TxWits era
mkWitnesses TxBody era
txBody TxAuxData era
auxData

    resultExamples :: ShelleyResultExamples era
resultExamples =
      ShelleyResultExamples
        { srePParams :: PParams era
srePParams = forall a. Default a => a
def
        , sreProposedPPUpdates :: ProposedPPUpdates era
sreProposedPPUpdates = forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPParamsUpdates
        , srePoolDistr :: PoolDistr (EraCrypto era)
srePoolDistr = forall c. PraosCrypto c => PoolDistr c
examplePoolDistr
        , sreNonMyopicRewards :: Map
  (Either Coin (Credential 'Staking (EraCrypto era)))
  (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
sreNonMyopicRewards = forall c.
Crypto c =>
Map
  (Either Coin (Credential 'Staking c))
  (Map (KeyHash 'StakePool c) Coin)
exampleNonMyopicRewards
        , sreShelleyGenesis :: ShelleyGenesis (EraCrypto era)
sreShelleyGenesis = forall c. Crypto c => ShelleyGenesis c
testShelleyGenesis
        }

{-------------------------------------------------------------------------------
  Helper constructors
-------------------------------------------------------------------------------}

exampleShelleyLedgerBlock ::
  forall era.
  (EraSegWits era, PraosCrypto (EraCrypto era)) =>
  Tx era ->
  Block (BHeader (EraCrypto era)) era
exampleShelleyLedgerBlock :: forall era.
(EraSegWits era, PraosCrypto (EraCrypto era)) =>
Tx era -> Block (BHeader (EraCrypto era)) era
exampleShelleyLedgerBlock Tx era
tx = forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
Block BHeader (EraCrypto era)
blockHeader TxSeq era
blockBody
  where
    keys :: AllIssuerKeys (EraCrypto era) 'StakePool
    keys :: AllIssuerKeys (EraCrypto era) 'StakePool
keys = forall c (r :: KeyRole). Crypto c => AllIssuerKeys c r
exampleKeys

    hotKey :: SignKeyKES (EraCrypto era)
hotKey = forall c. KESKeyPair c -> SignKeyKES c
kesSignKey forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
NE.head forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole).
AllIssuerKeys v r -> NonEmpty (KESPeriod, KESKeyPair v)
aikHot AllIssuerKeys (EraCrypto era) 'StakePool
keys
    KeyPair VKey 'StakePool (EraCrypto era)
vKeyCold SignKeyDSIGN (DSIGN (EraCrypto era))
_ = forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold AllIssuerKeys (EraCrypto era) 'StakePool
keys

    blockHeader :: BHeader (EraCrypto era)
    blockHeader :: BHeader (EraCrypto era)
blockHeader = forall c.
Crypto c =>
BHBody c -> SignedKES c (BHBody c) -> BHeader c
BHeader BHBody (EraCrypto era)
blockHeaderBody (forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v -> Period -> a -> SignKeyKES v -> SignedKES v a
signedKES () Period
0 BHBody (EraCrypto era)
blockHeaderBody SignKeyKES (EraCrypto era)
hotKey)

    blockHeaderBody :: BHBody (EraCrypto era)
    blockHeaderBody :: BHBody (EraCrypto era)
blockHeaderBody =
      BHBody
        { bheaderBlockNo :: BlockNo
bheaderBlockNo = Word64 -> BlockNo
BlockNo Word64
3
        , bheaderSlotNo :: SlotNo
bheaderSlotNo = Word64 -> SlotNo
SlotNo Word64
9
        , bheaderPrev :: PrevHash (EraCrypto era)
bheaderPrev = forall c. HashHeader c -> PrevHash c
BlockHash (forall c. Hash c EraIndependentBlockHeader -> HashHeader c
HashHeader (forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash (Int
2 :: Int)))
        , bheaderVk :: VKey 'BlockIssuer (EraCrypto era)
bheaderVk = forall (a :: KeyRole -> * -> *) (r :: KeyRole) c (r' :: KeyRole).
HasKeyRole a =>
a r c -> a r' c
coerceKeyRole VKey 'StakePool (EraCrypto era)
vKeyCold
        , bheaderVrfVk :: VerKeyVRF (EraCrypto era)
bheaderVrfVk = forall c. VRFKeyPair c -> VerKeyVRF c
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf AllIssuerKeys (EraCrypto era) 'StakePool
keys
        , bheaderEta :: CertifiedVRF (VRF (EraCrypto era)) Nonce
bheaderEta = forall v a b.
(Signable v a, VRFAlgorithm v, ContextVRF v ~ (),
 Coercible b (CertifiedVRF v a)) =>
a -> SignKeyVRF v -> b
mkCertifiedVRF (Int -> Seed
mkBytes Int
0) (forall c. VRFKeyPair c -> SignKeyVRF c
vrfSignKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf AllIssuerKeys (EraCrypto era) 'StakePool
keys)
        , bheaderL :: CertifiedVRF (VRF (EraCrypto era)) Natural
bheaderL = forall v a b.
(Signable v a, VRFAlgorithm v, ContextVRF v ~ (),
 Coercible b (CertifiedVRF v a)) =>
a -> SignKeyVRF v -> b
mkCertifiedVRF (Int -> Seed
mkBytes Int
1) (forall c. VRFKeyPair c -> SignKeyVRF c
vrfSignKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf AllIssuerKeys (EraCrypto era) 'StakePool
keys)
        , bsize :: Word32
bsize = Word32
2345
        , bhash :: Hash (EraCrypto era) EraIndependentBlockBody
bhash = forall era.
EraSegWits era =>
TxSeq era -> Hash (HASH (EraCrypto era)) EraIndependentBlockBody
hashTxSeq @era TxSeq era
blockBody
        , bheaderOCert :: OCert (EraCrypto era)
bheaderOCert = forall c (r :: KeyRole).
(Crypto c, Signable (DSIGN c) (OCertSignable c)) =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys (EraCrypto era) 'StakePool
keys Word64
0 (Period -> KESPeriod
KESPeriod Period
0)
        , bprotver :: ProtVer
bprotver = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2) Natural
0
        }

    blockBody :: TxSeq era
blockBody = forall era. EraSegWits era => StrictSeq (Tx era) -> TxSeq era
toTxSeq @era (forall a. [a] -> StrictSeq a
StrictSeq.fromList [Tx era
tx])

    mkBytes :: Int -> Cardano.Ledger.BaseTypes.Seed
    mkBytes :: Int -> Seed
mkBytes = Hash Blake2b_256 Seed -> Seed
Seed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @Blake2b_256

exampleHashHeader ::
  forall era.
  ShelleyBasedEra' era =>
  Proxy era ->
  HashHeader (EraCrypto era)
exampleHashHeader :: forall era.
ShelleyBasedEra' era =>
Proxy era -> HashHeader (EraCrypto era)
exampleHashHeader Proxy era
_ = coerce :: forall a b. Coercible a b => a -> b
coerce forall a b. (a -> b) -> a -> b
$ forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @(HASH (EraCrypto era)) (Int
0 :: Int)

mkKeyHash :: forall c discriminator. Crypto c => Int -> KeyHash discriminator c
mkKeyHash :: forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash = forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
KeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @(ADDRHASH c)

mkScriptHash :: forall c. Crypto c => Int -> ScriptHash c
mkScriptHash :: forall c. Crypto c => Int -> ScriptHash c
mkScriptHash = forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
ScriptHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @(ADDRHASH c)

-- | This is not a valid transaction. We don't care, we are only interested in
-- serialisation, not validation.
exampleTx ::
  forall era.
  EraTx era =>
  (TxBody era -> KeyPairWits era -> TxWits era) ->
  TxBody era ->
  TxAuxData era ->
  ShelleyTx era
exampleTx :: forall era.
EraTx era =>
(TxBody era -> KeyPairWits era -> TxWits era)
-> TxBody era -> TxAuxData era -> ShelleyTx era
exampleTx TxBody era -> KeyPairWits era -> TxWits era
mkWitnesses TxBody era
txBody TxAuxData era
auxData =
  forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody era
txBody (TxBody era -> KeyPairWits era -> TxWits era
mkWitnesses TxBody era
txBody KeyPairWits era
keyPairWits) (forall a. a -> StrictMaybe a
SJust TxAuxData era
auxData)
  where
    keyPairWits :: KeyPairWits era
    keyPairWits :: KeyPairWits era
keyPairWits =
      [ forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Payment c
examplePayKey
      , forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall c. Crypto c => KeyPair 'Staking c
exampleStakeKey
      , forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold (forall c (r :: KeyRole). Crypto c => AllIssuerKeys c r
exampleKeys @(EraCrypto era) @'StakePool)
      ]

exampleProposedPParamsUpdates ::
  EraPParams era =>
  ProposedPPUpdates era
exampleProposedPParamsUpdates :: forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPParamsUpdates =
  forall era.
Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates forall a b. (a -> b) -> a -> b
$
    forall k a. k -> a -> Map k a
Map.singleton
      (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
0)
      (forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuKeyDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust (Integer -> Coin
Coin Integer
100))

examplePoolDistr :: forall c. PraosCrypto c => PoolDistr c
examplePoolDistr :: forall c. PraosCrypto c => PoolDistr c
examplePoolDistr =
  forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr
    ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [
          ( forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
1
          , forall c.
Rational
-> CompactForm Coin
-> Hash c (VerKeyVRF c)
-> IndividualPoolStake c
IndividualPoolStake
              Rational
1
              (Word64 -> CompactForm Coin
CompactCoin Word64
1)
              (forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
hashVerKeyVRF (forall c. VRFKeyPair c -> VerKeyVRF c
vrfVerKey (forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf (forall c (r :: KeyRole). Crypto c => AllIssuerKeys c r
exampleKeys @c))))
          )
        ]
    )
    (Word64 -> CompactForm Coin
CompactCoin Word64
1)

exampleNonMyopicRewards ::
  forall c.
  Crypto c =>
  Map
    (Either Coin (Credential 'Staking c))
    (Map (KeyHash 'StakePool c) Coin)
exampleNonMyopicRewards :: forall c.
Crypto c =>
Map
  (Either Coin (Credential 'Staking c))
  (Map (KeyHash 'StakePool c) Coin)
exampleNonMyopicRewards =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (forall a b. a -> Either a b
Left (Integer -> Coin
Coin Integer
100), forall k a. k -> a -> Map k a
Map.singleton (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
2) (Integer -> Coin
Coin Integer
3))
    , (forall a b. b -> Either a b
Right (forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj (forall c. Crypto c => Int -> ScriptHash c
mkScriptHash Int
1)), forall k a. Map k a
Map.empty)
    , (forall a b. b -> Either a b
Right (forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
2)), forall k a. k -> a -> Map k a
Map.singleton (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
3) (Integer -> Coin
Coin Integer
9))
    ]

-- | These are dummy values.
testShelleyGenesis :: Crypto c => ShelleyGenesis c
testShelleyGenesis :: forall c. Crypto c => ShelleyGenesis c
testShelleyGenesis =
  ShelleyGenesis
    { sgSystemStart :: UTCTime
sgSystemStart = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
2020 Int
5 Int
14) DiffTime
0
    , sgNetworkMagic :: Word32
sgNetworkMagic = Word32
0
    , sgNetworkId :: Network
sgNetworkId = Network
Testnet
    , -- Chosen to match activeSlotCoeff
      sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.9
    , sgSecurityParam :: Word64
sgSecurityParam = Globals -> Word64
securityParameter Globals
testGlobals
    , sgEpochLength :: EpochSize
sgEpochLength = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> EpochNo -> m EpochSize
epochInfoSize EpochInfo Identity
testEpochInfo EpochNo
0
    , sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod = Globals -> Word64
slotsPerKESPeriod Globals
testGlobals
    , sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions = Globals -> Word64
maxKESEvo Globals
testGlobals
    , -- Not important
      sgSlotLength :: NominalDiffTimeMicro
sgSlotLength = Micro -> NominalDiffTimeMicro
secondsToNominalDiffTimeMicro Micro
2
    , sgUpdateQuorum :: Word64
sgUpdateQuorum = Globals -> Word64
quorum Globals
testGlobals
    , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = Globals -> Word64
maxLovelaceSupply Globals
testGlobals
    , sgProtocolParams :: PParams (ShelleyEra c)
sgProtocolParams = forall era. EraPParams era => PParams era
emptyPParams
    , sgGenDelegs :: Map (KeyHash 'Genesis c) (GenDelegPair c)
sgGenDelegs = forall k a. Map k a
Map.empty
    , sgInitialFunds :: ListMap (Addr c) Coin
sgInitialFunds = forall a. Monoid a => a
mempty
    , sgStaking :: ShelleyGenesisStaking c
sgStaking = forall c. ShelleyGenesisStaking c
emptyGenesisStaking
    }

-- | This is probably not a valid ledger. We don't care, we are only
-- interested in serialisation, not validation.
exampleNewEpochState ::
  forall era.
  ( EraTxOut era
  , EraGov era
  , ShelleyBasedEra' era
  , Default (StashedAVVMAddresses era)
  ) =>
  Value era ->
  PParams era ->
  PParams era ->
  NewEpochState era
exampleNewEpochState :: forall era.
(EraTxOut era, EraGov era, ShelleyBasedEra' era,
 Default (StashedAVVMAddresses era)) =>
Value era -> PParams era -> PParams era -> NewEpochState era
exampleNewEpochState Value era
value PParams era
ppp PParams era
pp =
  NewEpochState
    { nesEL :: EpochNo
nesEL = Word64 -> EpochNo
EpochNo Word64
0
    , nesBprev :: BlocksMade (EraCrypto era)
nesBprev = forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade (forall k a. k -> a -> Map k a
Map.singleton (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
1) Natural
10)
    , nesBcur :: BlocksMade (EraCrypto era)
nesBcur = forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade (forall k a. k -> a -> Map k a
Map.singleton (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
2) Natural
3)
    , nesEs :: EpochState era
nesEs = EpochState era
epochState
    , nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesRu = forall a. a -> StrictMaybe a
SJust PulsingRewUpdate (EraCrypto era)
rewardUpdate
    , nesPd :: PoolDistr (EraCrypto era)
nesPd = forall c. PraosCrypto c => PoolDistr c
examplePoolDistr
    , stashedAVVMAddresses :: StashedAVVMAddresses era
stashedAVVMAddresses = forall a. Default a => a
def
    }
  where
    epochState :: EpochState era
    epochState :: EpochState era
epochState =
      EpochState
        { esAccountState :: AccountState
esAccountState =
            AccountState
              { asTreasury :: Coin
asTreasury = Integer -> Coin
Coin Integer
10000
              , asReserves :: Coin
asReserves = Integer -> Coin
Coin Integer
1000
              }
        , esSnapshots :: SnapShots (EraCrypto era)
esSnapshots = forall c. SnapShots c
emptySnapShots
        , esLState :: LedgerState era
esLState =
            LedgerState
              { lsUTxOState :: UTxOState era
lsUTxOState =
                  UTxOState
                    { utxosUtxo :: UTxO era
utxosUtxo =
                        forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a b. (a -> b) -> a -> b
$
                          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            [
                              ( forall c. TxId c -> TxIx -> TxIn c
TxIn (forall c. SafeHash c EraIndependentTxBody -> TxId c
TxId (forall c a. Crypto c => Proxy c -> Int -> SafeHash c a
mkDummySafeHash forall {k} (t :: k). Proxy t
Proxy Int
1)) forall a. Bounded a => a
minBound
                              , forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut Addr (EraCrypto era)
addr Value era
value
                              )
                            ]
                    , utxosDeposited :: Coin
utxosDeposited = Integer -> Coin
Coin Integer
1000
                    , utxosFees :: Coin
utxosFees = Integer -> Coin
Coin Integer
1
                    , utxosGovState :: GovState era
utxosGovState = forall era. EraGov era => GovState era
emptyGovState
                    , utxosStakeDistr :: IncrementalStake (EraCrypto era)
utxosStakeDistr = forall a. Monoid a => a
mempty
                    , utxosDonation :: Coin
utxosDonation = forall a. Monoid a => a
mempty
                    }
              , lsCertState :: CertState era
lsCertState = forall a. Default a => a
def
              }
        , esNonMyopic :: NonMyopic (EraCrypto era)
esNonMyopic = forall a. Default a => a
def
        }
        forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
ppp
        forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
      where
        addr :: Addr (EraCrypto era)
        addr :: Addr (EraCrypto era)
addr =
          forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr
            Network
Testnet
            (forall c (r :: KeyRole). Crypto c => KeyPair r c -> Credential r c
keyToCredential forall c. Crypto c => KeyPair 'Payment c
examplePayKey)
            (forall c. StakeCredential c -> StakeReference c
StakeRefBase (forall c (r :: KeyRole). Crypto c => KeyPair r c -> Credential r c
keyToCredential forall c. Crypto c => KeyPair 'Staking c
exampleStakeKey))

    rewardUpdate :: PulsingRewUpdate (EraCrypto era)
    rewardUpdate :: PulsingRewUpdate (EraCrypto era)
rewardUpdate =
      forall era.
EraGov era =>
EpochSize
-> BlocksMade (EraCrypto era)
-> EpochState era
-> Coin
-> ActiveSlotCoeff
-> Word64
-> PulsingRewUpdate (EraCrypto era)
startStep @era
        (Word64 -> EpochSize
EpochSize Word64
432000)
        (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade (forall k a. k -> a -> Map k a
Map.singleton (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
1) Natural
10))
        EpochState era
epochState
        (Integer -> Coin
Coin Integer
1000)
        (Globals -> ActiveSlotCoeff
activeSlotCoeff Globals
testGlobals)
        Word64
10

exampleLedgerChainDepState :: forall c. Crypto c => Word64 -> ChainDepState c
exampleLedgerChainDepState :: forall c. Crypto c => Word64 -> ChainDepState c
exampleLedgerChainDepState Word64
seed =
  ChainDepState
    { csProtocol :: PrtclState c
csProtocol =
        forall c.
Map (KeyHash 'BlockIssuer c) Word64
-> Nonce -> Nonce -> PrtclState c
PrtclState
          ( forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
1, Word64
1)
              , (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
2, Word64
2)
              ]
          )
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
    , csTickn :: TicknState
csTickn =
        Nonce -> Nonce -> TicknState
TicknState
          Nonce
NeutralNonce
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
    , csLabNonce :: Nonce
csLabNonce =
        Word64 -> Nonce
mkNonceFromNumber Word64
seed
    }

testEpochInfo :: EpochInfo Identity
testEpochInfo :: EpochInfo Identity
testEpochInfo = Globals -> EpochInfo Identity
epochInfoPure Globals
testGlobals

mkDummyAnchor :: Crypto c => Int -> Anchor c
mkDummyAnchor :: forall c. Crypto c => Int -> Anchor c
mkDummyAnchor Int
n =
  Anchor
    { anchorUrl :: Url
anchorUrl = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 forall a b. (a -> b) -> a -> b
$ Text
"dummy@" forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (forall a. Show a => a -> String
show Int
n)
    , anchorDataHash :: SafeHash c AnchorData
anchorDataHash = forall c a. Crypto c => Proxy c -> Int -> SafeHash c a
mkDummySafeHash forall {k} (t :: k). Proxy t
Proxy Int
n
    }

{-------------------------------------------------------------------------------
  Shelley era specific functions
-------------------------------------------------------------------------------}

-- | ShelleyLedgerExamples for Shelley era
ledgerExamplesShelley :: ShelleyLedgerExamples Shelley
ledgerExamplesShelley :: ShelleyLedgerExamples (ShelleyEra StandardCrypto)
ledgerExamplesShelley =
  forall era.
(ShelleyBasedEra' era, EraSegWits era, EraGov era,
 PredicateFailure (EraRule "DELEGS" era)
 ~ ShelleyDelegsPredFailure era,
 PredicateFailure (EraRule "LEDGER" era)
 ~ ShelleyLedgerPredFailure era,
 Default (StashedAVVMAddresses era), ProtVerAtMost era 4) =>
(TxBody era -> KeyPairWits era -> TxWits era)
-> (ShelleyTx era -> Tx era)
-> Value era
-> TxBody era
-> TxAuxData era
-> TranslationContext era
-> ShelleyLedgerExamples era
defaultShelleyLedgerExamples
    (forall era.
(EraTx era,
 Signable
   (DSIGN (EraCrypto era))
   (Hash (HASH (EraCrypto era)) EraIndependentTxBody)) =>
Proxy era -> TxBody era -> KeyPairWits era -> ShelleyTxWits era
mkWitnessesPreAlonzo (forall {k} (t :: k). Proxy t
Proxy @Shelley))
    forall a. a -> a
id
    Coin
exampleCoin
    ShelleyTxBody (ShelleyEra StandardCrypto)
exampleTxBodyShelley
    TxAuxData (ShelleyEra StandardCrypto)
exampleAuxiliaryDataShelley
    forall c. Crypto c => FromByronTranslationContext c
emptyFromByronTranslationContext

mkWitnessesPreAlonzo ::
  ( EraTx era
  , DSIGN.Signable
      (DSIGN (EraCrypto era))
      (Hash.Hash (HASH (EraCrypto era)) EraIndependentTxBody)
  ) =>
  Proxy era ->
  TxBody era ->
  KeyPairWits era ->
  ShelleyTxWits era
mkWitnessesPreAlonzo :: forall era.
(EraTx era,
 Signable
   (DSIGN (EraCrypto era))
   (Hash (HASH (EraCrypto era)) EraIndependentTxBody)) =>
Proxy era -> TxBody era -> KeyPairWits era -> ShelleyTxWits era
mkWitnessesPreAlonzo Proxy era
_ TxBody era
txBody KeyPairWits era
keyPairWits =
  forall a. Monoid a => a
mempty
    { addrWits :: Set (WitVKey 'Witness (EraCrypto era))
addrWits =
        forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> [KeyPair kr c] -> Set (WitVKey 'Witness c)
mkWitnessesVKey (coerce :: forall a b. Coercible a b => a -> b
coerce (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
txBody)) KeyPairWits era
keyPairWits
    }

exampleCoin :: Coin
exampleCoin :: Coin
exampleCoin = Integer -> Coin
Coin Integer
10

exampleTxBodyShelley :: ShelleyTxBody Shelley
exampleTxBodyShelley :: ShelleyTxBody (ShelleyEra StandardCrypto)
exampleTxBodyShelley =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ShelleyTxBody era
ShelleyTxBody
    forall c. Crypto c => Set (TxIn c)
exampleTxIns
    ( forall a. [a] -> StrictSeq a
StrictSeq.fromList
        [ forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr (EraCrypto era) -> Value era -> ShelleyTxOut era
ShelleyTxOut (forall c.
Crypto c =>
(KeyPair 'Payment c, KeyPair 'Staking c) -> Addr c
mkAddr (forall c. Crypto c => KeyPair 'Payment c
examplePayKey, forall c. Crypto c => KeyPair 'Staking c
exampleStakeKey)) (Integer -> Coin
Coin Integer
100000)
        ]
    )
    forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
StrictSeq (TxCert era)
exampleCerts
    forall c. Crypto c => Withdrawals c
exampleWithdrawals
    (Integer -> Coin
Coin Integer
3)
    (Word64 -> SlotNo
SlotNo Word64
10)
    (forall a. a -> StrictMaybe a
SJust (forall era. ProposedPPUpdates era -> EpochNo -> Update era
Update forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPPUpdates (Word64 -> EpochNo
EpochNo Word64
0)))
    (forall a. a -> StrictMaybe a
SJust AuxiliaryDataHash StandardCrypto
auxiliaryDataHash)
  where
    -- Dummy hash to decouple from the auxiliaryData in 'exampleTx'.
    auxiliaryDataHash :: AuxiliaryDataHash StandardCrypto
    auxiliaryDataHash :: AuxiliaryDataHash StandardCrypto
auxiliaryDataHash =
      forall c. SafeHash c EraIndependentTxAuxData -> AuxiliaryDataHash c
AuxiliaryDataHash forall a b. (a -> b) -> a -> b
$ forall c a. Crypto c => Proxy c -> Int -> SafeHash c a
mkDummySafeHash (forall {k} (t :: k). Proxy t
Proxy @StandardCrypto) Int
30

exampleAuxDataMap :: Map Word64 Metadatum
exampleAuxDataMap :: Map Word64 Metadatum
exampleAuxDataMap =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ (Word64
1, Text -> Metadatum
S Text
"string")
    , (Word64
2, ByteString -> Metadatum
B ByteString
"bytes")
    , (Word64
3, [Metadatum] -> Metadatum
List [Integer -> Metadatum
I Integer
1, Integer -> Metadatum
I Integer
2])
    , (Word64
4, [(Metadatum, Metadatum)] -> Metadatum
Map [(Integer -> Metadatum
I Integer
3, ByteString -> Metadatum
B ByteString
"b")])
    ]

exampleAuxiliaryDataShelley :: TxAuxData Shelley
exampleAuxiliaryDataShelley :: TxAuxData (ShelleyEra StandardCrypto)
exampleAuxiliaryDataShelley = forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData Map Word64 Metadatum
exampleAuxDataMap

exampleTxIns :: Crypto c => Set (TxIn c)
exampleTxIns :: forall c. Crypto c => Set (TxIn c)
exampleTxIns =
  forall a. Ord a => [a] -> Set a
Set.fromList
    [ forall c. TxId c -> TxIx -> TxIn c
TxIn (forall c. SafeHash c EraIndependentTxBody -> TxId c
TxId (forall c a. Crypto c => Proxy c -> Int -> SafeHash c a
mkDummySafeHash forall {k} (t :: k). Proxy t
Proxy Int
1)) forall a. Bounded a => a
minBound
    ]

exampleCerts :: (ShelleyEraTxCert era, ProtVerAtMost era 8) => StrictSeq (TxCert era)
exampleCerts :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
StrictSeq (TxCert era)
exampleCerts =
  forall a. [a] -> StrictSeq a
StrictSeq.fromList
    [ forall era.
ShelleyEraTxCert era =>
StakeCredential (EraCrypto era) -> TxCert era
RegTxCert (forall c (r :: KeyRole). Crypto c => KeyPair r c -> Credential r c
keyToCredential forall c. Crypto c => KeyPair 'Staking c
exampleStakeKey)
    , forall era.
EraTxCert era =>
PoolParams (EraCrypto era) -> TxCert era
RegPoolTxCert forall c. Crypto c => PoolParams c
examplePoolParams
    , forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
MIRCert (EraCrypto era) -> TxCert era
MirTxCert forall a b. (a -> b) -> a -> b
$
        forall c. MIRPot -> MIRTarget c -> MIRCert c
MIRCert MIRPot
ReservesMIR forall a b. (a -> b) -> a -> b
$
          forall c. Map (Credential 'Staking c) DeltaCoin -> MIRTarget c
StakeAddressesMIR forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ (forall c (r :: KeyRole). Crypto c => KeyPair r c -> Credential r c
keyToCredential (forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
Word8 -> KeyPair kd c
mkDSIGNKeyPair Word8
2), Integer -> DeltaCoin
DeltaCoin Integer
110)
              ]
    ]

exampleWithdrawals :: Crypto c => Withdrawals c
exampleWithdrawals :: forall c. Crypto c => Withdrawals c
exampleWithdrawals =
  forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (forall c. PoolParams c -> RewardAccount c
ppRewardAccount forall c. Crypto c => PoolParams c
examplePoolParams, Integer -> Coin
Coin Integer
100)
      ]

exampleProposedPPUpdates ::
  EraPParams era =>
  ProposedPPUpdates era
exampleProposedPPUpdates :: forall era. EraPParams era => ProposedPPUpdates era
exampleProposedPPUpdates =
  forall era.
Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates forall a b. (a -> b) -> a -> b
$
    forall k a. k -> a -> Map k a
Map.singleton
      (forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash Int
1)
      (forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> StrictMaybe a
SJust Word16
4000)

examplePayKey :: Crypto c => KeyPair 'Payment c
examplePayKey :: forall c. Crypto c => KeyPair 'Payment c
examplePayKey = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
Word8 -> KeyPair kd c
mkDSIGNKeyPair Word8
0

exampleStakeKey :: Crypto c => KeyPair 'Staking c
exampleStakeKey :: forall c. Crypto c => KeyPair 'Staking c
exampleStakeKey = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
Word8 -> KeyPair kd c
mkDSIGNKeyPair Word8
1

exampleKeys :: forall c r. Crypto c => AllIssuerKeys c r
exampleKeys :: forall c (r :: KeyRole). Crypto c => AllIssuerKeys c r
exampleKeys =
  forall v (r :: KeyRole).
KeyPair r v
-> VRFKeyPair v
-> NonEmpty (KESPeriod, KESKeyPair v)
-> KeyHash r v
-> AllIssuerKeys v r
AllIssuerKeys
    forall {kd :: KeyRole}. KeyPair kd c
coldKey
    (forall c. Crypto c => Proxy c -> Word8 -> VRFKeyPair c
mkVRFKeyPair (forall {k} (t :: k). Proxy t
Proxy @c) Word8
1)
    ((Period -> KESPeriod
KESPeriod Period
0, forall c. Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
3)) forall a. a -> [a] -> NonEmpty a
NE.:| [])
    (forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall {kd :: KeyRole}. KeyPair kd c
coldKey))
  where
    coldKey :: KeyPair kd c
coldKey = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
Word8 -> KeyPair kd c
mkDSIGNKeyPair Word8
1

keyToCredential :: Crypto c => KeyPair r c -> Credential r c
keyToCredential :: forall c (r :: KeyRole). Crypto c => KeyPair r c -> Credential r c
keyToCredential = forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey

-- | @mkKeyPair'@ from @Test.Cardano.Ledger.Shelley.Utils@ doesn't work for real
-- crypto:
-- <https://github.com/intersectmbo/cardano-ledger/issues/1770>
mkDSIGNKeyPair ::
  forall c kd.
  DSIGNAlgorithm (DSIGN c) =>
  Word8 ->
  KeyPair kd c
mkDSIGNKeyPair :: forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
Word8 -> KeyPair kd c
mkDSIGNKeyPair Word8
byte = forall (kd :: KeyRole) c.
VKey kd c -> SignKeyDSIGN (DSIGN c) -> KeyPair kd c
KeyPair (forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
VKey forall a b. (a -> b) -> a -> b
$ forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
DSIGN.deriveVerKeyDSIGN SignKeyDSIGN (DSIGN c)
sk) SignKeyDSIGN (DSIGN c)
sk
  where
    seed :: Seed
seed =
      ByteString -> Seed
Seed.mkSeedFromBytes forall a b. (a -> b) -> a -> b
$
        Int -> Word8 -> ByteString
Strict.replicate
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Period
DSIGN.seedSizeDSIGN (forall {k} (t :: k). Proxy t
Proxy @(DSIGN c))))
          Word8
byte

    sk :: SignKeyDSIGN (DSIGN c)
sk = forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
DSIGN.genKeyDSIGN Seed
seed

mkVRFKeyPair ::
  forall c.
  Crypto c =>
  Proxy c ->
  Word8 ->
  VRFKeyPair c
mkVRFKeyPair :: forall c. Crypto c => Proxy c -> Word8 -> VRFKeyPair c
mkVRFKeyPair Proxy c
_ Word8
byte = forall c. SignKeyVRF c -> VerKeyVRF c -> VRFKeyPair c
VRFKeyPair SignKeyVRF (VRF c)
sk (forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
VRF.deriveVerKeyVRF SignKeyVRF (VRF c)
sk)
  where
    seed :: Seed
seed =
      ByteString -> Seed
Seed.mkSeedFromBytes forall a b. (a -> b) -> a -> b
$
        Int -> Word8 -> ByteString
Strict.replicate
          (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Period
VRF.seedSizeVRF (forall {k} (t :: k). Proxy t
Proxy @(VRF c))))
          Word8
byte

    sk :: SignKeyVRF (VRF c)
sk = forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
VRF.genKeyVRF Seed
seed

examplePoolParams :: forall c. Crypto c => PoolParams c
examplePoolParams :: forall c. Crypto c => PoolParams c
examplePoolParams =
  PoolParams
    { ppId :: KeyHash 'StakePool c
ppId = forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> KeyPair r v
aikCold AllIssuerKeys c 'StakePool
poolKeys
    , ppVrf :: Hash c (VerKeyVRF c)
ppVrf = forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
hashVerKeyVRF forall a b. (a -> b) -> a -> b
$ forall c. VRFKeyPair c -> VerKeyVRF c
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall v (r :: KeyRole). AllIssuerKeys v r -> VRFKeyPair v
aikVrf AllIssuerKeys c 'StakePool
poolKeys
    , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
1
    , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
5
    , ppMargin :: UnitInterval
ppMargin = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , ppRewardAccount :: RewardAccount c
ppRewardAccount = forall c. Network -> Credential 'Staking c -> RewardAccount c
RewardAccount Network
Testnet (forall c (r :: KeyRole). Crypto c => KeyPair r c -> Credential r c
keyToCredential forall c. Crypto c => KeyPair 'Staking c
exampleStakeKey)
    , ppOwners :: Set (KeyHash 'Staking c)
ppOwners = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall c. Crypto c => KeyPair 'Staking c
exampleStakeKey
    , ppRelays :: StrictSeq StakePoolRelay
ppRelays = forall a. StrictSeq a
StrictSeq.empty
    , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata =
        forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$
          PoolMetadata
            { pmUrl :: Url
pmUrl = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
"consensus.pool"
            , pmHash :: ByteString
pmHash = ByteString
"{}"
            }
    }
  where
    poolKeys :: AllIssuerKeys c 'StakePool
poolKeys = forall c (r :: KeyRole). Crypto c => AllIssuerKeys c r
exampleKeys @c @'StakePool