stuff

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
@@ -43,9 +43,3 @@ write-ghc-environment-files: always
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
-
-source-repository-package
-  type: git
-  location: https://github.com/input-output-hk/cardano-api
-  tag: c27daab1cf43fbe1cd5fca47fafcfeef0cab053e
-  subdir: cardano-api

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

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 =

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

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

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

cardano-cli/test/cardano-cli-test/Test/Cli/MultiAssetParsing.hs

@@ -5,20 +5,21 @@ module Test.Cli.MultiAssetParsing
   , hprop_roundtrip_Value_parse_renderPretty
   ) where
 
-import           Cardano.Api (parseValue, renderValue, renderValuePretty, valueToList)
+import           Cardano.Api (MaryEraOnwards (..), ShelleyBasedEra (..), fromLedgerValue,
+                   parseValue, renderValue, renderValuePretty)
 
 import qualified Data.Text as Text
 import qualified Text.Parsec as Parsec (parse)
 
 import           Test.Gen.Cardano.Api.Typed (genValueDefault)
 
 import           Hedgehog (Property, forAll, property, tripping)
-import qualified Hedgehog.Gen as Gen
 
 hprop_roundtrip_Value_parse_render :: Property
 hprop_roundtrip_Value_parse_render =
   property $ do
-    value <- forAll $ Gen.filter (not . null . valueToList) genValueDefault
+    ledgerValue <- forAll $ genValueDefault MaryEraOnwardsConway
+    let value = fromLedgerValue ShelleyBasedEraConway ledgerValue
     tripping
       value
       renderValue
@@ -27,7 +28,8 @@ hprop_roundtrip_Value_parse_render =
 hprop_roundtrip_Value_parse_renderPretty :: Property
 hprop_roundtrip_Value_parse_renderPretty =
   property $ do
-    value <- forAll $ Gen.filter (not . null . valueToList) genValueDefault
+    ledgerValue <- forAll $ genValueDefault MaryEraOnwardsConway
+    let value = fromLedgerValue ShelleyBasedEraConway ledgerValue
     tripping
       value
       renderValuePretty