Use ledger presentation of multi-asset values directly. Lens to make this uniform over ShelleyBasedEra

cardano-api/cardano-api.cabal

@@ -62,7 +62,6 @@ library internal
                         Cardano.Api.Eon.AlonzoEraOnwards
                         Cardano.Api.Eon.BabbageEraOnwards
                         Cardano.Api.Eon.ByronEraOnly
-                        Cardano.Api.Eon.ByronToAllegraEra
                         Cardano.Api.Eon.ByronToAlonzoEra
                         Cardano.Api.Eon.ConwayEraOnwards
                         Cardano.Api.Eon.MaryEraOnwards
@@ -170,6 +169,7 @@ library internal
                       , errors
                       , filepath
                       , formatting
+                      , groups
                       , iproute
                       , memory
                       , microlens
@@ -223,6 +223,7 @@ library
                         -- exposed by cardano-api-ledger
                         Cardano.Api.Ledger
 
+  reexported-modules:   Cardano.Api.Ledger.Lens
 
   build-depends:        bytestring
                       , cardano-api:internal

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -133,6 +133,8 @@ import           Cardano.Api.Byron (KeyWitness (ByronKeyWitness),
 import           Cardano.Api.Governance.Actions.VotingProcedure
 import           Cardano.Api.Script (scriptInEraToRefScript)
 import           Cardano.Api.Shelley
+import qualified Cardano.Api.Ledger as L
+import qualified Cardano.Api.Ledger.Lens as A
 
 import qualified Cardano.Binary as CBOR
 import qualified Cardano.Crypto.Hash as Crypto
@@ -340,9 +342,8 @@ genPolicyId =
     ]
 
 genAssetId :: Gen AssetId
-genAssetId = Gen.choice [ AssetId <$> genPolicyId <*> genAssetName
-                        , return AdaAssetId
-                        ]
+genAssetId =
+  AssetId <$> genPolicyId <*> genAssetName
 
 genQuantity :: Range Integer -> Gen Quantity
 genQuantity range = fromInteger <$> Gen.integral range
@@ -364,34 +365,42 @@ genUnsignedQuantity = genQuantity (Range.constant 0 2)
 genPositiveQuantity :: Gen Quantity
 genPositiveQuantity = genQuantity (Range.constant 1 2)
 
-genValue :: Gen AssetId -> Gen Quantity -> Gen Value
-genValue genAId genQuant =
-  valueFromList <$>
+genValue :: MaryEraOnwards era -> Gen AssetId -> Gen Quantity -> Gen (L.Value (ShelleyLedgerEra era))
+genValue w genAId genQuant =
+  toLedgerValue w . valueFromList <$>
     Gen.list (Range.constant 0 10)
              ((,) <$> genAId <*> genQuant)
 
 -- | Generate a 'Value' with any asset ID and a positive or negative quantity.
-genValueDefault :: Gen Value
-genValueDefault = genValue genAssetId genSignedNonZeroQuantity
+genValueDefault :: MaryEraOnwards era -> Gen (L.Value (ShelleyLedgerEra era))
+genValueDefault w = genValue w genAssetId genSignedNonZeroQuantity
 
 -- | Generate a 'Value' suitable for minting, i.e. non-ADA asset ID and a
 -- positive or negative quantity.
-genValueForMinting :: Gen Value
-genValueForMinting = genValue genAssetIdNoAda genSignedNonZeroQuantity
+genValueForMinting :: MaryEraOnwards era -> Gen Value
+genValueForMinting w =
+  fromLedgerValue sbe <$> genValue w genAssetIdNoAda genSignedNonZeroQuantity
   where
+    sbe = maryEraOnwardsToShelleyBasedEra w
     genAssetIdNoAda :: Gen AssetId
     genAssetIdNoAda = AssetId <$> genPolicyId <*> genAssetName
 
 -- | Generate a 'Value' suitable for usage in a transaction output, i.e. any
 -- asset ID and a positive quantity.
-genValueForTxOut :: Gen Value
-genValueForTxOut = do
-  -- Generate a potentially empty list with multi assets
-  val <- genValue genAssetId genPositiveQuantity
+genValueForTxOut :: ShelleyBasedEra era -> Gen (L.Value (ShelleyLedgerEra era))
+genValueForTxOut sbe = do
   -- Generate at least one positive ADA, without it Value in TxOut makes no sense
   -- and will fail deserialization starting with ConwayEra
