Command argument types: rest of 'genesis', format

cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs

@@ -10,6 +10,9 @@ module Cardano.CLI.EraBased.Commands.Genesis
   , GenesisKeyGenGenesisCmdArgs (..)
   , GenesisKeyGenDelegateCmdArgs (..)
   , GenesisKeyGenUTxOCmdArgs (..)
+  , GenesisVerKeyCmdArgs (..)
+  , GenesisTxInCmdArgs (..)
+  , GenesisAddrCmdArgs (..)
   , renderGenesisCmds
   ) where
 
@@ -27,21 +30,11 @@ data GenesisCmds era
   | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs
   | GenesisKeyGenDelegate !GenesisKeyGenDelegateCmdArgs
   | GenesisKeyGenUTxO !GenesisKeyGenUTxOCmdArgs
-  | GenesisCmdKeyHash
-      (VerificationKeyFile In)
-  | GenesisVerKey
-      (VerificationKeyFile Out)
-      (SigningKeyFile In)
-  | GenesisTxIn
-      (VerificationKeyFile In)
-      NetworkId
-      (Maybe (File () Out))
-  | GenesisAddr
-      (VerificationKeyFile In)
-      NetworkId
-      (Maybe (File () Out))
-  | GenesisHashFile
-      GenesisFile
+  | GenesisCmdKeyHash !(VerificationKeyFile In)
+  | GenesisVerKey !GenesisVerKeyCmdArgs
+  | GenesisTxIn !GenesisTxInCmdArgs
+  | GenesisAddr !GenesisAddrCmdArgs
+  | GenesisHashFile !GenesisFile
   deriving Show
 
 data GenesisCreateCmdArgs = GenesisCreateCmdArgs
@@ -104,6 +97,22 @@ data GenesisKeyGenUTxOCmdArgs = GenesisKeyGenUTxOCmdArgs
   , signingKeyPath :: !(SigningKeyFile Out)
   } deriving Show
 
+data GenesisVerKeyCmdArgs = GenesisVerKeyCmdArgs
+  { verificationKeyPath :: !(VerificationKeyFile Out)
+  , signingKeyPath :: !(SigningKeyFile In)
+  } deriving Show
+
+data GenesisTxInCmdArgs = GenesisTxInCmdArgs
+  { verificationKeyPath :: !(VerificationKeyFile In)
+  , network :: !NetworkId
+  , mOutFile :: !(Maybe (File () Out))
+  } deriving Show
+
+data GenesisAddrCmdArgs = GenesisAddrCmdArgs
+  { verificationKeyPath :: !(VerificationKeyFile In)
+  , network :: !NetworkId
+  , mOutFile :: !(Maybe (File () Out))
+  } deriving Show
 
 renderGenesisCmds :: GenesisCmds era -> Text
 renderGenesisCmds = \case

cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs

@@ -118,20 +118,20 @@ pGenesisKeyHash =
 
 pGenesisVerKey :: Parser (GenesisCmds era)
 pGenesisVerKey =
-  GenesisVerKey
+  fmap GenesisVerKey $ GenesisVerKeyCmdArgs
     <$> pVerificationKeyFileOut
     <*> pSigningKeyFileIn
 
 pGenesisAddr :: EnvCli -> Parser (GenesisCmds era)
 pGenesisAddr envCli =
-  GenesisAddr
+  fmap GenesisAddr $ GenesisAddrCmdArgs
     <$> pVerificationKeyFileIn
     <*> pNetworkId envCli
     <*> pMaybeOutputFile
 
 pGenesisTxIn :: EnvCli -> Parser (GenesisCmds era)
 pGenesisTxIn envCli =
-  GenesisTxIn
+  fmap GenesisTxIn $ GenesisTxInCmdArgs
     <$> pVerificationKeyFileIn
     <*> pNetworkId envCli
     <*> pMaybeOutputFile

cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -143,28 +143,17 @@ import           Crypto.Random as Crypto
 
 runGenesisCmds :: GenesisCmds era -> ExceptT GenesisCmdError IO ()
 runGenesisCmds = \case
