Merge pull request #1070 from IntersectMBO/mgalazyn/feature/add-more-compatible-commands

Add stake address registration and delegation certificate and stake pool delegation certificate to compatible commands

Author: carbolymer

cardano-cli/cardano-cli.cabal

@@ -68,6 +68,12 @@ library
     Cardano.CLI.Compatible.Governance.Run
     Cardano.CLI.Compatible.Option
     Cardano.CLI.Compatible.Run
+    Cardano.CLI.Compatible.StakeAddress.Command
+    Cardano.CLI.Compatible.StakeAddress.Option
+    Cardano.CLI.Compatible.StakeAddress.Run
+    Cardano.CLI.Compatible.StakePool.Command
+    Cardano.CLI.Compatible.StakePool.Option
+    Cardano.CLI.Compatible.StakePool.Run
     Cardano.CLI.Compatible.Transaction.Command
     Cardano.CLI.Compatible.Transaction.Option
     Cardano.CLI.Compatible.Transaction.Run
@@ -122,6 +128,7 @@ library
     Cardano.CLI.EraBased.StakeAddress.Option
     Cardano.CLI.EraBased.StakeAddress.Run
     Cardano.CLI.EraBased.StakePool.Command
+    Cardano.CLI.EraBased.StakePool.Internal.Metadata
     Cardano.CLI.EraBased.StakePool.Option
     Cardano.CLI.EraBased.StakePool.Run
     Cardano.CLI.EraBased.TextView.Command
@@ -361,7 +368,12 @@ test-suite cardano-cli-test
   build-tool-depends: tasty-discover:tasty-discover
   other-modules:
     Test.Cli.AddCostModels
+    Test.Cli.Certificates.StakePool
     Test.Cli.CheckNodeConfiguration
+    Test.Cli.Compatible.StakeAddress.DelegationCertificate
+    Test.Cli.Compatible.StakeAddress.RegistrationCertificate
+    Test.Cli.Compatible.StakePool.RegistrationCertificate
+    Test.Cli.Compatible.Transaction.Build
     Test.Cli.CreateCardano
     Test.Cli.CreateTestnetData
     Test.Cli.DRepMetadata
@@ -382,11 +394,9 @@ test-suite cardano-cli-test
     Test.Cli.Pioneers.Exercise5
     Test.Cli.Pioneers.Exercise6
     Test.Cli.Pipes
-    Test.Cli.Shelley.Certificates.StakePool
-    Test.Cli.Shelley.Run.Hash
-    Test.Cli.Shelley.Run.Query
-    Test.Cli.Shelley.Transaction.Build
-    Test.Cli.Shelley.Transaction.Compatible.Build
+    Test.Cli.Run.Hash
+    Test.Cli.Run.Query
+    Test.Cli.Transaction.Build
     Test.Cli.VerificationKey
 
   ghc-options:

cardano-cli/src/Cardano/CLI/Compatible/Command.hs

@@ -15,6 +15,8 @@ module Cardano.CLI.Compatible.Command
 where
 
 import Cardano.CLI.Compatible.Governance.Command
+import Cardano.CLI.Compatible.StakeAddress.Command
+import Cardano.CLI.Compatible.StakePool.Command
 import Cardano.CLI.Compatible.Transaction.Command
 
 import Data.Text
@@ -27,10 +29,14 @@ renderAnyCompatibleCommand = \case
   AnyCompatibleCommand cmd -> renderCompatibleCommand cmd
 
 data CompatibleCommand era
-  = CompatibleTransactionCmd (CompatibleTransactionCmds era)
+  = CompatibleTransactionCmds (CompatibleTransactionCmds era)
   | CompatibleGovernanceCmds (CompatibleGovernanceCmds era)
+  | CompatibleStakeAddressCmds (CompatibleStakeAddressCmds era)
+  | CompatibleStakePoolCmds (CompatibleStakePoolCmds era)
 
 renderCompatibleCommand :: CompatibleCommand era -> Text
 renderCompatibleCommand = \case