-  ada <- (,) AdaAssetId <$> genPositiveQuantity
-  pure $ valueFromList (ada : valueToList val)
+  ada <- A.mkAdaValue sbe . L.Coin <$> Gen.integral (Range.constant 1 2)
+
+  -- Generate a potentially empty list with multi assets
+  caseShelleyToAllegraOrMaryEraOnwards
+    (const (pure ada))
+    (\w -> do
+      v <- genValue w genAssetId genPositiveQuantity
+      pure $ ada <> v
+    )
+    sbe
 
 
 -- Note that we expect to sometimes generate duplicate policy id keys since we
@@ -497,9 +506,9 @@ genTxIndex = TxIx . fromIntegral <$> Gen.word16 Range.constantBounded
 
 genTxOutValue :: CardanoEra era -> Gen (TxOutValue era)
 genTxOutValue =
-  caseByronToAllegraOrMaryEraOnwards
-    (\w -> TxOutAdaOnly w <$> genPositiveLovelace)
-    (\w -> TxOutValue w <$> genValueForTxOut)
+  caseByronOrShelleyBasedEra
+    (\w -> TxOutValueByron w <$> genPositiveLovelace)
+    (\sbe -> TxOutValueShelleyBased sbe <$> genValueForTxOut sbe)
 
 genTxOutTxContext :: CardanoEra era -> Gen (TxOut CtxTx era)
 genTxOutTxContext era =
@@ -617,12 +626,12 @@ genTxUpdateProposal sbe =
 
 genTxMintValue :: CardanoEra era -> Gen (TxMintValue BuildTx era)
 genTxMintValue =
-  caseByronToAllegraOrMaryEraOnwards
-    (const (pure TxMintNone))
+  inEonForEra
+    (pure TxMintNone)
     (\supported ->
       Gen.choice
         [ pure TxMintNone
-        , TxMintValue supported <$> genValueForMinting <*> return (BuildTxWith mempty)
+        , TxMintValue supported <$> genValueForMinting supported <*> return (BuildTxWith mempty)
         ]
     )
 

cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs

