Merge pull request #467 from input-output-hk/jordan/byron-isolation-2…

…-of-n-final

Byron isolation 2 of n

cabal.project

@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2023-11-09T23:50:15Z
-  , cardano-haskell-packages 2023-11-17T15:33:21Z
+  , cardano-haskell-packages 2023-11-21T19:00:47Z
 
 packages:
   cardano-cli

cardano-cli/cardano-cli.cabal

@@ -206,7 +206,7 @@ library
                       , binary
                       , bytestring
                       , canonical-json
-                      , cardano-api ^>= 8.33.0.0
+                      , cardano-api ^>= 8.34.0.0
                       , cardano-binary
                       , cardano-crypto
                       , cardano-crypto-class ^>= 2.1.2

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

@@ -9,7 +9,7 @@ module Cardano.CLI.Byron.Run
   ) where
 
 import           Cardano.Api hiding (GenesisParameters, UpdateProposal)
-import           Cardano.Api.Byron (SomeByronSigningKey (..), Tx (..))
+import           Cardano.Api.Byron (SomeByronSigningKey (..))
 
 import qualified Cardano.Chain.Genesis as Genesis
 import           Cardano.CLI.Byron.Commands
@@ -178,9 +178,8 @@ runSubmitTx nodeSocketPath network fp = do
 runGetTxId :: TxFile In -> ExceptT ByronClientCmdError IO ()
 runGetTxId fp = firstExceptT ByronCmdTxError $ do
     tx <- readByronTx fp
-    let txbody = getTxBody (ByronTx ByronEraOnlyByron tx)
-        txid   = getTxId txbody
-    liftIO $ BS.putStrLn $ serialiseToRawBytesHex txid
+    let txId = getTxIdByron tx
+    liftIO . BS.putStrLn $ serialiseToRawBytesHex txId
 
 runSpendGenesisUTxO
   :: GenesisFile

cardano-cli/src/Cardano/CLI/Byron/Tx.hs

@@ -27,6 +27,8 @@ where
 
 import           Cardano.Api
 import           Cardano.Api.Byron
+import qualified Cardano.Api.Byron as Api
+import qualified Cardano.Api.Ledger as L
 import           Cardano.Api.Pretty
 
 import qualified Cardano.Binary as Binary
@@ -87,6 +89,7 @@ prettyAddress (ByronAddress addr) = sformat
   (Common.addressF % "\n" % Common.addressDetailedF)
   addr addr
 
+-- TODO: Move to cardano-api
 readByronTx :: TxFile In -> ExceptT ByronTxError IO (UTxO.ATxAux ByteString)
 readByronTx (File fp) = do
   txBS <- liftIO $ LB.readFile fp
@@ -147,37 +150,12 @@ txSpendGenesisUTxOByronPBFT
   -> Address ByronAddr
   -> [TxOut CtxTx ByronEra]
   -> Tx ByronEra
-txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs = do
-    let txBodyCont =
-          TxBodyContent
-            { txIns =
-                [ (fromByronTxIn txIn, BuildTxWith (KeyWitness KeyWitnessForSpending))
-                ]
-            , txInsCollateral = TxInsCollateralNone
-            , txInsReference = TxInsReferenceNone
-            , txOuts = outs
-            , txTotalCollateral = TxTotalCollateralNone
-            , txReturnCollateral = TxReturnCollateralNone
-            , txFee = TxFeeImplicit ByronEraOnlyByron
-            , txValidityLowerBound = TxValidityNoLowerBound
-            , txValidityUpperBound = defaultTxValidityUpperBound ByronEra
-            , txMetadata = TxMetadataNone
-            , txAuxScripts = TxAuxScriptsNone
-            , txExtraKeyWits = TxExtraKeyWitnessesNone
-            , txProtocolParams = BuildTxWith Nothing
-            , txWithdrawals = TxWithdrawalsNone
-            , txCertificates = TxCertificatesNone
-            , txUpdateProposal = TxUpdateProposalNone
-            , txMintValue = TxMintNone
-            , txScriptValidity = TxScriptValidityNone
-            , txProposalProcedures = Nothing
-            , txVotingProcedures = Nothing
-            }
-
-    case createAndValidateTransactionBody ByronEra txBodyCont of
+txSpendGenesisUTxOByronPBFT gc nId sk (ByronAddress bAddr) outs =
+    let txins = [(fromByronTxIn txIn, BuildTxWith (KeyWitness KeyWitnessForSpending))]
+    in case makeByronTransactionBody txins outs of
       Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err
       Right txBody -> let bWit = fromByronWitness sk nId txBody
-                      in makeSignedTransaction [bWit] txBody
+                      in Api.ByronTx ByronEraOnlyByron $ makeSignedByronTransaction [bWit] txBody
   where
     ByronVerificationKey vKey = byronWitnessToVerKey sk
 
