Merge pull request #435 from input-output-hk/newhoggy/update-to-carda…

…no-8.31.0.0 Update to `cardano-8.31.0.0`
IntersectMBO · Nov 11, 2023 · bc40e38 · bc40e38
2 parents 8bde151 + 383dc19
commit bc40e38
Show file tree

Hide file tree

Showing 26 changed files with 145 additions and 150 deletions.
diff --git a/cabal.project b/cabal.project
@@ -14,7 +14,7 @@ repository cardano-haskell-packages
 -- you need to run if you change them
 index-state:
   , hackage.haskell.org 2023-08-08T19:56:09Z
-  , cardano-haskell-packages 2023-11-03T08:46:06Z
+  , cardano-haskell-packages 2023-11-10T12:47:36Z
 
 packages:
   cardano-cli

diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -202,7 +202,7 @@ library
                       , binary
                       , bytestring
                       , canonical-json
-                      , cardano-api ^>= 8.30.0.0
+                      , cardano-api ^>= 8.31.0.0
                       , cardano-binary
                       , cardano-crypto
                       , cardano-crypto-class ^>= 2.1.2
@@ -303,7 +303,6 @@ test-suite cardano-cli-test
                       , filepath
                       , hedgehog
                       , hedgehog-extras ^>= 0.4.7.0
-                      , parsec
                       , tasty
                       , tasty-hedgehog
                       , text
@@ -316,7 +315,6 @@ test-suite cardano-cli-test
                         Test.Cli.FilePermissions
                         Test.Cli.ITN
                         Test.Cli.JSON
-                        Test.Cli.MultiAssetParsing
                         Test.Cli.Pioneers.Exercise1
                         Test.Cli.Pioneers.Exercise2
                         Test.Cli.Pioneers.Exercise3

diff --git a/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs b/cardano-cli/src/Cardano/CLI/Byron/Parsers.hs
@@ -293,7 +293,7 @@ parseTxOut =
   pLovelaceTxOut l =
     if l > (maxBound :: Word64)
       then error $ show l <> " lovelace exceeds the Word64 upper bound"
-      else TxOutAdaOnly ByronToAllegraEraByron . Lovelace $ toInteger l
+      else TxOutValueByron ByronEraOnlyByron . Lovelace $ toInteger l
 
 readerFromAttoParser :: Atto.Parser a -> Opt.ReadM a
 readerFromAttoParser p =

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance/Actions.hs
@@ -239,7 +239,6 @@ pCommonProtocolParameters =
     <*> convertToLedger toNonNegativeIntervalOrErr (optional pPoolInfluence)
     <*> convertToLedger toUnitIntervalOrErr (optional pTreasuryExpansion)
     <*> convertToLedger toUnitIntervalOrErr (optional pMonetaryExpansion)
-    <*> convertToLedger mkProtocolVersionOrErr (optional pProtocolVersion)
     <*> convertToLedger toShelleyLovelace (optional pMinPoolCost)
 
 
@@ -248,6 +247,11 @@ pDeprecatedAfterMaryPParams =
   DeprecatedAfterMaryPParams
     <$> convertToLedger toShelleyLovelace (optional pMinUTxOValue)
 
+pDeprecatedAfterBabbagePParams :: Parser (DeprecatedAfterBabbagePParams ledgerera)
+pDeprecatedAfterBabbagePParams =
+  DeprecatedAfterBabbagePParams
+    <$> convertToLedger mkProtocolVersionOrErr (optional pProtocolVersion)
+
 pShelleyToAlonzoPParams :: Parser (ShelleyToAlonzoPParams ledgerera)
 pShelleyToAlonzoPParams =
   ShelleyToAlonzoPParams
@@ -294,26 +298,31 @@ dpGovActionProtocolParametersUpdate = \case
     ShelleyEraBasedProtocolParametersUpdate
       <$> pCommonProtocolParameters
       <*> pDeprecatedAfterMaryPParams
+      <*> pDeprecatedAfterBabbagePParams
       <*> pShelleyToAlonzoPParams
   ShelleyBasedEraAllegra ->
     AllegraEraBasedProtocolParametersUpdate
       <$> pCommonProtocolParameters
       <*> pDeprecatedAfterMaryPParams
       <*> pShelleyToAlonzoPParams
