Skip to content

Commit

Permalink
cardano-testnet | replace StakingKey & SpoColdKey types with thei…
Browse files Browse the repository at this point in the history
…r cardano-api counterparts
  • Loading branch information
carbolymer committed Jan 20, 2025
1 parent 9017d91 commit 0cbf5b2
Show file tree
Hide file tree
Showing 6 changed files with 16 additions and 19 deletions.
4 changes: 2 additions & 2 deletions cardano-testnet/src/Testnet/Defaults.hs
Original file line number Diff line number Diff line change
Expand Up @@ -502,7 +502,7 @@ defaultSpoKeysDir n = "pools-keys" </> defaultSpoName n
-- | The relative path to SPO keys in directories created by cardano-testnet
defaultSpoColdKeyPair
:: Int
-> KeyPair SpoColdKey
-> KeyPair StakePoolKey
defaultSpoColdKeyPair n =
KeyPair
{ verificationKey = File $ defaultSpoKeysDir n </> "cold.vkey"
Expand All @@ -527,7 +527,7 @@ defaultSpoKeys n =
}

-- | The relative path to stake delegator key pairs in directories created by cardano-testnet
defaultDelegatorStakeKeyPair :: Int -> KeyPair StakingKey
defaultDelegatorStakeKeyPair :: Int -> KeyPair StakeKey
defaultDelegatorStakeKeyPair n =
KeyPair
{ verificationKey = File $ "stake-delegators" </> ("delegator" <> show n) </> "staking.vkey"
Expand Down
2 changes: 1 addition & 1 deletion cardano-testnet/src/Testnet/Process/Cli/DRep.hs
Original file line number Diff line number Diff line change
Expand Up @@ -264,7 +264,7 @@ delegateToDRep
-> FilePath -- ^ Base directory path where generated files will be stored.
-> String -- ^ Name for the subfolder that will be created under 'work' folder.
-> PaymentKeyInfo -- ^ Wallet that will pay for the transaction.
-> KeyPair StakingKey -- ^ Staking key pair used for delegation.
-> KeyPair StakeKey -- ^ Staking key pair used for delegation.
-> KeyPair PaymentKey -- ^ Delegate Representative (DRep) key pair ('PaymentKeyPair') to which delegate.
-> m ()
delegateToDRep execConfig epochStateView sbe work prefix
Expand Down
3 changes: 1 addition & 2 deletions cardano-testnet/src/Testnet/Process/Cli/Keys.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,8 +18,7 @@ module Testnet.Process.Cli.Keys
, cliByronSigningKeyAddress
) where

import Cardano.Api (ByronAddr, ByronKeyLegacy, File (..), FileDirection (..), StakeKey)
import Cardano.Api.Shelley (KesKey, StakePoolKey)
import Cardano.Api (ByronAddr, ByronKeyLegacy, File (..), FileDirection (..))

import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO)
Expand Down
20 changes: 9 additions & 11 deletions cardano-testnet/src/Testnet/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,10 +30,11 @@ module Testnet.Types
, VKey
, SKey
, VrfKey
, StakingKey
, StakePoolKey
, StakeKey
, PaymentKey
, KesKey
, DRepKey
, SpoColdKey
, readNodeLoggingFormat
, ShelleyGenesis(..)
, shelleyGenesis
Expand All @@ -44,7 +45,7 @@ module Testnet.Types

import Cardano.Api
import Cardano.Api.Experimental (Some (..))
import Cardano.Api.Shelley (VrfKey)
import Cardano.Api.Shelley (KesKey, StakePoolKey, VrfKey)

import qualified Cardano.Chain.Genesis as G
import Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic (..))
Expand Down Expand Up @@ -92,10 +93,10 @@ instance MonoFunctor (KeyPair k) where
deriving instance Show (KeyPair k)
deriving instance Eq (KeyPair k)

instance {-# OVERLAPPING #-} Show (Some KeyPair) where
instance Show (Some KeyPair) where
show (Some kp) = show kp

instance {-# OVERLAPPING #-} Eq (Some KeyPair) where
instance Eq (Some KeyPair) where
(Some KeyPair{verificationKey=File vk1, signingKey=File sk1})
== (Some KeyPair{verificationKey=File vk2, signingKey=File sk2}) =
vk1 == vk2 && sk1 == sk2
Expand Down Expand Up @@ -148,13 +149,10 @@ isTestnetNodeSpo = isJust . poolKeys
nodeSocketPath :: TestnetNode -> SocketPath
nodeSocketPath = File . H.sprocketSystemName . nodeSprocket

data StakingKey
data SpoColdKey

data SpoNodeKeys = SpoNodeKeys
{ poolNodeKeysCold :: KeyPair SpoColdKey
{ poolNodeKeysCold :: KeyPair StakePoolKey
, poolNodeKeysVrf :: KeyPair VrfKey
, poolNodeKeysStaking :: KeyPair StakingKey
, poolNodeKeysStaking :: KeyPair StakeKey
} deriving (Eq, Show)

type instance Element SpoNodeKeys = FilePath
Expand All @@ -168,7 +166,7 @@ data PaymentKeyInfo = PaymentKeyInfo

data Delegator = Delegator
{ paymentKeyPair :: KeyPair PaymentKey
, stakingKeyPair :: KeyPair StakingKey
, stakingKeyPair :: KeyPair StakeKey
} deriving (Eq, Show)

data LeadershipSlot = LeadershipSlot
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -19,7 +19,7 @@ import qualified Cardano.Api.Genesis as Api
import Cardano.Api.Ledger (Coin (Coin), EpochInterval (EpochInterval), StandardCrypto,
extractHash, unboundRational)
import qualified Cardano.Api.Ledger as L
import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey), StakePoolKey)
import Cardano.Api.Shelley (StakeCredential (StakeCredentialByKey))

import Cardano.CLI.Types.Key (VerificationKeyOrFile (VerificationKeyFilePath),
readVerificationKeyOrFile)
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ import qualified Testnet.Process.Run as H
import qualified Testnet.Property.Util as H
import Testnet.Start.Types
import Testnet.Types (KeyPair (..),
PaymentKeyInfo (paymentKeyInfoAddr, paymentKeyInfoPair), StakingKey)
PaymentKeyInfo (paymentKeyInfoAddr, paymentKeyInfoPair))

import Hedgehog
import qualified Hedgehog.Extras as H
Expand Down Expand Up @@ -133,7 +133,7 @@ delegateToAlwaysAbstain
-> FilePath -- ^ Base directory path where generated files will be stored.
-> String -- ^ Name for the subfolder that will be created under 'work' folder.
-> PaymentKeyInfo -- ^ Wallet that will pay for the transaction.
-> KeyPair StakingKey -- ^ Staking key pair used for delegation.
-> KeyPair StakeKey -- ^ Staking key pair used for delegation.
-> m ()
delegateToAlwaysAbstain execConfig epochStateView sbe work prefix
payingWallet skeyPair@(KeyPair vKeyFile _sKeyFile) = do
Expand Down

0 comments on commit 0cbf5b2

Please sign in to comment.