Update to ghc@9.6.3, cardano-node@8.7.2, cardano-api@8.36.1.

Author: j-mueller

.github/workflows/ci-linux.yaml

@@ -83,7 +83,7 @@ jobs:
       - uses: haskell-actions/setup@v2
         id: setuphaskell
         with:
-          ghc-version: '9.2.8'
+          ghc-version: '9.6.3'
           cabal-version: '3.10.1.0'
 
       - name: Cache .cabal
@@ -100,8 +100,8 @@ jobs:
       - name: Build dependencies for integration test
         run: |
           cabal update
-          cabal install -j cardano-node-8.1.1 --overwrite-policy=always
-          cabal install -j cardano-cli-8.4.0.0 --overwrite-policy=always
+          cabal install -j cardano-node-8.7.2 --overwrite-policy=always
+          cabal install -j cardano-cli-8.17.0.0 --overwrite-policy=always
           cabal install -j convex-wallet --overwrite-policy=always
           echo "/home/runner/.cabal/bin" >> $GITHUB_PATH
 

cabal.project

@@ -1,9 +1,9 @@
 
 -- Custom repository for cardano haskell packages, see
--- https://github.com/input-output-hk/cardano-haskell-packages
+-- https://github.com/IntersectMBO/cardano-haskell-packages
 -- for more information.
 repository cardano-haskell-packages
-  url: https://input-output-hk.github.io/cardano-haskell-packages
+  url: https://chap.intersectmbo.org/
   secure: True
   root-keys:
     3e0cce471cf09815f930210f7827266fd09045445d65923e6d0238a6cd15126f
@@ -14,11 +14,14 @@ repository cardano-haskell-packages
     d4a35cd3121aa00d18544bb0ac01c3e1691d618f462c46129271bccf39f7e8ee
 
 index-state:
-  , hackage.haskell.org 2023-07-22T22:41:49Z
-  , cardano-haskell-packages 2023-07-26T01:36:26Z
+  , hackage.haskell.org 2023-11-20T23:52:53Z
+  , cardano-haskell-packages 2023-12-08T09:30:26Z
 
+with-compiler: ghc-9.6.3
 
-with-compiler: ghc-9.2.8
+constraints:
+  cardano-api == 8.36.1.1,
+  cardano-node == 8.7.2
 
 packages:
   src/base
@@ -27,10 +30,3 @@ packages:
   src/mockchain
   src/coin-selection
   src/devnet
-
--- https://github.com/obsidiansystems/dependent-sum-template/issues/5
--- requires cabal 3.10
-if impl(ghc >= 9.2)
-  constraints :
-      dependent-sum-template < 0.1.2
-

src/base/convex-base.cabal

@@ -54,7 +54,7 @@ library
       either-result
 
     build-depends:
-      cardano-api == 8.8.0.0,
+      cardano-api,
       cardano-ledger-core,
       cardano-crypto-wrapper,
 
@@ -73,4 +73,5 @@ library
       serialise,
       bytestring,
       dlist,
-      either-result
+      either-result,
+      strict-sop-core

src/base/lib/Convex/BuildTx.hs

@@ -280,23 +280,23 @@ addAuxScript :: MonadBuildTx m => C.ScriptInEra C.BabbageEra -> m ()
 addAuxScript s = addBtx (over (L.txAuxScripts . L._TxAuxScripts) ((:) s))
 
 payToAddressTxOut :: C.AddressInEra C.BabbageEra -> C.Value -> C.TxOut C.CtxTx C.BabbageEra
-payToAddressTxOut addr vl = C.TxOut addr (C.TxOutValue C.MultiAssetInBabbageEra vl) C.TxOutDatumNone C.ReferenceScriptNone
+payToAddressTxOut addr vl = C.TxOut addr (C.TxOutValueShelleyBased C.ShelleyBasedEraBabbage $ C.toMaryValue vl) C.TxOutDatumNone C.ReferenceScriptNone
 
 payToAddress :: MonadBuildTx m => C.AddressInEra C.BabbageEra -> C.Value -> m ()
 payToAddress addr vl = addBtx $ over L.txOuts ((:) (payToAddressTxOut addr vl))
 
 payToPublicKey :: MonadBuildTx m => NetworkId -> Hash PaymentKey -> C.Value -> m ()
 payToPublicKey network pk vl =
