wip

IntersectMBO · May 6, 2024 · c0b0891 · c0b0891
1 parent 0cb17bb
commit c0b0891
Show file tree

Hide file tree

Showing 3 changed files with 84 additions and 121 deletions.
diff --git a/cardano-testnet/src/Testnet/Defaults.hs b/cardano-testnet/src/Testnet/Defaults.hs
@@ -77,8 +77,7 @@ import           System.FilePath ((</>))
 
 import           Test.Cardano.Ledger.Core.Rational
 import           Testnet.Start.Types
-import           Testnet.Types (PaymentKeyPair (PaymentKeyPair), PoolNodeKeys (..),
-                   SPOColdKeyPair (..), StakingKeyPair (StakingKeyPair))
+import           Testnet.Types
 
 {- HLINT ignore "Use underscore" -}
 
@@ -505,43 +504,40 @@ defaultGenesisFilepath era =
   eraToString era <> "-genesis.json"
 
 -- | The relative path to DRep keys in directories created by cardano-testnet
-defaultDRepVkeyFp
+defaultDRepKeyPair 
   :: Int -- ^ The DRep's index (starts at 1)
-  -> FilePath
-defaultDRepVkeyFp n = "drep-keys" </> ("drep" <> show n) </> "drep.vkey"
-
--- | The relative path to DRep secret keys in directories created by cardano-testnet
-defaultDRepSkeyFp
-  :: Int -- ^ The DRep's index (starts at 1)
-  -> FilePath
-defaultDRepSkeyFp n = "drep-keys" </> ("drep" <> show n) </> "drep.skey"
-
--- | The relative path to DRep key pairs in directories created by cardano-testnet
-defaultDRepKeyPair :: Int -> PaymentKeyPair
-defaultDRepKeyPair n = PaymentKeyPair (defaultDRepVkeyFp n) (defaultDRepSkeyFp n)
-
--- | The relative path to SPO cold verification key in directories created by cardano-testnet
-defaultSPOColdVKeyFp :: Int -> FilePath
-defaultSPOColdVKeyFp n = "pools-keys" </> "pool" <> show n </> "cold.vkey"
-
--- | The relative path to SPO cold secret key in directories created by cardano-testnet
-defaultSPOColdSKeyFp :: Int -> FilePath
-defaultSPOColdSKeyFp n = "pools-keys" </> "pool" <> show n </> "cold.skey"
+  -> KeyPair DRepKey
+defaultDRepKeyPair n = 
+  KeyPair
+    { verificationKey = "drep-keys" </> ("drep" <> show n) </> "drep.vkey" 
+    , signingKey = "drep-keys" </> ("drep" <> show n) </> "drep.skey" 
+    }
 
--- | The relative path to SPO key cold key pair in directories created by cardano-testnet
-defaultSPOColdKeyPair :: Int -> SPOColdKeyPair
-defaultSPOColdKeyPair n = SPOColdKeyPair (defaultSPOColdVKeyFp n) (defaultSPOColdSKeyFp n)
+-- | The relative path to SPO keys in directories created by cardano-testnet
+defaultSpoColdKeyPair
+  :: Int
+  -> KeyPair SpoColdKey
+defaultSPOColdKeyPair n =
+  KeyPair 
+    { verificationKey = "pools-keys" </> "pool" <> show n </> "cold.vkey"
+    , signingKey = "pools-keys" </> "pool" <> show n </> "cold.skey"
+    }
 
 -- | The relative path to SPO key pairs in directories created by cardano-testnet
 defaultSPOKeys :: Int -> PoolNodeKeys
 defaultSPOKeys n =
   PoolNodeKeys