-  GenesisKeyGenGenesis args ->
-    runGenesisKeyGenGenesisCmd args
-  GenesisKeyGenDelegate args ->
-    runGenesisKeyGenDelegateCmd args
-  GenesisKeyGenUTxO args ->
-    runGenesisKeyGenUTxOCmd args
-  GenesisCmdKeyHash vk ->
-    runGenesisKeyHashCmd vk
-  GenesisVerKey vk sk ->
-    runGenesisVerKeyCmd vk sk
-  GenesisTxIn vk nw mOutFile ->
-    runGenesisTxInCmd vk nw mOutFile
-  GenesisAddr vk nw mOutFile ->
-    runGenesisAddrCmd vk nw mOutFile
-  GenesisCreate args ->
-    runGenesisCreateCmd args
-  GenesisCreateCardano args ->
-    runGenesisCreateCardanoCmd args
-  GenesisCreateStaked args ->
-    runGenesisCreateStakedCmd args
-  GenesisHashFile gf ->
-    runGenesisHashFileCmd gf
+  GenesisKeyGenGenesis args -> runGenesisKeyGenGenesisCmd args
+  GenesisKeyGenDelegate args -> runGenesisKeyGenDelegateCmd args
+  GenesisKeyGenUTxO args -> runGenesisKeyGenUTxOCmd args
+  GenesisCmdKeyHash vk -> runGenesisKeyHashCmd vk
+  GenesisVerKey args -> runGenesisVerKeyCmd args
+  GenesisTxIn args -> runGenesisTxInCmd args
+  GenesisAddr args -> runGenesisAddrCmd args
+  GenesisCreate args -> runGenesisCreateCmd args
+  GenesisCreateCardano args -> runGenesisCreateCardanoCmd args
+  GenesisCreateStaked args -> runGenesisCreateStakedCmd args
+  GenesisHashFile gf -> runGenesisHashFileCmd gf
 
 runGenesisKeyGenGenesisCmd
   :: GenesisKeyGenGenesisCmdArgs
@@ -296,11 +285,14 @@ runGenesisKeyHashCmd vkeyPath = do
                               . verificationKeyHash
 
 
-runGenesisVerKeyCmd ::
-     VerificationKeyFile Out
-  -> SigningKeyFile In
+runGenesisVerKeyCmd
+  :: GenesisVerKeyCmdArgs
   -> ExceptT GenesisCmdError IO ()
-runGenesisVerKeyCmd vkeyPath skeyPath = do
+runGenesisVerKeyCmd
+    Cmd.GenesisVerKeyCmdArgs
+    { Cmd.verificationKeyPath
+    , Cmd.signingKeyPath
+    } = do
     skey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $
             readFileTextEnvelopeAnyOf
               [ FromSomeType (AsSigningKey AsGenesisKey)
@@ -310,7 +302,7 @@ runGenesisVerKeyCmd vkeyPath skeyPath = do
               , FromSomeType (AsSigningKey AsGenesisUTxOKey)
                              AGenesisUTxOKey
               ]
-              skeyPath
+              signingKeyPath
 
     let vkey :: SomeGenesisKey VerificationKey
         vkey = case skey of
@@ -320,36 +312,42 @@ runGenesisVerKeyCmd vkeyPath skeyPath = do
 
     firstExceptT GenesisCmdGenesisFileError . newExceptT . liftIO $
       case vkey of
-        AGenesisKey         vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk
-        AGenesisDelegateKey vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk
-        AGenesisUTxOKey     vk -> writeLazyByteStringFile vkeyPath $ textEnvelopeToJSON Nothing vk
+        AGenesisKey         vk -> writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON Nothing vk
+        AGenesisDelegateKey vk -> writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON Nothing vk
+        AGenesisUTxOKey     vk -> writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON Nothing vk
 
 data SomeGenesisKey f
      = AGenesisKey         (f GenesisKey)
      | AGenesisDelegateKey (f GenesisDelegateKey)
      | AGenesisUTxOKey     (f GenesisUTxOKey)
 
 
-runGenesisTxInCmd ::
-     VerificationKeyFile In
-  -> NetworkId
-  -> Maybe (File () Out)
+runGenesisTxInCmd
+  :: GenesisTxInCmdArgs
   -> ExceptT GenesisCmdError IO ()