-  CompatibleTransactionCmd cmd -> renderCompatibleTransactionCmd cmd
+  CompatibleTransactionCmds cmd -> renderCompatibleTransactionCmd cmd
   CompatibleGovernanceCmds cmd -> renderCompatibleGovernanceCmds cmd
+  CompatibleStakeAddressCmds cmd -> renderCompatibleStakeAddressCmds cmd
+  CompatibleStakePoolCmds cmd -> renderCompatibleStakePoolCmds cmd

cardano-cli/src/Cardano/CLI/Compatible/Exception.hs

@@ -9,6 +9,7 @@ module Cardano.CLI.Compatible.Exception
   , throwCliError
   , fromEitherCli
   , fromEitherIOCli
+  , fromExceptTCli
   )
 where
 
@@ -25,8 +26,8 @@ type CIO e a = HasCallStack => RIO e a
 -- in `cardano-cl` should be wrapped in this exception type.
 data CustomCliException where
   CustomCliException
-    :: (HasCallStack, Show error, Typeable error, Error error)
-    => error -> CustomCliException
+    :: (HasCallStack, Show err, Typeable err, Error err)
+    => err -> CustomCliException
 
 deriving instance Show CustomCliException
 
@@ -37,13 +38,34 @@ instance Exception CustomCliException where
       , prettyCallStack callStack
       ]
 
-throwCliError :: MonadIO m => CustomCliException -> m a
-throwCliError = throwIO
+-- | Wrapper function which allows throwing of types of instance `Error`, attaching call stack
+-- from the call site
+throwCliError
+  :: forall e m a
+   . (HasCallStack, Show e, Typeable e, Error e, MonadIO m)
+  => e
+  -> m a
+throwCliError = withFrozenCallStack $ throwIO . CustomCliException
 
