Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update to cardano-8.31.0.0 #435

Merged
merged 3 commits into from
Nov 11, 2023
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/cardano-cli.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/src/Cardano/CLI/Byron/Parsers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
5 changes: 3 additions & 2 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
57 changes: 39 additions & 18 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -903,6 +922,7 @@ runTransactionSignCmd

firstExceptT TxCmdWriteFileError . newExceptT
$ writeLazyByteStringFile outTxFile
$ shelleyBasedEraConstraints sbe
$ textEnvelopeToJSON Nothing tx

-- ----------------------------------------------------------------------------
Expand Down Expand Up @@ -1201,6 +1221,7 @@ runTransactionWitnessCmd

firstExceptT TxCmdWriteFileError . newExceptT
$ writeLazyByteStringFile outFile
$ shelleyBasedEraConstraints sbe
$ textEnvelopeToJSON Nothing witness

runTransactionSignWitnessCmd :: ()
Expand Down
19 changes: 14 additions & 5 deletions cardano-cli/src/Cardano/CLI/Json/Friendly.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Original file line number Diff line number Diff line change
@@ -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
Original file line number Diff line number Diff line change
Expand Up @@ -2,4 +2,4 @@
"cborHex": "<cborHex>",
"description": "",
"type": "Governance proposal"
}
}
Original file line number Diff line number Diff line change
Expand Up @@ -2,4 +2,4 @@
"type": "CertificateShelley",
"description": "Vote Delegation Certificate",
"cborHex": "83098200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab018102"
}
}
Original file line number Diff line number Diff line change
Expand Up @@ -2,4 +2,4 @@
"type": "CertificateShelley",
"description": "Vote Delegation Certificate",
"cborHex": "83098200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab018103"
}
}
Original file line number Diff line number Diff line change
Expand Up @@ -2,4 +2,4 @@
"type": "CertificateShelley",
"description": "Stake and Vote Delegation Certificate",
"cborHex": "840a8200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab01581cc27cf021914a2b3bcb286d3d741979083422378c577fe757702b69888102"
}
}
Original file line number Diff line number Diff line change
Expand Up @@ -2,4 +2,4 @@
"type": "CertificateShelley",
"description": "Stake and Vote Delegation Certificate",
"cborHex": "840a8200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab01581cc27cf021914a2b3bcb286d3d741979083422378c577fe757702b69888200581ce68f9ee70599cb93d9f60678f9c6463c01938c27d9820c7bf93887a5"
}
}
Original file line number Diff line number Diff line change
Expand Up @@ -2,4 +2,4 @@
"type": "CertificateShelley",
"description": "Stake and Vote Delegation Certificate",
"cborHex": "840a8200581cef1785cf18928f8353c90e76b7a8fc60855472d31a0ea1c1c774ab01581cc27cf021914a2b3bcb286d3d741979083422378c577fe757702b69888103"
}
}
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,8 @@ mint: null
outputs:
- address: addr_test1vz7w0r9epak6nmnh3mc8e2ypkjyu8zsc3xf7dpct6k577acxmcfyv
address era: Shelley
amount: 31 Lovelace
amount:
lovelace: 31
network: Testnet
payment credential key hash: bce78cb90f6da9ee778ef07ca881b489c38a188993e6870bd5a9ef77
reference script: null
Expand Down
27 changes: 15 additions & 12 deletions cardano-cli/test/cardano-cli-test/Test/Cli/MultiAssetParsing.hs
Original file line number Diff line number Diff line change
@@ -1,33 +1,36 @@
{-# LANGUAGE OverloadedStrings #-}

module Test.Cli.MultiAssetParsing
( hprop_roundtrip_Value_parse_render
, hprop_roundtrip_Value_parse_renderPretty
) where
{- HLINT ignore "Use camelCase" -}

import Cardano.Api (parseValue, renderValue, renderValuePretty, valueToList)
module Test.Cli.MultiAssetParsing where

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 =
-- TODO enable these tests after switching completely to ledger types
disable_hprop_roundtrip_Value_parse_render :: Property
disable_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
(Parsec.parse parseValue "" . Text.unpack)

hprop_roundtrip_Value_parse_renderPretty :: Property
hprop_roundtrip_Value_parse_renderPretty =
-- TODO enable these tests after switching completely to ledger types
disable_hprop_roundtrip_Value_parse_renderPretty :: Property
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why can't we enable them now?

Copy link
Contributor Author

@newhoggy newhoggy Nov 11, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The tests fail like when Value is completely empty and the generators are now capable of generating completely empty values:

      ✗ Test.Cli.MultiAssetParsing.hprop_roundtrip_Value_parse_render failed at test/cardano-cli-test/Test/Cli/MultiAssetParsing.hs:23:5
        after 25 tests.
        shrink path: 25:
      
           ┏━━ test/cardano-cli-test/Test/Cli/MultiAssetParsing.hs ━━━
        18 ┃ hprop_roundtrip_Value_parse_render :: Property
        19 ┃ hprop_roundtrip_Value_parse_render =
        20 ┃   property $ do
        21 ┃     ledgerValue <- forAll $ genValueDefault MaryEraOnwardsConway
           ┃     │ MaryValue 0 (MultiAsset (fromList []))
        22 ┃     let value = fromLedgerValue ShelleyBasedEraConway ledgerValue
        23 ┃     tripping
           ┃     ^^^^^^^^
           ┃     │ ━━━ Original ━━━
           ┃     │ Right (valueFromList [])
           ┃     │ ━━━ Intermediate ━━━
           ┃     │ ""
           ┃     │ ━━━ Roundtrip ━━━
           ┃     │ Left (line 1, column 1):
           ┃     │ unexpected end of input
           ┃     │ expecting multi-asset value expression
        24 ┃       value
        25 ┃       renderValue
        26 ┃       (Parsec.parse parseValue "" . Text.unpack)
      
        This failure can be reproduced by running:
        > recheckAt (Seed 15168243033552485215 8658252526254707155) "25:" Test.Cli.MultiAssetParsing.hprop_roundtrip_Value_parse_render

Copy link
Contributor Author

@newhoggy newhoggy Nov 11, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I don't think we particularly care about empty Value, but for completeness, I think it good if the roundtrip worked for this edge case. This can be fixed in cardano-api.

But since we're going to delete Value anyway, it probably isn't worth the effort.

In fact, I will delete these tests because they don't belong here: They test nothing in cardano-cli. See the import list for verification.

These tests should instead be moved to cardano-api.

disable_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
Expand Down
6 changes: 3 additions & 3 deletions flake.lock

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.