Constraint legacy parser to be Shelley->Alonzo

IntersectMBO · Oct 13, 2023 · 4eb0fdb · 4eb0fdb
1 parent c00e8af
commit 4eb0fdb
Show file tree

Hide file tree

Showing 5 changed files with 38 additions and 22 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
@@ -16,7 +16,7 @@ import qualified Cardano.Api.Ledger as Ledger
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.Environment (EnvCli (..), envCliAnyShelleyBasedEra,
-                   envCliAnyShelleyToBabbageEra)
+                   envCliAnyShelleyToAlonzoEra, envCliAnyShelleyToBabbageEra)
 import           Cardano.CLI.Parser
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
@@ -64,6 +64,9 @@ defaultShelleyBasedEra = EraInEon ShelleyBasedEraBabbage
 defaultShelleyToBabbageEra :: EraInEon ShelleyToBabbageEra
 defaultShelleyToBabbageEra = EraInEon ShelleyToBabbageEraBabbage
 
+defaultShelleyToAlonzoEra :: EraInEon ShelleyToAlonzoEra
+defaultShelleyToAlonzoEra = EraInEon ShelleyToAlonzoEraAlonzo
+
 command' :: String -> String -> Parser a -> Mod CommandFields a
 command' c descr p =
   mconcat
@@ -347,6 +350,22 @@ pAnyShelleyToBabbageEra envCli =
     , pure $ pure defaultShelleyToBabbageEra
   ]
 
+pAnyShelleyToAlonzoEra :: EnvCli -> Parser (EraInEon ShelleyToAlonzoEra)
+pAnyShelleyToAlonzoEra envCli =
+  asum $ mconcat
+    [ [ Opt.flag' (EraInEon ShelleyToAlonzoEraShelley)
+        $ mconcat [Opt.long "shelley-era", Opt.help "Specify the Shelley era"]
+      , Opt.flag' (EraInEon ShelleyToAlonzoEraAllegra)
+        $ mconcat [Opt.long "allegra-era", Opt.help "Specify the Allegra era"]
+      , Opt.flag' (EraInEon ShelleyToAlonzoEraMary)
+        $ mconcat [Opt.long "mary-era", Opt.help "Specify the Mary era"]
+      , Opt.flag' (EraInEon ShelleyToAlonzoEraAlonzo)
+        $ mconcat [Opt.long "alonzo-era", Opt.help "Specify the Alonzo era"]
+      ]
+    , maybeToList $ pure <$> envCliAnyShelleyToAlonzoEra envCli
+    , pure $ pure defaultShelleyToAlonzoEra
+  ]
+
 pShelleyBasedShelley :: EnvCli -> Parser (EraInEon ShelleyBasedEra)
 pShelleyBasedShelley envCli =
   asum $ mconcat

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run.hs
@@ -74,6 +74,15 @@ runCmds = \case
     runTransactionCmds cmd
       & firstExceptT CmdTransactionError
 
+-- TODO smelc Move me to cardano-api. Or is there an other way? I'd be surprised
+-- this is the first time we need this.
+shelleyToAlonzoEraToShelleyToBabbageEra :: ShelleyToAlonzoEra era -> ShelleyToBabbageEra era
+shelleyToAlonzoEraToShelleyToBabbageEra = \case
+  ShelleyToAlonzoEraShelley -> ShelleyToBabbageEraShelley
+  ShelleyToAlonzoEraAllegra -> ShelleyToBabbageEraAllegra
+  ShelleyToAlonzoEraMary -> ShelleyToBabbageEraMary
+  ShelleyToAlonzoEraAlonzo -> ShelleyToBabbageEraAlonzo
+
 runGovernanceCmds :: ()
   => GovernanceCmds era
   -> ExceptT CmdError IO ()
@@ -87,8 +96,8 @@ runGovernanceCmds = \case
       & firstExceptT CmdGovernanceCmdError
 
   GovernanceGenesisKeyDelegationCertificate sta genVk genDelegVk vrfVk out ->