+      <*> pDeprecatedAfterBabbagePParams
   ShelleyBasedEraMary ->
     MaryEraBasedProtocolParametersUpdate
       <$> pCommonProtocolParameters
       <*> pDeprecatedAfterMaryPParams
       <*> pShelleyToAlonzoPParams
+      <*> pDeprecatedAfterBabbagePParams
   ShelleyBasedEraAlonzo ->
     AlonzoEraBasedProtocolParametersUpdate
       <$> pCommonProtocolParameters
       <*> pShelleyToAlonzoPParams
       <*> pAlonzoOnwardsPParams
+      <*> pDeprecatedAfterBabbagePParams
   ShelleyBasedEraBabbage ->
     BabbageEraBasedProtocolParametersUpdate
       <$> pCommonProtocolParameters
       <*> pAlonzoOnwardsPParams
+      <*> pDeprecatedAfterBabbagePParams
       <*> pIntroducedInBabbagePParams
   ShelleyBasedEraConway ->
     ConwayEraBasedProtocolParametersUpdate

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
@@ -1049,8 +1049,9 @@ printUtxo sbe txInOutTuple =
     in Text.pack $ replicate (max 1 (len - slen)) ' ' ++ str
 
   printableValue :: TxOutValue era -> Text
-  printableValue (TxOutValue _ val) = renderValue val
-  printableValue (TxOutAdaOnly _ (Lovelace i)) = Text.pack $ show i
+  printableValue = \case
+    TxOutValueByron _ (Lovelace i) -> Text.pack $ show i
+    TxOutValueShelleyBased sbe2 val -> renderValue $ Api.fromLedgerValue sbe2 val
 
 runQueryStakePoolsCmd :: ()
   => Cmd.QueryStakePoolsCmdArgs

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
@@ -689,18 +689,31 @@ toAddressInAnyEra era addrAny = runExcept $ do
 
       pure (AddressInEra (ShelleyAddressInEra sbe) sAddr)
 
+
+lovelaceToCoin :: Lovelace -> Ledger.Coin
+lovelaceToCoin (Lovelace ll) = Ledger.Coin ll
+
 toTxOutValueInAnyEra
   :: CardanoEra era
   -> Value
   -> Either TxCmdError (TxOutValue era)
 toTxOutValueInAnyEra era val =
-  caseByronToAllegraOrMaryEraOnwards
+  caseByronOrShelleyBasedEra
     (\w ->
       case valueToLovelace val of
-        Just l  -> return (TxOutAdaOnly w l)
+        Just l  -> return (TxOutValueByron w l)
         Nothing -> txFeatureMismatchPure era TxFeatureMultiAssetOutputs
     )
-    (\w -> return (TxOutValue w val))
+    (\sbe ->
+      caseShelleyToAllegraOrMaryEraOnwards
+        (\_ -> case valueToLovelace val of
+          Just l  -> return (TxOutValueShelleyBased sbe $ lovelaceToCoin l)
+          Nothing -> txFeatureMismatchPure era TxFeatureMultiAssetOutputs
+        )
+        (\w -> return (TxOutValueShelleyBased sbe (toLedgerValue w val))
+        )
+        sbe
+    )
     era
 
 toTxOutInAnyEra :: CardanoEra era
@@ -710,9 +723,12 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do
   addr <- hoistEither $ toAddressInAnyEra era addr'
   val <- hoistEither $ toTxOutValueInAnyEra era val'
 
-  datum <- caseByronToMaryOrAlonzoEraOnwards
+  datum <- caseByronOrShelleyBasedEra
     (const (pure TxOutDatumNone))
-    (\wa -> toTxAlonzoDatum wa mDatumHash)
+    (caseShelleyToMaryOrAlonzoEraOnwards
+      (const (pure TxOutDatumNone))
+      (\wa -> toTxAlonzoDatum wa mDatumHash)
+    )
     era
 
   refScript <- caseByronToAlonzoOrBabbageEraOnwards