-runGenesisTxInCmd vkeyPath network mOutFile = do
+runGenesisTxInCmd
+    Cmd.GenesisTxInCmdArgs
+    { Cmd.verificationKeyPath
+    , Cmd.network
+    , Cmd.mOutFile
+    } = do
     vkey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $
-            readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath
+            readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) verificationKeyPath
     let txin = genesisUTxOPseudoTxIn network (verificationKeyHash vkey)
     liftIO $ writeOutput mOutFile (renderTxIn txin)
 
 
-runGenesisAddrCmd ::
-     VerificationKeyFile In
-  -> NetworkId
-  -> Maybe (File () Out)
+runGenesisAddrCmd
+  :: GenesisAddrCmdArgs
   -> ExceptT GenesisCmdError IO ()
-runGenesisAddrCmd vkeyPath network mOutFile = do
+runGenesisAddrCmd
+    Cmd.GenesisAddrCmdArgs
+    { Cmd.verificationKeyPath
+    , Cmd.network
+    , Cmd.mOutFile
+    } = do
     vkey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $
-            readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) vkeyPath
+            readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) verificationKeyPath
     let vkh  = verificationKeyHash (castVerificationKey vkey)
         addr = makeShelleyAddress network (PaymentCredentialByKey vkh)
                                   NoStakeAddress

cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs

@@ -12,14 +12,15 @@ module Cardano.CLI.Legacy.Run.Genesis
 import           Cardano.Api
 
 import           Cardano.Chain.Common (BlockCount)
+import           Cardano.CLI.EraBased.Commands.Genesis
+                   (GenesisKeyGenGenesisCmdArgs (GenesisKeyGenGenesisCmdArgs))
+import qualified Cardano.CLI.EraBased.Commands.Genesis as Cmd
 import           Cardano.CLI.EraBased.Run.Genesis
 import           Cardano.CLI.Legacy.Commands.Genesis
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.GenesisCmdError
 
 import           Control.Monad.Trans.Except (ExceptT)
-import qualified Cardano.CLI.EraBased.Commands.Genesis as Cmd
-import Cardano.CLI.EraBased.Commands.Genesis (GenesisKeyGenGenesisCmdArgs(GenesisKeyGenGenesisCmdArgs))
 
 runLegacyGenesisCmds :: LegacyGenesisCmds -> ExceptT GenesisCmdError IO ()
 runLegacyGenesisCmds = \case
@@ -83,21 +84,38 @@ runLegacyGenesisVerKeyCmd ::
      VerificationKeyFile Out
   -> SigningKeyFile In
   -> ExceptT GenesisCmdError IO ()
-runLegacyGenesisVerKeyCmd = runGenesisVerKeyCmd
+runLegacyGenesisVerKeyCmd vk sk =
+  runGenesisVerKeyCmd
+    Cmd.GenesisVerKeyCmdArgs
+      { Cmd.verificationKeyPath = vk
+      , Cmd.signingKeyPath = sk
+      }
 
 runLegacyGenesisTxInCmd :: ()
   => VerificationKeyFile In
   -> NetworkId
   -> Maybe (File () Out)
   -> ExceptT GenesisCmdError IO ()
-runLegacyGenesisTxInCmd = runGenesisTxInCmd
+runLegacyGenesisTxInCmd vkt nid mOf =
+  runGenesisTxInCmd
+    Cmd.GenesisTxInCmdArgs
+      { Cmd.verificationKeyPath = vkt
+      , Cmd.network = nid
+      , Cmd.mOutFile = mOf
+      }
 
 runLegacyGenesisAddrCmd :: ()
   => VerificationKeyFile In
   -> NetworkId
   -> Maybe (File () Out)
   -> ExceptT GenesisCmdError IO ()
-runLegacyGenesisAddrCmd = runGenesisAddrCmd
+runLegacyGenesisAddrCmd vkf nid mOf =
+  runGenesisAddrCmd
+    Cmd.GenesisAddrCmdArgs
+      { Cmd.verificationKeyPath = vkf
+      , Cmd.network = nid
+      , Cmd.mOutFile = mOf
+      }
 
 runLegacyGenesisCreateCmd :: ()
   => KeyOutputFormat