@@ -193,40 +171,15 @@ txSpendUTxOByronPBFT
   -> [TxOut CtxTx ByronEra]
   -> Tx ByronEra
 txSpendUTxOByronPBFT nId sk txIns outs = do
-  let txBodyCont =
-        TxBodyContent
-          { txIns =
-              [ ( txIn
-                , BuildTxWith (KeyWitness KeyWitnessForSpending)
-                ) | txIn <- txIns
-              ]
-          , txInsCollateral = TxInsCollateralNone
-          , txInsReference = TxInsReferenceNone
-          , txOuts = outs
-          , txTotalCollateral = TxTotalCollateralNone
-          , txReturnCollateral = TxReturnCollateralNone
-          , txFee = TxFeeImplicit ByronEraOnlyByron
-          , txValidityLowerBound = TxValidityNoLowerBound
-          , txValidityUpperBound = defaultTxValidityUpperBound ByronEra
-          , txMetadata = TxMetadataNone
-          , txAuxScripts = TxAuxScriptsNone
-          , txExtraKeyWits = TxExtraKeyWitnessesNone
-          , txProtocolParams = BuildTxWith Nothing
-          , txWithdrawals = TxWithdrawalsNone
-          , txCertificates = TxCertificatesNone
-          , txUpdateProposal = TxUpdateProposalNone
-          , txMintValue = TxMintNone
-          , txScriptValidity = TxScriptValidityNone
-          , txProposalProcedures = Nothing
-          , txVotingProcedures = Nothing
-          }
+  let apiTxIns = [ ( txIn, BuildTxWith (KeyWitness KeyWitnessForSpending)) | txIn <- txIns]
 
-  case createAndValidateTransactionBody ByronEra txBodyCont of
+  case makeByronTransactionBody apiTxIns outs of
     Left err -> error $ "Error occurred while creating a Byron genesis based UTxO transaction: " <> show err
     Right txBody -> let bWit = fromByronWitness sk nId txBody
-                    in makeSignedTransaction [bWit] txBody
+                    in Api.ByronTx ByronEraOnlyByron $ makeSignedByronTransaction [bWit] txBody
 
-fromByronWitness :: SomeByronSigningKey -> NetworkId -> TxBody ByronEra -> KeyWitness ByronEra
+fromByronWitness
+  :: SomeByronSigningKey -> NetworkId -> L.Annotated L.Tx ByteString -> KeyWitness ByronEra
 fromByronWitness bw nId txBody =
   case bw of
     AByronSigningKeyLegacy sk -> makeByronKeyWitness nId txBody sk

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

@@ -123,5 +123,5 @@ pCmds era envCli =
     , fmap StakeAddressCmds <$> pStakeAddressCmds (toCardanoEra era) envCli
     , fmap StakePoolCmds    <$> pStakePoolCmds (toCardanoEra era) envCli
     , fmap TextViewCmds     <$> pTextViewCmds
-    , fmap TransactionCmds  <$> pTransactionCmds (toCardanoEra era) envCli
+    , fmap TransactionCmds  <$> pTransactionCmds era envCli
     ]

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

@@ -42,7 +42,7 @@ data TransactionCmds era
   | TransactionViewCmd                !TransactionViewCmdArgs
 
 data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