-  let val = C.TxOutValue C.MultiAssetInBabbageEra vl
-      addr = C.makeShelleyAddressInEra network (C.PaymentCredentialByKey pk) C.NoStakeAddress
+  let val = C.TxOutValueShelleyBased C.ShelleyBasedEraBabbage $ C.toMaryValue vl
+      addr = C.makeShelleyAddressInEra C.ShelleyBasedEraBabbage network (C.PaymentCredentialByKey pk) C.NoStakeAddress
       txo = C.TxOut addr val C.TxOutDatumNone C.ReferenceScriptNone
   in prependTxOut txo
 
 payToScriptHash :: MonadBuildTx m => NetworkId -> ScriptHash -> HashableScriptData -> C.StakeAddressReference -> C.Value -> m ()
 payToScriptHash network script datum stakeAddress vl =
-  let val = C.TxOutValue C.MultiAssetInBabbageEra vl
-      addr = C.makeShelleyAddressInEra network (C.PaymentCredentialByScript script) stakeAddress
-      dat = C.TxOutDatumInTx C.ScriptDataInBabbageEra datum
+  let val = C.TxOutValueShelleyBased C.ShelleyBasedEraBabbage $ C.toMaryValue vl
+      addr = C.makeShelleyAddressInEra C.ShelleyBasedEraBabbage network (C.PaymentCredentialByScript script) stakeAddress
+      dat = C.TxOutDatumInTx C.AlonzoEraOnwardsBabbage datum
       txo = C.TxOut addr val dat C.ReferenceScriptNone
   in prependTxOut txo
 
@@ -314,8 +314,8 @@ payToPlutusV2 network s datum stakeRef vl =
 
 payToPlutusV2InlineBase :: MonadBuildTx m => C.AddressInEra C.BabbageEra -> C.PlutusScript C.PlutusScriptV2 -> C.TxOutDatum C.CtxTx C.BabbageEra -> C.Value -> m ()
 payToPlutusV2InlineBase addr script dat vl =
-  let refScript = C.ReferenceScript C.ReferenceTxInsScriptsInlineDatumsInBabbageEra (C.toScriptInAnyLang $ C.PlutusScript C.PlutusScriptV2 script)
-      txo = C.TxOut addr (C.TxOutValue C.MultiAssetInBabbageEra vl) dat refScript
+  let refScript = C.ReferenceScript C.BabbageEraOnwardsBabbage (C.toScriptInAnyLang $ C.PlutusScript C.PlutusScriptV2 script)
+      txo = C.TxOut addr (C.TxOutValueShelleyBased C.ShelleyBasedEraBabbage $ C.toMaryValue vl) dat refScript
   in prependTxOut txo
 
 payToPlutusV2Inline :: MonadBuildTx m => C.AddressInEra C.BabbageEra -> PlutusScript PlutusScriptV2 -> C.Value -> m ()
@@ -324,38 +324,38 @@ payToPlutusV2Inline addr script vl = payToPlutusV2InlineBase addr script C.TxOut
 {-| same as payToPlutusV2Inline but also specify an inline datum -}
 payToPlutusV2InlineWithInlineDatum :: forall a m. (MonadBuildTx m, Plutus.ToData a) => C.AddressInEra C.BabbageEra -> C.PlutusScript C.PlutusScriptV2 -> a -> C.Value -> m ()
 payToPlutusV2InlineWithInlineDatum addr script datum vl =
-  let dat = C.TxOutDatumInline C.ReferenceTxInsScriptsInlineDatumsInBabbageEra (toHashableScriptData datum)
+  let dat = C.TxOutDatumInline C.BabbageEraOnwardsBabbage (toHashableScriptData datum)
   in payToPlutusV2InlineBase addr script dat vl
 
 {-| same as payToPlutusV2Inline but also specify a datum -}
 payToPlutusV2InlineWithDatum :: forall a m. (MonadBuildTx m, Plutus.ToData a) => C.AddressInEra C.BabbageEra -> C.PlutusScript C.PlutusScriptV2 -> a -> C.Value -> m ()
 payToPlutusV2InlineWithDatum addr script datum vl =
-  let dat = C.TxOutDatumInTx C.ScriptDataInBabbageEra (toHashableScriptData datum)
+  let dat = C.TxOutDatumInTx C.AlonzoEraOnwardsBabbage (toHashableScriptData datum)
   in payToPlutusV2InlineBase addr script dat vl
 
 payToPlutusV2InlineDatum :: forall a m. (MonadBuildTx m, Plutus.ToData a) => NetworkId -> PlutusScript PlutusScriptV2 -> a -> C.StakeAddressReference -> C.Value -> m ()
 payToPlutusV2InlineDatum network script datum stakeRef vl =
