Integrate Ledger-related changes

- Fix simple script decoding fallback for Conway
- Introduce transaction levels.
- Replace promoted constructors with types.
- Introduce CoinPerByte.
- Use StrictMaybe where necessary.
- `PoolParams` -> `StakePoolParams`

Author: geo2a

cardano-cli/cardano-cli.cabal

@@ -442,10 +442,8 @@ test-suite cardano-cli-golden
     cardano-cli,
     cardano-cli:cardano-cli-test-lib,
     cardano-crypto-wrapper,
-    cardano-ledger-core,
     cardano-strict-containers ^>=0.1,
     cborg,
-    containers,
     directory,
     exceptions,
     extra,

cardano-cli/src/Cardano/CLI/Compatible/Json/Friendly.hs

@@ -284,7 +284,7 @@ getScriptWitnessDetails era tb =
  where
   aeo = convert era
   friendlyRedeemers
-    :: Ledger.Tx (ShelleyLedgerEra era)
+    :: Ledger.Tx C.TopTx (ShelleyLedgerEra era)
     -> Aeson.Value
   friendlyRedeemers tx =
     alonzoEraOnwardsConstraints aeo $ do
@@ -293,7 +293,7 @@ getScriptWitnessDetails era tb =
       Aeson.Array $ Vector.fromList redeemerList
 
   friendlyRedeemerInfo
-    :: Ledger.Tx (ShelleyLedgerEra era)
+    :: Ledger.Tx C.TopTx (ShelleyLedgerEra era)
     -> Ledger.PlutusPurpose Ledger.AsIx (ShelleyLedgerEra era)
     -> (Ledger.Data (ShelleyLedgerEra era), ExUnits)
     -> Aeson.Value
@@ -373,7 +373,7 @@ getScriptWitnessDetails era tb =
   addLabelToPurpose Proposing pp = Aeson.object ["submitting a proposal following proposal policy" .= pp]
   addLabelToPurpose Guarding _ = error "TODO Dijkstra"
 
-  friendlyScriptData :: Ledger.Tx (ShelleyLedgerEra era) -> Aeson.Value
+  friendlyScriptData :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value
   friendlyScriptData tx =
     alonzoEraOnwardsConstraints aeo $ do
       Aeson.Array $
@@ -386,7 +386,7 @@ getScriptWitnessDetails era tb =
           | (scriptHash, scriptData) <- Map.toList $ tx ^. Ledger.witsTxL . Ledger.scriptTxWitsL
           ]
 
-  friendlyDats :: Ledger.Tx (ShelleyLedgerEra era) -> Aeson.Value
+  friendlyDats :: Ledger.Tx C.TopTx (ShelleyLedgerEra era) -> Aeson.Value
   friendlyDats tx =
     alonzoEraOnwardsConstraints aeo $
       let Ledger.TxDats dats = tx ^. Ledger.witsTxL . Ledger.datsTxWitsL
@@ -633,7 +633,7 @@ renderCertificate sbe (Exp.Certificate c) =
 
 renderDrepCredential
   :: ()
-  => L.Credential 'L.DRepRole
+  => L.Credential L.DRepRole
   -> Aeson.Value
 renderDrepCredential =
   object . \case

cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs

@@ -18,7 +18,7 @@ import Cardano.Api.Compatible.Certificate qualified as Compatible
 import Cardano.Api.Experimental (obtainCommonConstraints)
 import Cardano.Api.Experimental qualified as Exp
 import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp
-import Cardano.Api.Experimental.Plutus qualified as Exp
+import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus
 import Cardano.Api.Experimental.Tx qualified as Exp
 import Cardano.Api.Ledger qualified as L hiding
   ( VotingProcedures
@@ -158,9 +158,9 @@ readCertificateScriptWitnessSbe
       (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits)
     ) = do
     let plutusScriptFp = unFile scriptFp
-    Exp.AnyPlutusScript anyPlutusScript <- Compatible.readFilePlutusScript sbe plutusScriptFp
+    Exp.Plutus.AnyPlutusScript anyPlutusScript <- Compatible.readFilePlutusScript sbe plutusScriptFp
     let