-fromEitherCli :: (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => Either e a -> m a
+fromEitherCli
+  :: forall e m a
+   . (HasCallStack, MonadIO m, Show e, Typeable e, Error e)
+  => Either e a
+  -> m a
 fromEitherCli = withFrozenCallStack $ \case
-  Left e -> throwCliError $ CustomCliException e
+  Left e -> throwCliError e
   Right a -> return a
 
-fromEitherIOCli :: (HasCallStack, MonadIO m, Show e, Typeable e, Error e) => IO (Either e a) -> m a
-fromEitherIOCli action = liftIO action >>= fromEitherCli
+fromEitherIOCli
+  :: forall e m a
+   . (HasCallStack, MonadIO m, Show e, Typeable e, Error e)
+  => IO (Either e a)
+  -> m a
+fromEitherIOCli action = withFrozenCallStack $ liftIO action >>= fromEitherCli
+
+fromExceptTCli
+  :: forall e m a
+   . (HasCallStack, MonadIO m, Show e, Typeable e, Error e)
+  => ExceptT e IO a
+  -> m a
+fromExceptTCli = withFrozenCallStack $ fromEitherIOCli . runExceptT

cardano-cli/src/Cardano/CLI/Compatible/Governance/Run.hs

@@ -1,17 +1,16 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Cardano.CLI.Compatible.Governance.Run
   ( runCompatibleGovernanceCmds
   )
 where
 
-import Cardano.Api
-
+import Cardano.CLI.Compatible.Exception
 import Cardano.CLI.Compatible.Governance.Command
 import Cardano.CLI.EraBased.Governance.Run
-import Cardano.CLI.Type.Error.CmdError
 
-runCompatibleGovernanceCmds :: CompatibleGovernanceCmds era -> ExceptT CmdError IO ()
+runCompatibleGovernanceCmds :: CompatibleGovernanceCmds era -> CIO e ()
 runCompatibleGovernanceCmds = \case
-  CreateCompatibleProtocolUpdateCmd cmd -> runGovernanceCmds cmd
+  CreateCompatibleProtocolUpdateCmd cmd -> fromExceptTCli $ runGovernanceCmds cmd

cardano-cli/src/Cardano/CLI/Compatible/Option.hs

@@ -15,12 +15,15 @@ import Cardano.Api
 
 import Cardano.CLI.Compatible.Command
 import Cardano.CLI.Compatible.Governance.Option
+import Cardano.CLI.Compatible.StakeAddress.Option
+import Cardano.CLI.Compatible.StakePool.Option
 import Cardano.CLI.Compatible.Transaction.Option
 import Cardano.CLI.Environment
 import Cardano.CLI.Parser
 
-import Data.Foldable
-import Options.Applicative
+import Data.Foldable (asum)
+import Data.Maybe
+import Options.Applicative (Parser)
 import Options.Applicative qualified as Opt
 
 pAnyCompatibleCommand :: EnvCli -> Parser AnyCompatibleCommand
@@ -49,7 +52,10 @@ pAnyCompatibleCommand envCli =
 
 pCompatibleCommand :: ShelleyBasedEra era -> EnvCli -> Parser (CompatibleCommand era)
 pCompatibleCommand era env =
-  asum
-    [ CompatibleTransactionCmd <$> pAllCompatibleTransactionCommands env era
-    , CompatibleGovernanceCmds <$> pCompatibleGovernanceCmds era
-    ]
+  asum $
+    catMaybes
+      [ Just $ CompatibleTransactionCmds <$> pAllCompatibleTransactionCommands env era
+      , Just $ CompatibleGovernanceCmds <$> pCompatibleGovernanceCmds era
+      , fmap CompatibleStakeAddressCmds <$> pCompatibleStakeAddressCmds era
+      , fmap CompatibleStakePoolCmds <$> pCompatibleStakePoolCmds era env
+      ]

cardano-cli/src/Cardano/CLI/Compatible/Run.hs

@@ -3,37 +3,28 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.CLI.Compatible.Run
-  ( CompatibleCmdError
-  , renderCompatibleCmdError
-  , runAnyCompatibleCommand
+  ( runAnyCompatibleCommand
   , runCompatibleCommand
   )
 where
 
-import Cardano.Api
-
 import Cardano.CLI.Compatible.Command
+import Cardano.CLI.Compatible.Exception
 import Cardano.CLI.Compatible.Governance.Run
+import Cardano.CLI.Compatible.StakeAddress.Run
+import Cardano.CLI.Compatible.StakePool.Run
 import Cardano.CLI.Compatible.Transaction.Run
-import Cardano.CLI.Render
-import Cardano.CLI.Type.Error.CmdError
-
-import RIO
-
-data CompatibleCmdError
-  = CompatibleTransactionError CompatibleTransactionError
-  | CompatibleGovernanceError CmdError
-
-renderCompatibleCmdError :: Text -> CompatibleCmdError -> Doc ann
-renderCompatibleCmdError cmdText = \case
-  CompatibleTransactionError e -> renderAnyCmdError cmdText prettyError e
-  CompatibleGovernanceError e -> renderCmdError cmdText e
 
-runAnyCompatibleCommand :: AnyCompatibleCommand -> ExceptT CompatibleCmdError IO ()
+runAnyCompatibleCommand :: AnyCompatibleCommand -> CIO e ()
 runAnyCompatibleCommand (AnyCompatibleCommand cmd) = runCompatibleCommand cmd
 
-runCompatibleCommand :: CompatibleCommand era -> ExceptT CompatibleCmdError IO ()
-runCompatibleCommand (CompatibleTransactionCmd txCmd) =
-  runRIO () (runCompatibleTransactionCmd txCmd)
-runCompatibleCommand (CompatibleGovernanceCmds govCmd) =
-  firstExceptT CompatibleGovernanceError $ runCompatibleGovernanceCmds govCmd
+runCompatibleCommand :: CompatibleCommand era -> CIO e ()
+runCompatibleCommand = \case
+  CompatibleTransactionCmds txCmd ->
+    runCompatibleTransactionCmd txCmd
+  CompatibleGovernanceCmds govCmd ->
+    runCompatibleGovernanceCmds govCmd
+  CompatibleStakeAddressCmds stakeAddressCmd ->
+    runCompatibleStakeAddressCmds stakeAddressCmd
+  CompatibleStakePoolCmds stakePoolCmd ->
+    runCompatibleStakePoolCmds stakePoolCmd

cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Command.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Cardano.CLI.Compatible.StakeAddress.Command
+  ( CompatibleStakeAddressCmds (..)
+  , renderCompatibleStakeAddressCmds
+  )
+where
+
+import Cardano.Api.Ledger (Coin)
+import Cardano.Api.Shelley
+
+import Cardano.CLI.Type.Key
+
+import Prelude
+
+import Data.Text (Text)
+
+data CompatibleStakeAddressCmds era
+  = CompatibleStakeAddressRegistrationCertificateCmd
+      (ShelleyBasedEra era)
+      StakeIdentifier
+      (Maybe (Featured ConwayEraOnwards era Coin))
+      -- ^ Deposit required in conway era
+      (File () Out)
+  | CompatibleStakeAddressStakeDelegationCertificateCmd
+      (ShelleyBasedEra era)
+      StakeIdentifier
+      (VerificationKeyOrHashOrFile StakePoolKey)
+      (File () Out)
+  deriving Show
+
+renderCompatibleStakeAddressCmds :: CompatibleStakeAddressCmds era -> Text
+renderCompatibleStakeAddressCmds =
+  (<>) "stake-address " . \case
+    CompatibleStakeAddressRegistrationCertificateCmd{} -> "registration-certificate"
+    CompatibleStakeAddressStakeDelegationCertificateCmd{} -> "stake-delegation-certificate"

cardano-cli/src/Cardano/CLI/Compatible/StakeAddress/Option.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+
+module Cardano.CLI.Compatible.StakeAddress.Option
+  ( pCompatibleStakeAddressCmds
+  )
+where
+
+import Cardano.Api
+
+import Cardano.CLI.Compatible.StakeAddress.Command
+import Cardano.CLI.EraBased.Common.Option
+import Cardano.CLI.Parser
+
+import Options.Applicative
+import Options.Applicative qualified as Opt
+
+pCompatibleStakeAddressCmds
+  :: ()
+  => ShelleyBasedEra era
+  -> Maybe (Parser (CompatibleStakeAddressCmds era))
+pCompatibleStakeAddressCmds era =
+  subInfoParser
+    "stake-address"
+    ( Opt.progDesc $
+        mconcat
+          [ "Stake address commands."
+          ]
+    )
+    [ Just $ pStakeAddressRegistrationCertificateCmd era
+    , Just $ pStakeAddressStakeDelegationCertificateCmd era
+    ]
+
+pStakeAddressRegistrationCertificateCmd
+  :: ()
+  => ShelleyBasedEra era
+  -> Parser (CompatibleStakeAddressCmds era)
+pStakeAddressRegistrationCertificateCmd sbe = do
+  subParser "registration-certificate" $
+    Opt.info
+      ( CompatibleStakeAddressRegistrationCertificateCmd sbe
+          <$> pStakeIdentifier Nothing
+          <*> pFeatured (toCardanoEra sbe) pKeyRegistDeposit
+          <*> pOutputFile
+      )
+      desc
+ where
+  desc = Opt.progDesc "Create a stake address registration certificate"
+
+pStakeAddressStakeDelegationCertificateCmd
+  :: ()
+  => ShelleyBasedEra era
+  -> Parser (CompatibleStakeAddressCmds era)
+pStakeAddressStakeDelegationCertificateCmd sbe = do
+  subParser "stake-delegation-certificate"
+    $ Opt.info
+      ( CompatibleStakeAddressStakeDelegationCertificateCmd sbe
+          <$> pStakeIdentifier Nothing
+          <*> pStakePoolVerificationKeyOrHashOrFile Nothing
+          <*> pOutputFile
+      )
+    $ Opt.progDesc
+    $ mconcat
+      [ "Create a stake address stake delegation certificate, which when submitted in a transaction "
+      , "delegates stake to a stake pool."
+      ]