@@ -78,6 +78,7 @@ type AllegraEraOnwardsConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.AllegraEraTxBody (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs

@@ -88,6 +88,7 @@ type AlonzoEraOnwardsConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto

cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs

@@ -84,6 +84,7 @@ type BabbageEraOnwardsConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto

cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs

@@ -87,6 +87,7 @@ type ConwayEraOnwardsConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto

cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs

@@ -78,6 +78,7 @@ type MaryEraOnwardsConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.MaryEraTxBody (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs

@@ -48,6 +48,7 @@ import qualified Cardano.Ledger.BaseTypes as L
 import           Cardano.Ledger.Binary (FromCBOR)
 import qualified Cardano.Ledger.Core as L
 import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
 import           Ouroboros.Consensus.Shelley.Eras as Consensus (StandardAllegra, StandardAlonzo,
@@ -204,6 +205,8 @@ type ShelleyBasedEraConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)
   , L.ShelleyEraTxCert (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs

@@ -72,6 +72,7 @@ type ShelleyEraOnlyConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.ExactEra L.ShelleyEra (ShelleyLedgerEra era)
   , L.ExactEra L.ShelleyEra (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto

cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs

@@ -75,6 +75,7 @@ type ShelleyToAllegraEraConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.ProtVerAtMost (ShelleyLedgerEra era) 4

cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs

@@ -77,6 +77,7 @@ type ShelleyToAlonzoEraConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.ProtVerAtMost (ShelleyLedgerEra era) 6
   , L.ProtVerAtMost (ShelleyLedgerEra era) 8

cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs

@@ -79,6 +79,7 @@ type ShelleyToBabbageEraConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.ProtVerAtMost (ShelleyLedgerEra era) 8
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)

cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs

@@ -75,6 +75,7 @@ type ShelleyToMaryEraConstraints era =
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraTxOut (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.ProtVerAtMost (ShelleyLedgerEra era) 4
   , L.ProtVerAtMost (ShelleyLedgerEra era) 6

cardano-api/internal/Cardano/Api/Eras.hs

@@ -42,7 +42,6 @@ module Cardano.Api.Eras
   , caseByronOrShelleyBasedEra
 
     -- ** Case on ShelleyBasedEra
-  , caseByronToAllegraOrMaryEraOnwards
   , caseByronToAlonzoOrBabbageEraOnwards
   , caseShelleyToAllegraOrMaryEraOnwards
   , caseShelleyToMaryOrAlonzoEraOnwards

cardano-api/internal/Cardano/Api/Eras/Case.hs

@@ -7,7 +7,6 @@
 module Cardano.Api.Eras.Case
   ( -- Case on CardanoEra
     caseByronOrShelleyBasedEra
-  , caseByronToAllegraOrMaryEraOnwards
   , caseByronToAlonzoOrBabbageEraOnwards
 
     -- Case on ShelleyBasedEra
@@ -22,7 +21,6 @@ module Cardano.Api.Eras.Case
   , disjointByronEraOnlyAndShelleyBasedEra
 
     -- Conversions
-  , shelleyToAllegraEraToByronToAllegraEra
   , shelleyToAlonzoEraToShelleyToBabbageEra
   , alonzoEraOnwardsToMaryEraOnwards
   , babbageEraOnwardsToMaryEraOnwards
@@ -33,7 +31,6 @@ import           Cardano.Api.Eon.AllegraEraOnwards
 import           Cardano.Api.Eon.AlonzoEraOnwards
 import           Cardano.Api.Eon.BabbageEraOnwards
 import           Cardano.Api.Eon.ByronEraOnly
-import           Cardano.Api.Eon.ByronToAllegraEra
 import           Cardano.Api.Eon.ByronToAlonzoEra
 import           Cardano.Api.Eon.ConwayEraOnwards
 import           Cardano.Api.Eon.MaryEraOnwards
@@ -60,22 +57,6 @@ caseByronOrShelleyBasedEra l r = \case
   BabbageEra -> r ShelleyBasedEraBabbage
   ConwayEra  -> r ShelleyBasedEraConway
 
--- | @caseByronToAllegraOrMaryEraOnwards f g era@ applies @f@ to byron, shelley, and allegra;
--- and @g@ to mary and later eras.
-caseByronToAllegraOrMaryEraOnwards :: ()
-  => (ByronToAllegraEraConstraints era => ByronToAllegraEra era -> a)
-  -> (MaryEraOnwardsConstraints era => MaryEraOnwards era -> a)
-  -> CardanoEra era
-  -> a
-caseByronToAllegraOrMaryEraOnwards l r = \case
-  ByronEra   -> l ByronToAllegraEraByron
-  ShelleyEra -> l ByronToAllegraEraShelley
-  AllegraEra -> l ByronToAllegraEraAllegra
-  MaryEra    -> r MaryEraOnwardsMary
-  AlonzoEra  -> r MaryEraOnwardsAlonzo
-  BabbageEra -> r MaryEraOnwardsBabbage
-  ConwayEra  -> r MaryEraOnwardsConway
-
 -- | @caseByronToAlonzoOrBabbageEraOnwards f g era@ applies @f@ to byron, shelley, allegra, mary, and alonzo;
 -- and @g@ to babbage and later eras.
 caseByronToAlonzoOrBabbageEraOnwards :: ()
@@ -174,11 +155,6 @@ noByronEraInShelleyBasedEra = flip disjointByronEraOnlyAndShelleyBasedEra
 disjointByronEraOnlyAndShelleyBasedEra :: ByronEraOnly era -> ShelleyBasedEra era -> a
 disjointByronEraOnlyAndShelleyBasedEra ByronEraOnlyByron sbe = case sbe of {}
 
-shelleyToAllegraEraToByronToAllegraEra :: ShelleyToAllegraEra era -> ByronToAllegraEra era
-shelleyToAllegraEraToByronToAllegraEra = \case
-  ShelleyToAllegraEraShelley -> ByronToAllegraEraShelley
-  ShelleyToAllegraEraAllegra -> ByronToAllegraEraAllegra
-
 shelleyToAlonzoEraToShelleyToBabbageEra :: ()
   => ShelleyToAlonzoEra era
   -> ShelleyToBabbageEra era