-    { poolNodeKeysColdVkey = defaultSPOColdVKeyFp n
-    , poolNodeKeysColdSkey = defaultSPOColdSKeyFp n
-    , poolNodeKeysVrfVkey = "pools-keys" </> "pool" ++ show n </> "vrf.vkey"
-    , poolNodeKeysVrfSkey = "pools-keys" </> "pool" ++ show n </> "vrf.skey"
-    , poolNodeKeysStakingVkey = "pools-keys" </> "pool" ++ show n </> "staking-reward.vkey"
-    , poolNodeKeysStakingSkey = "pools-keys" </> "pool" ++ show n </> "staking-reward.skey"
+    { poolNodeKeysCold = defaultSpoKeys n
+    , poolNodeKeysVrf = 
+      KeyPair
+        { verificationKey = File $ "pools-keys" </> "pool" ++ show n </> "vrf.vkey"
+        , signingKey = File $ "pools-keys" </> "pool" ++ show n </> "vrf.skey"
+        }
+    , poolNodeKeysStaking = 
+      KeyPair 
+        { verificationKey = File $ "pools-keys" </> "pool" ++ show n </> "staking-reward.vkey"
+        , signingKey = File $ "pools-keys" </> "pool" ++ show n </> "staking-reward.skey"
+        }
     }
 
 -- | The relative path to stake delegator stake keys in directories created by cardano-testnet

diff --git a/cardano-testnet/src/Testnet/Process/Cli.hs b/cardano-testnet/src/Testnet/Process/Cli.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE DataKinds #-}
+
 module Testnet.Process.Cli
   ( cliAddressKeyGen
   , cliNodeKeyGen
@@ -6,29 +8,20 @@ module Testnet.Process.Cli
   , cliStakeAddressKeyGen
   , execCliStdoutToJson
   , pNetworkId
-  , KeyGen
   , KeyNames (..)
 
-  , File (..)
-
-  , VKey
-  , SKey
-
   , OperatorCounter
 
   , ByronDelegationKey
   , ByronDelegationCert
 
-  , getVKeyPath
-  , getSKeyPath
-
   , cliKeyGen
 
   , cliByronSigningKeyAddress
   ) where
 
-import           Cardano.Api (ByronAddr, ByronKeyLegacy, PaymentKey, StakeKey, bounded)
-import           Cardano.Api.Shelley (KesKey, StakePoolKey, VrfKey)
+import           Cardano.Api (ByronAddr, ByronKeyLegacy, StakeKey, bounded)
+import           Cardano.Api.Shelley (KesKey, StakePoolKey)
 
 import           Control.Monad.Catch (MonadCatch)
 import           Control.Monad.IO.Class (MonadIO)
@@ -41,45 +34,47 @@ import qualified Options.Applicative as Opt
 import           System.FilePath.Posix
 
 import           Testnet.Process.Run
+import Testnet.Types hiding (testnetMagic)
 
 import           Hedgehog (MonadTest)
 import           Hedgehog.Extras (ExecConfig)
 import qualified Hedgehog.Extras.Test.Base as H
 import qualified Hedgehog.Extras.Test.File as H (writeFile)
+import Cardano.Api (File(..), FileDirection(..))
 
 data KeyNames = KeyNames
-  { verificationKeyFile :: FilePath
-  , signingKeyFile :: FilePath
+  { verificationKeyFile :: !FilePath
+  , signingKeyFile :: !FilePath
   }
 
-type KeyGen a = (File (VKey a), File (SKey a))
+-- type KeyGen a = (File (VKey a) Out, File (SKey a) Out)
 
 cliAddressKeyGen :: ()
   => (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => TmpDir
   -> KeyNames
-  -> m (KeyGen PaymentKey)
+  -> m (KeyPair PaymentKey)
 cliAddressKeyGen = GHC.withFrozenCallStack $ shelleyKeyGen "address" "key-gen"
 
 cliStakeAddressKeyGen :: ()
   => (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => TmpDir
   -> KeyNames
-  -> m (KeyGen StakeKey)
+  -> m (KeyPair StakeKey)
 cliStakeAddressKeyGen = GHC.withFrozenCallStack $ shelleyKeyGen "stake-address" "key-gen"
 
 cliNodeKeyGenVrf :: ()
   => (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => TmpDir
   -> KeyNames
-  -> m (KeyGen VrfKey)
+  -> m (KeyPair VrfKey)
 cliNodeKeyGenVrf = GHC.withFrozenCallStack $ shelleyKeyGen "node" "key-gen-VRF"
 
 cliNodeKeyGenKes :: ()
   => (MonadTest m, MonadCatch m, MonadIO m, HasCallStack)
   => TmpDir
   -> KeyNames
-  -> m (KeyGen KesKey)
+  -> m (KeyPair KesKey)
 cliNodeKeyGenKes = GHC.withFrozenCallStack $ shelleyKeyGen "node" "key-gen-KES"
 
 shelleyKeyGen :: ()
@@ -88,7 +83,7 @@ shelleyKeyGen :: ()
   -> String
   -> TmpDir
   -> KeyNames
-  -> m (KeyGen x)
+  -> m (KeyPair x)
 shelleyKeyGen command subCommand tmpDir keyNames =
   GHC.withFrozenCallStack $ do
     let
@@ -99,14 +94,14 @@ shelleyKeyGen command subCommand tmpDir keyNames =
         , "--verification-key-file", vKeyPath
         , "--signing-key-file", sKeyPath
         ]
-    return (File vKeyPath, File sKeyPath)
+    pure $ KeyPair (File vKeyPath) (File sKeyPath)
 
 cliNodeKeyGen
   :: TmpDir
   -> FilePath
   -> FilePath
   -> FilePath
-  -> H.Integration (File (VKey StakePoolKey), File (SKey StakePoolKey), File OperatorCounter)
+  -> H.Integration (KeyPair StakePoolKey, File OperatorCounter Out)
 cliNodeKeyGen tmpDir vkey skey counter = do
   let
     vkPath = tmpDir </> vkey
@@ -118,7 +113,7 @@ cliNodeKeyGen tmpDir vkey skey counter = do
     , "--cold-signing-key-file", skPath
     , "--operational-certificate-issue-counter-file", counterPath
     ]
-  return (File vkPath, File skPath, File counterPath)
+  pure (KeyPair (File vkPath) (File skPath), File counterPath)
 
 -- | Call a command of the CLI that returns JSON to stdout. Then parse it,
 -- and deserialize it to a Haskell value. Fail the test if a step fails.
@@ -134,12 +129,6 @@ execCliStdoutToJson execConfig cmd = GHC.withFrozenCallStack $ do
   result <- execCli' execConfig cmd
   H.leftFail $ Aeson.eitherDecode $ Data.String.fromString result
 
--- | Verification keys
-data VKey a
-
--- | Signing keys
-data SKey a
-
 -- | The 'OperatorCounter'
 data OperatorCounter
 
@@ -151,17 +140,8 @@ data ByronDelegationCert
 
 type TmpDir = FilePath
 
-newtype File a = File {unFile :: FilePath}
-  deriving (Show, Eq)
-
-getVKeyPath ::  (File (VKey a), File (SKey a)) -> FilePath
-getVKeyPath = unFile . fst
-
-getSKeyPath ::  (File (VKey a), File (SKey a)) -> FilePath
-getSKeyPath = unFile . snd
-
 -- Byron
-cliKeyGen :: TmpDir -> FilePath -> H.Integration (File ByronKeyLegacy)
+cliKeyGen :: TmpDir -> FilePath -> H.Integration (File ByronKeyLegacy Out)
 cliKeyGen tmp key = do
   let keyPath = tmp </> key
   execCli_
@@ -173,9 +153,9 @@ cliKeyGen tmp key = do
 cliByronSigningKeyAddress
   :: TmpDir
   -> Int
-  -> File ByronKeyLegacy
+  -> File ByronKeyLegacy In
   -> FilePath
-  -> H.Integration (File ByronAddr)
+  -> H.Integration (File ByronAddr Out)
 cliByronSigningKeyAddress tmp testnetMagic (File key) destPath = do
   let addrPath = tmp </> destPath
   addr <- execCli

diff --git a/cardano-testnet/src/Testnet/Types.hs b/cardano-testnet/src/Testnet/Types.hs
@@ -6,21 +6,28 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
 
 module Testnet.Types
   ( LeadershipSlot(..)
   , NodeLoggingFormat(..)
   , PaymentKeyInfo(..)
-  , PaymentKeyPair(..)
-  , StakingKeyPair(..)
   , TestnetRuntime(..)
   , NodeRuntime(..)
   , PoolNode(..)
   , PoolNodeKeys(..)
   , Delegator(..)
-  , SPOColdKeyPair(..)
   , KeyPair(..)
-  , SomeKeyPair(..)
+  , VKey
+  , SKey
+  , ColdPoolKey
+  , VrfKey
+  , StakingKey
+  , PaymentKey
+  , DRepKey
+  , SpoColdKey
   , allNodes
   , poolSprockets
   , poolNodeStdout
@@ -58,6 +65,21 @@ import           Testnet.Start.Types
 
 import qualified Hedgehog as H
 import           Hedgehog.Extras.Stock.IO.Network.Sprocket (Sprocket (..))
+import Cardano.Api.Shelley (VrfKey)
+
+data KeyPair k = KeyPair
+  { verificationKey :: forall dir. (File (VKey k) dir)
+  , signingKey :: forall dir. (File (SKey k) dir)
+  }
+
+deriving instance Show (KeyPair k)
+deriving instance Eq (KeyPair k)
+
+-- | Verification key tag
+data VKey k
+
+-- | Signing key tag
+data SKey k
 
 data TestnetRuntime = TestnetRuntime
   { configurationFile :: !FilePath
@@ -84,66 +106,31 @@ data PoolNode = PoolNode
   , poolKeys :: PoolNodeKeys
   }
 
-data PoolNodeKeys = PoolNodeKeys
-  { poolNodeKeysColdVkey :: FilePath
-  , poolNodeKeysColdSkey :: FilePath
-  , poolNodeKeysVrfVkey :: FilePath
-  , poolNodeKeysVrfSkey :: FilePath
-  , poolNodeKeysStakingVkey :: FilePath
-  , poolNodeKeysStakingSkey :: FilePath
-  } deriving (Eq, Show)
-
-data SPOColdKeyPair = SPOColdKeyPair
-  { spoColdVKey :: FilePath
-  , spoColdSKey :: FilePath
-  } deriving (Eq, Show)
+data ColdPoolKey
+data StakingKey
+data SpoColdKey
 
-data PaymentKeyPair = PaymentKeyPair
-  { paymentVKey :: FilePath
-  , paymentSKey :: FilePath
+data PoolNodeKeys = PoolNodeKeys
+  { poolNodeKeysCold :: KeyPair SpoColdKey
+  , poolNodeKeysVrf :: KeyPair VrfKey
+  , poolNodeKeysStaking :: KeyPair StakingKey
   } deriving (Eq, Show)
 
 data PaymentKeyInfo = PaymentKeyInfo
-  { paymentKeyInfoPair :: PaymentKeyPair
+  { paymentKeyInfoPair :: KeyPair PaymentKey
   , paymentKeyInfoAddr :: Text
   } deriving (Eq, Show)
 
-data StakingKeyPair = StakingKeyPair
-  { stakingVKey :: FilePath
-  , stakingSKey :: FilePath
-  } deriving (Eq, Show)
-
 data Delegator = Delegator
-  { paymentKeyPair :: PaymentKeyPair
-  , stakingKeyPair :: StakingKeyPair
+  { paymentKeyPair :: KeyPair PaymentKey
+  , stakingKeyPair :: KeyPair StakingKey
   } deriving (Eq, Show)
 
 data LeadershipSlot = LeadershipSlot
   { slotNumber  :: Int
   , slotTime    :: Text
   } deriving (Eq, Show, Generic, FromJSON)
 
-class KeyPair a where
-  secretKey :: a -> FilePath
-
-instance KeyPair PaymentKeyPair where
-  secretKey :: PaymentKeyPair -> FilePath
-  secretKey = paymentSKey
-
-instance KeyPair StakingKeyPair where
-  secretKey :: StakingKeyPair -> FilePath
-  secretKey = stakingSKey
-
-instance KeyPair SPOColdKeyPair where
-  secretKey :: SPOColdKeyPair -> FilePath
-  secretKey = spoColdSKey
-
-data SomeKeyPair = forall a . KeyPair a => SomeKeyPair a
-
-instance KeyPair SomeKeyPair where
-  secretKey :: SomeKeyPair -> FilePath
-  secretKey (SomeKeyPair x) = secretKey x
-
 poolNodeStdout :: PoolNode -> FilePath
 poolNodeStdout = nodeStdout . poolRuntime