inital attempt

IntersectMBO · Jul 2, 2024 · 91b34dc · 91b34dc
1 parent 2006e3b
commit 91b34dc
Show file tree

Hide file tree

Showing 7 changed files with 15 additions and 14 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs
@@ -180,7 +180,7 @@ pTransactionBuildCmd era envCli = do
                       Nothing
                       "Filepath of auxiliary script(s)")
           <*> many pMetadataFile
-          <*> pFeatured (shelleyBasedToCardanoEra sbe) (optional pUpdateProposalFile)
+          <*> pFeatured (toCardanoEra sbe) (optional pUpdateProposalFile)
           <*> pVoteFiles sbe AutoBalance
           <*> pProposalFiles sbe AutoBalance
           <*> pTreasuryDonation sbe
@@ -235,7 +235,7 @@ pTransactionBuildEstimateCmd era _envCli = do
                       Nothing
                       "Filepath of auxiliary script(s)")
           <*> many pMetadataFile
-          <*> pFeatured (shelleyBasedToCardanoEra sbe) (optional pUpdateProposalFile)
+          <*> pFeatured (toCardanoEra sbe) (optional pUpdateProposalFile)
           <*> pVoteFiles sbe ManualBalance
           <*> pProposalFiles sbe ManualBalance
           <*> pCurrentTreasuryValue sbe

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs
@@ -195,7 +195,7 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
   , numUtxoKeys
   , totalSupply
   , delegatedSupply
-   , relays
+  , relays
   , systemStart
   , outputDir
   } = do

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs
@@ -401,7 +401,7 @@ runGenesisCreateCardanoCmd
     overrideShelleyGenesis t = t
       { sgNetworkMagic = unNetworkMagic (toNetworkMagic network)
       , sgNetworkId = toShelleyNetwork network
-      , sgActiveSlotsCoeff = fromMaybe (error $ "Could not convert from Rational: " ++ show slotCoeff) $ L.boundRational slotCoeff
+      , sgActiveSlotsCoeff = unsafeBoundedRational slotCoeff
       , sgSecurityParam = unBlockCount security
       , sgUpdateQuorum = fromIntegral $ ((numGenesisKeys `div` 3) * 2) + 1
       , sgEpochLength = EpochSize $ floor $ (fromIntegral (unBlockCount security) * 10) / slotCoeff

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
@@ -170,11 +170,11 @@ runQueryProtocolParametersCmd
     , Cmd.mOutFile
     } = do
   let localNodeConnInfo = LocalNodeConnectInfo consensusModeParams networkId nodeSocketPath
-  AnyCardanoEra era <- firstExceptT QueryCmdAcquireFailure $ newExceptT $ determineEra localNodeConnInfo
+  AnyCardanoEra era <- firstExceptT QueryCmdAcquireFailure $ determineEra localNodeConnInfo
   sbe <- forEraInEon @ShelleyBasedEra era (left QueryCmdByronEra) pure
   let qInMode = QueryInEra $ QueryInShelleyBasedEra sbe Api.QueryProtocolParameters
-  pp <- firstExceptT QueryCmdConvenienceError
-          . newExceptT $ executeQueryAnyMode localNodeConnInfo qInMode
+  pp <- modifyError QueryCmdConvenienceError $
+    executeQueryAnyMode localNodeConnInfo qInMode
   writeProtocolParameters sbe mOutFile pp
   where
     writeProtocolParameters
@@ -654,8 +654,8 @@ runQueryTxMempoolCmd
 
   localQuery <- case query of
       TxMempoolQueryTxExists tx -> do
-        AnyCardanoEra era <- lift (determineEra localNodeConnInfo)
-          & onLeft (left . QueryCmdAcquireFailure)
+        AnyCardanoEra era <- determineEra localNodeConnInfo
+          & modifyError QueryCmdAcquireFailure
         pure $ LocalTxMonitoringQueryTx $ TxIdInMode era tx
       TxMempoolQueryNextTx -> pure LocalTxMonitoringSendNextTx
       TxMempoolQueryInfo -> pure LocalTxMonitoringMempoolInformation

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -131,7 +131,7 @@ runTransactionBuildCmd
       , treasuryDonation
       , buildOutputOptions
       } = shelleyBasedEraConstraints eon $ do
-  let era = shelleyBasedToCardanoEra eon
+  let era = toCardanoEra eon
 
   -- The user can specify an era prior to the era that the node is currently in.
   -- We cannot use the user specified era to construct a query against a node because it may differ
@@ -766,7 +766,7 @@ runTxBuild
 
   -- TODO: All functions should be parameterized by ShelleyBasedEra
   -- as it's not possible to call this function with ByronEra
-  let era = shelleyBasedToCardanoEra sbe
+  let era = toCardanoEra sbe
       inputsThatRequireWitnessing = [input | (input,_) <- inputsAndMaybeScriptWits]
 
   let allReferenceInputs = getAllReferenceInputs
@@ -1078,7 +1078,7 @@ toTxAlonzoDatum supp cliDatum =
       sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile
       pure (TxOutDatumInTx supp sData)
     TxOutInlineDatumByValue sDataOrFile -> do
-      let cEra = alonzoEraOnwardsToCardanoEra supp
+      let cEra = toCardanoEra supp
       forEraInEon cEra (txFeatureMismatch cEra TxFeatureInlineDatums) $ \babbageOnwards -> do
         sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile
         pure $ TxOutDatumInline babbageOnwards sData
@@ -1521,7 +1521,7 @@ runTransactionSignWitnessCmd
                 lift (readFileTxKeyWitness file) & onLeft (left . TxCmdCddlWitnessError)
 
               case testEquality era era' of
-                Nothing   -> left $ TxCmdWitnessEraMismatch (AnyCardanoEra $ shelleyBasedToCardanoEra era) (AnyCardanoEra $ shelleyBasedToCardanoEra era') witnessFile
+                Nothing   -> left $ TxCmdWitnessEraMismatch (AnyCardanoEra $ toCardanoEra era) (AnyCardanoEra $ toCardanoEra era') witnessFile
                 Just Refl -> return witness
           | witnessFile@(WitnessFile file) <- witnessFiles ]
 

diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Transaction.hs
@@ -103,7 +103,7 @@ runLegacyTransactionBuildCmd
     outputOptions = do
 
   mUpdateProposalFile <-
-    validateUpdateProposalFile (shelleyBasedToCardanoEra sbe) mUpdateProposal
+    validateUpdateProposalFile (toCardanoEra sbe) mUpdateProposal
       & hoistEither
       & firstExceptT TxCmdNotSupportedInEraValidationError
 

diff --git a/cardano-cli/src/Cardano/CLI/Run/Debug/LogEpochState.hs b/cardano-cli/src/Cardano/CLI/Run/Debug/LogEpochState.hs
@@ -28,6 +28,7 @@ runLogEpochStateCmd
   LBS.appendFile outputFilePath ""
 
   result <- runExceptT $ foldEpochState
+    AlonzoEraOnwardsConway -- FIXME: get this from somewhere, prolly query the node beforehand for an era
     configurationFile
     nodeSocketPath
     Api.QuickValidation