@@ -763,24 +779,27 @@ createTxMintValue era (val, scriptWitnesses) =
   if List.null (valueToList val) && List.null scriptWitnesses
   then return TxMintNone
   else do
-    caseByronToAllegraOrMaryEraOnwards
+    caseByronOrShelleyBasedEra
       (const (txFeatureMismatchPure era TxFeatureMintValue))
-      (\w -> do
-        -- The set of policy ids for which we need witnesses:
-        let witnessesNeededSet :: Set PolicyId
-            witnessesNeededSet =
-              Set.fromList [ pid | (AssetId pid _, _) <- valueToList val ]
+      (caseShelleyToAllegraOrMaryEraOnwards
+        (const (txFeatureMismatchPure era TxFeatureMintValue))
+        (\w -> do
+          -- The set of policy ids for which we need witnesses:
+          let witnessesNeededSet :: Set PolicyId
+              witnessesNeededSet =
+                Set.fromList [ pid | (AssetId pid _, _) <- valueToList val ]
 
-        let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
-            witnessesProvidedMap = Map.fromList $ gatherMintingWitnesses scriptWitnesses
+          let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
+              witnessesProvidedMap = Map.fromList $ gatherMintingWitnesses scriptWitnesses
 
-            witnessesProvidedSet = Map.keysSet witnessesProvidedMap
+              witnessesProvidedSet = Map.keysSet witnessesProvidedMap
 
-        -- Check not too many, nor too few:
-        validateAllWitnessesProvided   witnessesNeededSet witnessesProvidedSet
-        validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet
+          -- Check not too many, nor too few:
+          validateAllWitnessesProvided   witnessesNeededSet witnessesProvidedSet
+          validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet
 
-        return (TxMintValue w val (BuildTxWith witnessesProvidedMap))
+          return (TxMintValue w val (BuildTxWith witnessesProvidedMap))
+        )
       )
       era
  where
@@ -903,6 +922,7 @@ runTransactionSignCmd
 
           firstExceptT TxCmdWriteFileError . newExceptT
             $ writeLazyByteStringFile outTxFile
+            $ shelleyBasedEraConstraints sbe
             $ textEnvelopeToJSON Nothing tx
 
 -- ----------------------------------------------------------------------------
@@ -1201,6 +1221,7 @@ runTransactionWitnessCmd
 
       firstExceptT TxCmdWriteFileError . newExceptT
         $ writeLazyByteStringFile outFile
+        $ shelleyBasedEraConstraints sbe
         $ textEnvelopeToJSON Nothing witness
 
 runTransactionSignWitnessCmd :: ()

diff --git a/cardano-cli/src/Cardano/CLI/Json/Friendly.hs b/cardano-cli/src/Cardano/CLI/Json/Friendly.hs
@@ -562,15 +562,24 @@ friendlyLovelace (Shelley.Coin value) = String $ textShow value <> " Lovelace"
 friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value
 friendlyMintValue = \case
   TxMintNone -> Null
-  TxMintValue _ v _ -> friendlyValue v
+  TxMintValue sbe v _ -> friendlyValue (maryEraOnwardsToShelleyBasedEra sbe) v
 
 friendlyTxOutValue :: TxOutValue era -> Aeson.Value
 friendlyTxOutValue = \case
-  TxOutAdaOnly _ lovelace -> friendlyLovelace $ toShelleyLovelace lovelace
-  TxOutValue _ v -> friendlyValue v
+  TxOutValueByron _ lovelace -> friendlyLovelace $ toShelleyLovelace lovelace
+  TxOutValueShelleyBased sbe v -> friendlyLedgerValue sbe v
 
-friendlyValue :: Api.Value -> Aeson.Value
-friendlyValue v =
+friendlyLedgerValue :: ()
+  => ShelleyBasedEra era
+  -> Ledger.Value (ShelleyLedgerEra era)
+  -> Aeson.Value
+friendlyLedgerValue sbe v = friendlyValue sbe $ Api.fromLedgerValue sbe v
+
+friendlyValue :: ()
+  => ShelleyBasedEra era
+  -> Api.Value
+  -> Aeson.Value
+friendlyValue _ v =
   object
     [ case bundle of
         ValueNestedBundleAda q -> "lovelace" .= q

diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/allegra/transaction-view.out
@@ -10,7 +10,8 @@ mint: null
 outputs:
 - address: addr_test1qrefnr4k09pvge6dq83v6s67ruter8sftmky8qrmkqqsxy7q5psgn8tgqmupq4r79jmxlyk4eqt6z6hj5g8jd8393msqaw47f4
   address era: Shelley
-  amount: 99 Lovelace
+  amount:
+    lovelace: 99
   network: Testnet
   payment credential key hash: f2998eb67942c4674d01e2cd435e1f17919e095eec43807bb0010313
   reference script: null

diff --git a/...rors.GovernanceVoteCmdError.GovernanceVoteCmdError/GovernanceVoteCmdReadVoteFileError.txt b/...rors.GovernanceVoteCmdError.GovernanceVoteCmdError/GovernanceVoteCmdReadVoteFileError.txt
@@ -1 +1 @@
-Cannot read vote file: path/file.txt: TextEnvelope aeson decode error: some error description
+Cannot read vote file: path/file.txt: TextEnvelope aeson decode error: some error description
diff --git a/...golden/files/golden/governance/action/create-constitution-for-stake-address.action.golden b/...golden/files/golden/governance/action/create-constitution-for-stake-address.action.golden
@@ -2,4 +2,4 @@
     "cborHex": "<cborHex>",
     "description": "",
     "type": "Governance proposal"
-}
+}
diff --git a/...-cli/test/cardano-cli-golden/files/golden/governance/stakeaddress/alwaysAbstainDeleg.cert b/...-cli/test/cardano-cli-golden/files/golden/governance/stakeaddress/alwaysAbstainDeleg.cert
@@ -2,4 +2,4 @@
     "type": "CertificateShelley",
     "description": "Vote Delegation Certificate",
     "cborHex": "83098200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab018102"