-    let sbe = shelleyToAlonzoEraToShelleyBasedEra sta in
-    runGovernanceGenesisKeyDelegationCertificate sbe genVk genDelegVk vrfVk out
+    let stb = shelleyToAlonzoEraToShelleyToBabbageEra sta in
+    runGovernanceGenesisKeyDelegationCertificate stb genVk genDelegVk vrfVk out
       & firstExceptT CmdGovernanceCmdError
 
   GovernanceCommitteeCmds cmds ->

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/GenesisKeyDelegationCertificate.hs
@@ -16,13 +16,13 @@ import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra
 
 runGovernanceGenesisKeyDelegationCertificate
-  :: ShelleyBasedEra era
+  :: ShelleyToBabbageEra era
   -> VerificationKeyOrHashOrFile GenesisKey
   -> VerificationKeyOrHashOrFile GenesisDelegateKey
   -> VerificationKeyOrHashOrFile VrfKey
   -> File () Out
   -> ExceptT GovernanceCmdError IO ()
-runGovernanceGenesisKeyDelegationCertificate sbe
+runGovernanceGenesisKeyDelegationCertificate stb
                                              genVkOrHashOrFp
                                              genDelVkOrHashOrFp
                                              vrfVkOrHashOrFp
@@ -37,26 +37,14 @@ runGovernanceGenesisKeyDelegationCertificate sbe
     . newExceptT
     $ readVerificationKeyOrHashOrFile AsVrfKey vrfVkOrHashOrFp
 
-  req <- hoistEither $ createGenesisDelegationRequirements sbe genesisVkHash genesisDelVkHash vrfVkHash
-  let genKeyDelegCert = makeGenesisKeyDelegationCertificate req
+  let req = GenesisKeyDelegationRequirements stb genesisVkHash genesisDelVkHash vrfVkHash
+      genKeyDelegCert = makeGenesisKeyDelegationCertificate req
 
   firstExceptT GovernanceCmdTextEnvWriteError
     . newExceptT
     $ writeLazyByteStringFile oFp
-    $ shelleyBasedEraConstraints sbe
+    $ shelleyBasedEraConstraints (shelleyToBabbageEraToShelleyBasedEra stb)
     $ textEnvelopeToJSON (Just genKeyDelegCertDesc) genKeyDelegCert
   where
     genKeyDelegCertDesc :: TextEnvelopeDescr
     genKeyDelegCertDesc = "Genesis Key Delegation Certificate"
-
-createGenesisDelegationRequirements
-  :: ShelleyBasedEra era
-  -> Hash GenesisKey
-  -> Hash GenesisDelegateKey
-  -> Hash VrfKey
-  -> Either GovernanceCmdError (GenesisKeyDelegationRequirements era)
-createGenesisDelegationRequirements sbe hGen hGenDeleg hVrf =
-  caseShelleyToBabbageOrConwayEraOnwards
-      (\eon -> return $ GenesisKeyDelegationRequirements eon hGen hGenDeleg hVrf)
-      (const $ Left GovernanceCmdGenesisDelegationNotSupportedInConway)
-      sbe
diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Commands/Governance.hs b/cardano-cli/src/Cardano/CLI/Legacy/Commands/Governance.hs
@@ -25,7 +25,7 @@ data LegacyGovernanceCmds
       (File () Out)
       TransferDirection
   | GovernanceGenesisKeyDelegationCertificate
-      (EraInEon ShelleyBasedEra)
+      (EraInEon ShelleyToBabbageEra)
       (VerificationKeyOrHashOrFile GenesisKey)
       (VerificationKeyOrHashOrFile GenesisDelegateKey)
       (VerificationKeyOrHashOrFile VrfKey)

diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Options.hs b/cardano-cli/src/Cardano/CLI/Legacy/Options.hs
@@ -854,7 +854,7 @@ pGovernanceCmds envCli =
     pGovernanceGenesisKeyDelegationCertificate :: Parser LegacyGovernanceCmds
     pGovernanceGenesisKeyDelegationCertificate =
       GovernanceGenesisKeyDelegationCertificate
-        <$> pAnyShelleyBasedEra envCli
+        <$> pAnyShelleyToBabbageEra envCli
         <*> pGenesisVerificationKeyOrHashOrFile
         <*> pGenesisDelegateVerificationKeyOrHashOrFile
         <*> pVrfVerificationKeyOrHashOrFile