-  { eon                   :: !(CardanoEra era)
+  { eon                   :: !(ShelleyBasedEra era)
   , mScriptValidity       :: !(Maybe ScriptValidity)
     -- ^ Mark script as expected to pass or fail validation
   , txIns                 :: ![(TxIn, Maybe (ScriptWitnessFiles WitCtxTxIn))]

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

@@ -2078,36 +2078,33 @@ pLegacyInvalidHereafter =
     ]
 
 pInvalidHereafter :: ()
-  => CardanoEra era
+  => ShelleyBasedEra era
   -> Parser (TxValidityUpperBound era)
-pInvalidHereafter =
-  caseByronOrShelleyBasedEra
-    (pure . TxValidityNoUpperBound)
-    (\eon ->
-      fmap (TxValidityUpperBound eon) $ asum
-        [ fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
-          [ Opt.long "invalid-hereafter"
-          , Opt.metavar "SLOT"
-          , Opt.help "Time that transaction is valid until (in slots)."
-          ]
-        , fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
-          [ Opt.long "upper-bound"
-          , Opt.metavar "SLOT"
-          , Opt.help $ mconcat
-            [ "Time that transaction is valid until (in slots) "
-            , "(deprecated; use --invalid-hereafter instead)."
-            ]
-          , Opt.internal
-          ]
-        , fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
-          [ Opt.long "ttl"
-          , Opt.metavar "SLOT"
-          , Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
-          , Opt.internal
-          ]
-        , pure Nothing
+pInvalidHereafter eon =
+  fmap (TxValidityUpperBound eon) $ asum
+    [ fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
+      [ Opt.long "invalid-hereafter"
+      , Opt.metavar "SLOT"
+      , Opt.help "Time that transaction is valid until (in slots)."
+      ]
+    , fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
+      [ Opt.long "upper-bound"
+      , Opt.metavar "SLOT"
+      , Opt.help $ mconcat
+        [ "Time that transaction is valid until (in slots) "
+        , "(deprecated; use --invalid-hereafter instead)."
         ]
-    )
+      , Opt.internal
+      ]
+    , fmap (Just . SlotNo) $ Opt.option (bounded "SLOT") $ mconcat
+      [ Opt.long "ttl"
+      , Opt.metavar "SLOT"
+      , Opt.help "Time to live (in slots) (deprecated; use --invalid-hereafter instead)."
+      , Opt.internal
+      ]
+    , pure Nothing
+    ]
+
 
 pTxFee :: Parser Lovelace
 pTxFee =

cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs

@@ -281,7 +281,7 @@ pIntroducedInConwayPParams =
     <$> convertToLedger id (optional pPoolVotingThresholds)
     <*> convertToLedger id (optional pDRepVotingThresholds)
     <*> convertToLedger id (optional pMinCommitteeSize)
-    <*> convertToLedger id (optional pCommitteeTermLength)
+    <*> convertToLedger id (optional (fromIntegral . unEpochNo <$> pCommitteeTermLength))
     <*> convertToLedger id (optional pGovActionLifetime)
     <*> convertToLedger toShelleyLovelace (optional pGovActionDeposit)
     <*> convertToLedger toShelleyLovelace (optional pDRepDeposit)

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

@@ -25,7 +25,7 @@ import           Prettyprinter (line, pretty)
 {- HLINT ignore "Move brackets to avoid $" -}
 
 pTransactionCmds :: ()
-  => CardanoEra era
+  => ShelleyBasedEra era
   -> EnvCli
   -> Maybe (Parser (TransactionCmds era))
 pTransactionCmds era envCli =
@@ -78,17 +78,10 @@ pTransactionCmds era envCli =
         $ subParser "calculate-min-fee"
         $ Opt.info (pTransactionCalculateMinFee envCli)
         $ Opt.progDesc "Calculate the minimum fee for a transaction."
-    , caseByronOrShelleyBasedEra
-        (const Nothing)
-        (\sbe -> Just $ subParser "calculate-min-required-utxo"
-                      $ Opt.info (pTransactionCalculateMinReqUTxO sbe)
-                      $ Opt.progDesc "Calculate the minimum required UTxO for a transaction output."
-        )
-        era
-    , caseByronOrShelleyBasedEra
-        (const Nothing)
-        (Just . pCalculateMinRequiredUtxoBackwardCompatible)
-        era
+    , Just $ subParser "calculate-min-required-utxo"
+           $ Opt.info (pTransactionCalculateMinReqUTxO era)
+           $ Opt.progDesc "Calculate the minimum required UTxO for a transaction output."
+    , Just $ pCalculateMinRequiredUtxoBackwardCompatible era
     , Just
         $ subParser "hash-script-data"
         $ Opt.info pTxHashScriptData
@@ -140,12 +133,11 @@ pScriptValidity = asum
     ]
   ]
 
-pTransactionBuildCmd :: CardanoEra era -> EnvCli -> Maybe (Parser (TransactionCmds era))
+pTransactionBuildCmd :: ShelleyBasedEra era -> EnvCli -> Maybe (Parser (TransactionCmds era))
 pTransactionBuildCmd era envCli = do
-  w <- forEraMaybeEon era
   pure
     $ subParser "build"
-    $ Opt.info (pCmd w)
+    $ Opt.info (pCmd era)
     $ Opt.progDescDoc
     $ Just $ mconcat
         [ pretty @String "Build a balanced transaction (automatically calculates fees)"
@@ -178,7 +170,7 @@ pTransactionBuildCmd era envCli = do
           <*> pChangeAddress
           <*> optional (pMintMultiAsset AutoBalance)
           <*> optional pInvalidBefore
-          <*> pInvalidHereafter (shelleyBasedToCardanoEra sbe)
+          <*> pInvalidHereafter sbe
           <*> many (pCertificateFile AutoBalance)
           <*> many (pWithdrawal AutoBalance)
           <*> pTxMetadataJsonSchema
@@ -200,7 +192,7 @@ pChangeAddress =
     , Opt.help "Address where ADA in excess of the tx fee will go to."
     ]
 
-pTransactionBuildRaw :: CardanoEra era -> Parser (TransactionCmds era)
+pTransactionBuildRaw :: ShelleyBasedEra era -> Parser (TransactionCmds era)
 pTransactionBuildRaw era =
   fmap TransactionBuildRawCmd $
     TransactionBuildRawCmdArgs era