-  let val = C.TxOutValue C.MultiAssetInBabbageEra vl
+  let val = C.TxOutValueShelleyBased C.ShelleyBasedEraBabbage $ C.toMaryValue vl
       sh  = C.hashScript (C.PlutusScript C.PlutusScriptV2 script)
-      addr = C.makeShelleyAddressInEra network (C.PaymentCredentialByScript sh) stakeRef
-      dat = C.TxOutDatumInline C.ReferenceTxInsScriptsInlineDatumsInBabbageEra (toHashableScriptData datum)
+      addr = C.makeShelleyAddressInEra C.ShelleyBasedEraBabbage network (C.PaymentCredentialByScript sh) stakeRef
+      dat = C.TxOutDatumInline C.BabbageEraOnwardsBabbage (toHashableScriptData datum)
       txo = C.TxOut addr val dat C.ReferenceScriptNone
   in prependTxOut txo
 -- TODO: Functions for building outputs (Output -> Output)
 
 setScriptsValid :: MonadBuildTx m => m ()
-setScriptsValid = addBtx $ set L.txScriptValidity (C.TxScriptValidity C.TxScriptValiditySupportedInBabbageEra C.ScriptValid)
+setScriptsValid = addBtx $ set L.txScriptValidity (C.TxScriptValidity C.AlonzoEraOnwardsBabbage C.ScriptValid)
 
 {-| Set the Ada component in an output's value to at least the amount needed to cover the
 minimum UTxO deposit for this output
 -}
-setMinAdaDeposit :: C.BundledProtocolParameters C.BabbageEra -> C.TxOut C.CtxTx C.BabbageEra -> C.TxOut C.CtxTx C.BabbageEra
+setMinAdaDeposit :: C.LedgerProtocolParameters C.BabbageEra -> C.TxOut C.CtxTx C.BabbageEra -> C.TxOut C.CtxTx C.BabbageEra
 setMinAdaDeposit params txOut =
   let minUtxo = minAdaDeposit params txOut
   in txOut & over (L._TxOut . _2 . L._TxOutValue . L._Value . at C.AdaAssetId) (maybe (Just minUtxo) (Just . max minUtxo))
 