-}
+}
diff --git a/...o-cli/test/cardano-cli-golden/files/golden/governance/stakeaddress/noConfidenceDeleg.cert b/...o-cli/test/cardano-cli-golden/files/golden/governance/stakeaddress/noConfidenceDeleg.cert
@@ -2,4 +2,4 @@
     "type": "CertificateShelley",
     "description": "Vote Delegation Certificate",
     "cborHex": "83098200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab018103"
-}
+}
diff --git a/...st/cardano-cli-golden/files/golden/governance/stakeaddress/poolAndAlwaysAbstainDeleg.cert b/...st/cardano-cli-golden/files/golden/governance/stakeaddress/poolAndAlwaysAbstainDeleg.cert
@@ -2,4 +2,4 @@
     "type": "CertificateShelley",
     "description": "Stake and Vote Delegation Certificate",
     "cborHex": "840a8200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab01581cc27cf021914a2b3bcb286d3d741979083422378c577fe757702b69888102"
-}
+}
diff --git a/...li/test/cardano-cli-golden/files/golden/governance/stakeaddress/poolAndDrepVkeyDeleg.cert b/...li/test/cardano-cli-golden/files/golden/governance/stakeaddress/poolAndDrepVkeyDeleg.cert
@@ -2,4 +2,4 @@
     "type": "CertificateShelley",
     "description": "Stake and Vote Delegation Certificate",
     "cborHex": "840a8200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab01581cc27cf021914a2b3bcb286d3d741979083422378c577fe757702b69888200581ce68f9ee70599cb93d9f60678f9c6463c01938c27d9820c7bf93887a5"
-}
+}
diff --git a/...est/cardano-cli-golden/files/golden/governance/stakeaddress/poolAndNoConfidenceDeleg.cert b/...est/cardano-cli-golden/files/golden/governance/stakeaddress/poolAndNoConfidenceDeleg.cert
@@ -2,4 +2,4 @@
     "type": "CertificateShelley",
     "description": "Stake and Vote Delegation Certificate",
     "cborHex": "840a8200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab01581cc27cf021914a2b3bcb286d3d741979083422378c577fe757702b69888103"
-}
+}