-      lang = Exp.plutusScriptInEraSLanguage anyPlutusScript
+      lang = Exp.Plutus.plutusScriptInEraSLanguage anyPlutusScript
     let script' = Exp.PScript anyPlutusScript
 
     redeemer <-

cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs

@@ -21,7 +21,7 @@ import Cardano.Api
   )
 import Cardano.Api.Experimental qualified as Exp
 import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp
-import Cardano.Api.Experimental.Plutus qualified as Exp
+import Cardano.Api.Experimental.Plutus qualified as Exp.Plutus
 
 import Cardano.CLI.Compatible.Exception
 import Cardano.CLI.Compatible.Read (readFilePlutusScript, readFileSimpleScript)
@@ -68,8 +68,8 @@ readCertificateScriptWitness sbe certScriptReq =
     OnDiskPlutusScript
       (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do
         let plutusScriptFp = unFile scriptFp
-        Exp.AnyPlutusScript anyPlutusScript <- readFilePlutusScript sbe plutusScriptFp
-        let lang = Exp.plutusScriptInEraSLanguage anyPlutusScript
+        Exp.Plutus.AnyPlutusScript anyPlutusScript <- readFilePlutusScript sbe plutusScriptFp
+        let lang = Exp.Plutus.plutusScriptInEraSLanguage anyPlutusScript
             script' = Exp.PScript anyPlutusScript
         redeemer <-
           fromExceptTCli $

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

@@ -374,6 +374,13 @@ parseLovelace = do
     then fail $ show i <> " lovelace exceeds the Word64 upper bound"
     else return $ L.Coin i
 
+parseCoinPerByte :: P.Parser L.CoinPerByte
+parseCoinPerByte = do
+  i <- P.parseDecimal
+  case L.toCompact (Coin i) of
+    Nothing -> fail $ show i <> " lovelace exceeds the Word64 upper bound"
+    Just c -> pure . L.CoinPerByte $ c
+
 -- | The first argument is the optional prefix.
 pStakePoolVerificationKeyOrFile
   :: Maybe String
@@ -2712,9 +2719,9 @@ pCostModels =
       , Opt.completer (Opt.bashCompleter "file")
       ]
 
-pMinFeePerByteFactor :: Parser Lovelace
+pMinFeePerByteFactor :: Parser L.CoinPerByte
 pMinFeePerByteFactor =
-  Opt.option (readerFromParsecParser parseLovelace) $
+  Opt.option (readerFromParsecParser parseCoinPerByte) $
     mconcat
       [ Opt.long "min-fee-linear"
       , Opt.metavar "LOVELACE"
@@ -2935,9 +2942,9 @@ pExtraEntropy =
       . BSC.pack
       =<< some P.hexDigit
 
-pUTxOCostPerByte :: Parser Lovelace
+pUTxOCostPerByte :: Parser L.CoinPerByte
 pUTxOCostPerByte =
-  Opt.option (readerFromParsecParser parseLovelace) $
+  Opt.option (readerFromParsecParser parseCoinPerByte) $
     mconcat
       [ Opt.long "utxo-cost-per-byte"
       , Opt.metavar "LOVELACE"
@@ -3004,7 +3011,7 @@ pMaxBlockExecutionUnits =
           ]
       )
 
-pMaxValueSize :: Parser Natural
+pMaxValueSize :: Parser Word32
 pMaxValueSize =
   Opt.option integralReader $
     mconcat
@@ -3016,7 +3023,7 @@ pMaxValueSize =
             ]
       ]
 
-pCollateralPercent :: Parser Natural
+pCollateralPercent :: Parser Word16
 pCollateralPercent =
   Opt.option integralReader $
     mconcat
@@ -3030,7 +3037,7 @@ pCollateralPercent =
             ]
       ]
 
-pMaxCollateralInputs :: Parser Natural
+pMaxCollateralInputs :: Parser Word16
 pMaxCollateralInputs =
   Opt.option integralReader $
     mconcat
@@ -3208,7 +3215,7 @@ pDRepVotingThresholds =
         , Opt.help "Acceptance threshold for DRep votes on treasury withdrawals."
         ]
 