-minAdaDeposit :: C.BundledProtocolParameters C.BabbageEra -> C.TxOut C.CtxTx C.BabbageEra -> C.Quantity
-minAdaDeposit params txOut =
+minAdaDeposit :: C.LedgerProtocolParameters C.BabbageEra -> C.TxOut C.CtxTx C.BabbageEra -> C.Quantity
+minAdaDeposit (C.LedgerProtocolParameters params) txOut =
   let minAdaValue = C.Quantity 3_000_000
       txo = txOut
             -- set the Ada value to a dummy amount to ensure that it is not 0 (if it was 0, the size of the output
@@ -367,7 +367,7 @@ minAdaDeposit params txOut =
 
 {-| Apply 'setMinAdaDeposit' to all outputs
 -}
-setMinAdaDepositAll :: MonadBuildTx m => C.BundledProtocolParameters C.BabbageEra -> m ()
+setMinAdaDepositAll :: MonadBuildTx m => C.LedgerProtocolParameters C.BabbageEra -> m ()
 setMinAdaDepositAll params = addBtx $ over (L.txOuts . mapped) (setMinAdaDeposit params)
 
 {-| Add a public key hash to the list of required signatures.

src/base/lib/Convex/Class.hs

@@ -25,9 +25,9 @@ module Convex.Class(
 
 import qualified Cardano.Api                                       as C
 import           Cardano.Api.Shelley                               (BabbageEra,
-                                                                    CardanoMode,
                                                                     EraHistory (..),
                                                                     Hash,
+                                                                    LedgerProtocolParameters (..),
                                                                     LocalNodeConnectInfo,
                                                                     NetworkId,
                                                                     PoolId,
@@ -60,7 +60,6 @@ import           Convex.Utils                                      (posixTimeToS
 import           Data.Aeson                                        (FromJSON,
                                                                     ToJSON)
 import           Data.Set                                          (Set)
-import qualified Data.Text                                         as Text
 import           Data.Time.Clock                                   (UTCTime)
 import           GHC.Generics                                      (Generic)
 import           Ouroboros.Consensus.HardFork.History              (interpretQuery,
@@ -73,10 +72,10 @@ import qualified PlutusLedgerApi.V1                                as PV1
 class Monad m => MonadBlockchain m where
   sendTx                  :: Tx BabbageEra -> m TxId -- ^ Submit a transaction to the network
   utxoByTxIn              :: Set C.TxIn -> m (C.UTxO C.BabbageEra) -- ^ Resolve tx inputs
-  queryProtocolParameters :: m (C.BundledProtocolParameters C.BabbageEra) -- ^ Get the protocol parameters
+  queryProtocolParameters :: m (LedgerProtocolParameters C.BabbageEra) -- ^ Get the protocol parameters
   queryStakePools         :: m (Set PoolId) -- ^ Get the stake pools
   querySystemStart        :: m SystemStart
-  queryEraHistory         :: m (EraHistory CardanoMode)
+  queryEraHistory         :: m EraHistory
   querySlotNo             :: m (SlotNo, SlotLength, UTCTime)
                           -- ^ returns the current slot number, slot length and begin utc time for slot.
                           -- Slot 0 is returned when at genesis.
@@ -198,7 +197,7 @@ This MAY move the clock backwards!
 setTimeToValidRange :: MonadMockchain m => (C.TxValidityLowerBound C.BabbageEra, C.TxValidityUpperBound C.BabbageEra) -> m ()
 setTimeToValidRange = \case
   (C.TxValidityLowerBound _ lowerSlot, _) -> setSlot lowerSlot
-  (_, C.TxValidityUpperBound _ upperSlot) -> setSlot (pred upperSlot)
+  (_, C.TxValidityUpperBound _ (Just upperSlot)) -> setSlot (pred upperSlot)
   _                                       -> pure ()
 
 {-| Increase the slot number by 1.
@@ -208,32 +207,27 @@ nextSlot = modifySlot (\s -> (succ s, ()))
 
 data MonadBlockchainError e =
   MonadBlockchainError e
-  | ProtocolConversionError Text.Text
   | FailWith String
   deriving stock (Eq, Functor, Generic)
   deriving anyclass (ToJSON, FromJSON)
 
-protocolConversionError :: C.ProtocolParametersConversionError -> MonadBlockchainError e
-protocolConversionError = ProtocolConversionError . C.textShow
-
 instance Show e => Show (MonadBlockchainError e) where
-  show (MonadBlockchainError e)    = show e
-  show (FailWith str)              = str
-  show (ProtocolConversionError e) = show e
+  show (MonadBlockchainError e) = show e
+  show (FailWith str)           = str
 
 {-| 'MonadBlockchain' implementation that connects to a cardano node
 -}
-newtype MonadBlockchainCardanoNodeT e m a = MonadBlockchainCardanoNodeT { unMonadBlockchainCardanoNodeT :: ReaderT (LocalNodeConnectInfo CardanoMode) (ExceptT (MonadBlockchainError e) m) a }
+newtype MonadBlockchainCardanoNodeT e m a = MonadBlockchainCardanoNodeT { unMonadBlockchainCardanoNodeT :: ReaderT LocalNodeConnectInfo (ExceptT (MonadBlockchainError e) m) a }
   deriving newtype (Functor, Applicative, Monad, MonadIO)
 
 instance Monad m => MonadError e (MonadBlockchainCardanoNodeT e m) where
   throwError = MonadBlockchainCardanoNodeT . throwError . MonadBlockchainError
   catchError (MonadBlockchainCardanoNodeT action) handler = MonadBlockchainCardanoNodeT $ catchError action (\case { MonadBlockchainError e -> unMonadBlockchainCardanoNodeT (handler e); e' -> throwError e' })
 
-runMonadBlockchainCardanoNodeT :: LocalNodeConnectInfo CardanoMode -> MonadBlockchainCardanoNodeT e m a -> m (Either (MonadBlockchainError e) a)
+runMonadBlockchainCardanoNodeT :: LocalNodeConnectInfo -> MonadBlockchainCardanoNodeT e m a -> m (Either (MonadBlockchainError e) a)
 runMonadBlockchainCardanoNodeT info (MonadBlockchainCardanoNodeT action) = runExceptT (runReaderT action info)
 
-runQuery :: (MonadIO m, MonadLog m) => C.QueryInMode CardanoMode a -> MonadBlockchainCardanoNodeT e m a
+runQuery :: (MonadIO m, MonadLog m) => C.QueryInMode a -> MonadBlockchainCardanoNodeT e m a
 runQuery qry = MonadBlockchainCardanoNodeT $ do
   info <- ask
   result <- liftIO (C.queryNodeLocalState info Nothing qry)
@@ -245,7 +239,7 @@ runQuery qry = MonadBlockchainCardanoNodeT $ do
     Right result' -> do
       pure result'
 
-runQuery' :: (MonadIO m, MonadLog m, Show e1) => C.QueryInMode CardanoMode (Either e1 a) -> MonadBlockchainCardanoNodeT e2 m a
+runQuery' :: (MonadIO m, MonadLog m, Show e1) => C.QueryInMode (Either e1 a) -> MonadBlockchainCardanoNodeT e2 m a
 runQuery' qry = runQuery qry >>= \case
   Left err -> MonadBlockchainCardanoNodeT $ do
     let msg = "runQuery': Era mismatch: " <> show err
@@ -257,7 +251,7 @@ instance (MonadLog m, MonadIO m) => MonadBlockchain (MonadBlockchainCardanoNodeT
   sendTx tx = MonadBlockchainCardanoNodeT $ do
     let txId = C.getTxId (C.getTxBody tx)
     info <- ask
-    result <- liftIO (C.submitTxToNodeLocal info (C.TxInMode tx C.BabbageEraInCardanoMode))
+    result <- liftIO (C.submitTxToNodeLocal info (C.TxInMode C.ShelleyBasedEraBabbage tx))
     -- TODO: Error should be reflected in return type of 'sendTx'
     case result of
       SubmitSuccess -> do
@@ -269,24 +263,21 @@ instance (MonadLog m, MonadIO m) => MonadBlockchain (MonadBlockchainCardanoNodeT
         throwError $ FailWith msg
 
   utxoByTxIn txIns =
-    runQuery' (C.QueryInEra C.BabbageEraInCardanoMode (C.QueryInShelleyBasedEra C.ShelleyBasedEraBabbage (C.QueryUTxO (C.QueryUTxOByTxIn txIns))))
+    runQuery' (C.QueryInEra (C.QueryInShelleyBasedEra C.ShelleyBasedEraBabbage (C.QueryUTxO (C.QueryUTxOByTxIn txIns))))
 
   queryProtocolParameters = do
-    p <- runQuery' (C.QueryInEra C.BabbageEraInCardanoMode (C.QueryInShelleyBasedEra C.ShelleyBasedEraBabbage C.QueryProtocolParameters))
-    case C.bundleProtocolParams C.BabbageEra p of
-      Right x -> pure x
-      Left err -> MonadBlockchainCardanoNodeT $ throwError (protocolConversionError err)
+    LedgerProtocolParameters <$> runQuery' (C.QueryInEra (C.QueryInShelleyBasedEra C.ShelleyBasedEraBabbage C.QueryProtocolParameters))
 
   queryStakePools =
-    runQuery' (C.QueryInEra C.BabbageEraInCardanoMode (C.QueryInShelleyBasedEra C.ShelleyBasedEraBabbage C.QueryStakePools))
+    runQuery' (C.QueryInEra (C.QueryInShelleyBasedEra C.ShelleyBasedEraBabbage C.QueryStakePools))
 
   querySystemStart = runQuery C.QuerySystemStart
 
-  queryEraHistory = runQuery (C.QueryEraHistory C.CardanoModeIsMultiEra)
+  queryEraHistory = runQuery C.QueryEraHistory
 
   querySlotNo = do
-    (eraHistory@(EraHistory _ interpreter), systemStart) <- (,) <$> queryEraHistory <*> querySystemStart
-    slotNo <- runQuery (C.QueryChainPoint C.CardanoMode) >>= \case
+    (eraHistory@(EraHistory interpreter), systemStart) <- (,) <$> queryEraHistory <*> querySystemStart
+    slotNo <- runQuery C.QueryChainPoint >>= \case
                 C.ChainPointAtGenesis  -> pure $ fromIntegral (0 :: Integer)
                 C.ChainPoint slot _hsh -> pure slot
     MonadBlockchainCardanoNodeT $ do