-pMinCommitteeSize :: Parser Natural
+pMinCommitteeSize :: Parser Word16
 pMinCommitteeSize =
   Opt.option integralReader $
     mconcat

cardano-cli/src/Cardano/CLI/EraBased/Genesis/CreateTestnetData/Run.hs

@@ -382,8 +382,8 @@ runGenesisCreateTestNetDataCmd
       addDRepsToConwayGenesis dRepKeys (map snd delegatorKeys) conwayGenesis
         <&> addCommitteeToConwayGenesis ccColdKeys
 
-    let stake = second L.ppId . mkDelegationMapEntry <$> delegations
-        stakePools = [(L.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations]
+    let stake = second L.sppId . mkDelegationMapEntry <$> delegations
+        stakePools = [(L.sppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations]
         delegAddrs = dInitialUtxoAddr <$> delegations
     !shelleyGenesis' <-
       fromExceptTCli $
@@ -447,7 +447,7 @@ runGenesisCreateTestNetDataCmd
     mkPoolDir idx = poolsDir </> ("pool" <> show idx)
 
     mkDelegationMapEntry
-      :: Delegation -> (L.KeyHash L.Staking, L.PoolParams)
+      :: Delegation -> (L.KeyHash L.Staking, L.StakePoolParams)
     mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d)
 
     addCommitteeToConwayGenesis
@@ -751,7 +751,7 @@ createPoolCredentials fmt dir = do
 data Delegation = Delegation
   { dInitialUtxoAddr :: !(AddressInEra ShelleyEra)
   , dDelegStaking :: !(L.KeyHash L.Staking)
-  , dPoolParams :: !L.PoolParams
+  , dPoolParams :: !L.StakePoolParams
   }
   deriving (Generic, NFData)
 
@@ -763,7 +763,7 @@ buildPoolParams
   -- ^ The index of the pool being built. Starts at 0.
   -> Map Word [L.StakePoolRelay]
   -- ^ User submitted stake pool relay map. Starts at 0
-  -> ExceptT GenesisCmdError IO L.PoolParams
+  -> ExceptT GenesisCmdError IO L.StakePoolParams
 buildPoolParams nw dir index specifiedRelays = do
   StakePoolVerificationKey poolColdVK <-
     firstExceptT (GenesisCmdStakePoolCmdError . StakePoolCmdReadFileError)
@@ -780,17 +780,17 @@ buildPoolParams nw dir index specifiedRelays = do
       $ readFileTextEnvelope poolRewardVKF
 
   pure
-    L.PoolParams
-      { L.ppId = L.hashKey poolColdVK
-      , L.ppVrf = C.hashVerKeyVRF @StandardCrypto poolVrfVK
-      , L.ppPledge = L.Coin 0
-      , L.ppCost = L.Coin 0
-      , L.ppMargin = minBound
-      , L.ppRewardAccount =
+    L.StakePoolParams
+      { L.sppId = L.hashKey poolColdVK
+      , L.sppVrf = C.hashVerKeyVRF @StandardCrypto poolVrfVK
+      , L.sppPledge = L.Coin 0
+      , L.sppCost = L.Coin 0
+      , L.sppMargin = minBound
+      , L.sppAccountAddress =
           toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK)
-      , L.ppOwners = mempty
-      , L.ppRelays = lookupPoolRelay specifiedRelays
-      , L.ppMetadata = L.SNothing
+      , L.sppOwners = mempty
+      , L.sppRelays = lookupPoolRelay specifiedRelays
+      , L.sppMetadata = L.SNothing
       }
  where
   lookupPoolRelay :: Map Word [L.StakePoolRelay] -> Seq.StrictSeq L.StakePoolRelay
@@ -812,7 +812,7 @@ computeInsecureStakeKeyAddr g0 = do
 computeDelegation
   :: NetworkId
   -> (VerificationKey PaymentKey, VerificationKey StakeKey)
-  -> L.PoolParams
+  -> L.StakePoolParams
   -> Delegation
 computeDelegation nw (paymentVK, stakeVK) dPoolParams = do
   let paymentCredential = PaymentCredentialByKey (verificationKeyHash paymentVK)
@@ -835,9 +835,9 @@ updateOutputTemplate
   -- ^ Total amount of lovelace
   -> [AddressInEra ShelleyEra]
   -- ^ UTxO addresses that are not delegating
-  -> [(L.KeyHash 'L.StakePool, L.PoolParams)]
+  -> [(L.KeyHash L.StakePool, L.StakePoolParams)]
   -- ^ Pool map
-  -> [(L.KeyHash 'L.Staking, L.KeyHash 'L.StakePool)]
+  -> [(L.KeyHash L.Staking, L.KeyHash L.StakePool)]
   -- ^ Delegaton map
   -> Maybe Lovelace
   -- ^ Amount of lovelace to delegate

cardano-cli/src/Cardano/CLI/EraBased/Genesis/Run.hs

@@ -681,8 +681,8 @@ runGenesisCreateStakedCmd
     stuffedUtxoAddrs <-
       liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ genStuffedAddress network
 
-    let stake = second L.ppId . mkDelegationMapEntry <$> delegations
-        stakePools = [(L.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations]
+    let stake = second L.sppId . mkDelegationMapEntry <$> delegations
+        stakePools = [(L.sppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations]
         delegAddrs = dInitialUtxoAddr <$> delegations
         !shelleyGenesis =
           updateOutputTemplate
@@ -740,7 +740,7 @@ runGenesisCreateStakedCmd
    where
     adjustTemplate t = t{sgNetworkMagic = unNetworkMagic (toNetworkMagic networkId)}
     mkDelegationMapEntry
-      :: Delegation -> (L.KeyHash L.Staking, L.PoolParams)
+      :: Delegation -> (L.KeyHash L.Staking, L.StakePoolParams)
     mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d)
 
 -- -------------------------------------------------------------------------------------------------
@@ -756,9 +756,9 @@ updateOutputTemplate
   -- ^ Number of UTxO addresses that are delegating
   -> [AddressInEra ShelleyEra]
   -- ^ UTxO addresses that are not delegating
-  -> [(L.KeyHash 'L.StakePool, L.PoolParams)]
+  -> [(L.KeyHash L.StakePool, L.StakePoolParams)]
   -- ^ Pool map
-  -> [(L.KeyHash 'L.Staking, L.KeyHash 'L.StakePool)]
+  -> [(L.KeyHash L.Staking, L.KeyHash L.StakePool)]
   -- ^ Delegaton map
   -> Maybe Lovelace
   -- ^ Amount of lovelace to delegate
@@ -939,7 +939,7 @@ createPoolCredentials fmt dir index = do
 data Delegation = Delegation
   { dInitialUtxoAddr :: !(AddressInEra ShelleyEra)
   , dDelegStaking :: !(L.KeyHash L.Staking)
-  , dPoolParams :: !L.PoolParams
+  , dPoolParams :: !L.StakePoolParams
   }
   deriving (Generic, NFData)
 
@@ -950,7 +950,7 @@ buildPoolParams
   -> Maybe Word
   -> Map Word [L.StakePoolRelay]
   -- ^ User submitted stake pool relay map
-  -> ExceptT GenesisCmdError IO L.PoolParams
+  -> ExceptT GenesisCmdError IO L.StakePoolParams
 buildPoolParams nw dir index specifiedRelays = do
   StakePoolVerificationKey poolColdVK <-
     firstExceptT (GenesisCmdStakePoolCmdError . StakePoolCmdReadFileError)
@@ -967,17 +967,17 @@ buildPoolParams nw dir index specifiedRelays = do
       $ readFileTextEnvelope @(VerificationKey StakeKey) poolRewardVKF
 
   pure
-    L.PoolParams
-      { L.ppId = L.hashKey poolColdVK
-      , L.ppVrf = C.hashVerKeyVRF @C.StandardCrypto poolVrfVK
-      , L.ppPledge = L.Coin 0
-      , L.ppCost = L.Coin 0
-      , L.ppMargin = minBound
-      , L.ppRewardAccount =
+    L.StakePoolParams
+      { L.sppId = L.hashKey poolColdVK
+      , L.sppVrf = C.hashVerKeyVRF @C.StandardCrypto poolVrfVK
+      , L.sppPledge = L.Coin 0
+      , L.sppCost = L.Coin 0
+      , L.sppMargin = minBound
+      , L.sppAccountAddress =
           toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK)
-      , L.ppOwners = mempty
-      , L.ppRelays = lookupPoolRelay specifiedRelays
-      , L.ppMetadata = L.SNothing
+      , L.sppOwners = mempty
+      , L.sppRelays = lookupPoolRelay specifiedRelays
+      , L.sppMetadata = L.SNothing
       }
  where
   lookupPoolRelay
@@ -1030,7 +1030,7 @@ writeBulkPoolCredentials dir bulkIx poolIxs = do
 computeInsecureDelegation
   :: StdGen
   -> NetworkId
-  -> L.PoolParams
+  -> L.StakePoolParams
   -> IO (StdGen, Delegation)
 computeInsecureDelegation g0 nw pool = do
   (paymentVK, g1) <- first getVerificationKey <$> generateInsecureSigningKey g0 AsPaymentKey
@@ -1080,7 +1080,7 @@ updateTemplate
   -- ^ Amount of lovelace not delegated
   -> [AddressInEra ShelleyEra]
   -- ^ UTxO addresses that are not delegating
-  -> Map (L.KeyHash 'L.Staking) L.PoolParams
+  -> Map (L.KeyHash L.Staking) L.StakePoolParams
   -- ^ Genesis staking: pools/delegation map & delegated initial UTxO spec
   -> Lovelace
   -- ^ Number of UTxO Addresses for delegation
@@ -1120,10 +1120,10 @@ updateTemplate
                 ShelleyGenesisStaking
                   { sgsPools =
                       fromList
-                        [ (L.ppId poolParams, poolParams)
+                        [ (L.sppId poolParams, poolParams)
                         | poolParams <- Map.elems poolSpecs
                         ]
-                  , sgsStake = ListMap.fromMap $ L.ppId <$> poolSpecs
+                  , sgsStake = ListMap.fromMap $ L.sppId <$> poolSpecs
                   }
             , sgProtocolParams = pparamsFromTemplate
             }

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

@@ -287,7 +287,7 @@ pAlonzoOnwardsPParams =
 pIntroducedInBabbagePParams :: Parser (IntroducedInBabbagePParams ledgerera)
 pIntroducedInBabbagePParams =
   IntroducedInBabbagePParams
-    <$> convertToLedger L.CoinPerByte (optional pUTxOCostPerByte)
+    <$> convertToLedger id (optional pUTxOCostPerByte)
 
 pIntroducedInConwayPParams :: Parser (IntroducedInConwayPParams ledgerera)
 pIntroducedInConwayPParams =

cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs

@@ -1051,7 +1051,7 @@ getQueryStakeAddressInfo
                           | gas <- toList govActionStates
                           , let proc = L.gasProposalProcedure gas
                           , let rewardAccount = L.pProcReturnAddr proc
-                                stakeCredential :: Api.StakeCredential = fromShelleyStakeCredential (rewardAccount ^. L.accountAddressCredentialL)
+                                stakeCredential :: Api.StakeCredential = fromShelleyStakeCredential ( rewardAccount ^. L.accountAddressCredentialL)
                           , stakeCredential == fromShelleyStakeCredential addr
                           ]
 
@@ -1818,10 +1818,10 @@ runQuerySPOStakeDistribution
     PoolState poolStateResult <-
       fromEitherCli $ decodePoolState (convert eon) serialisedPoolState
 
-    let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential 'L.Staking)
+    let spoToRewardCred :: Map (L.KeyHash L.StakePool) (L.Credential L.Staking)
         spoToRewardCred =
           Map.map
-            (L.raCredential . L.ppRewardAccount)
+            (\params -> L.sppAccountAddress params ^. L.accountAddressCredentialL)
             (L.qpsrStakePoolParams poolStateResult)
 
         allRewardCreds :: Set StakeCredential