Merge pull request #552 from IntersectMBO/yura/cardano-node-8.12

Updated dependencies for the Cardano Node 8.12 release
IntersectMBO · Jun 19, 2024 · 61830bd · 61830bd
2 parents 850aa19 + 122fb48
commit 61830bd
Show file tree

Hide file tree

Showing 11 changed files with 143 additions and 115 deletions.
diff --git a/cabal.project b/cabal.project
@@ -13,13 +13,18 @@ repository cardano-haskell-packages
 -- See CONTRIBUTING for information about these, including some Nix commands
 -- you need to run if you change them
 index-state:
-  , hackage.haskell.org 2024-05-24T12:49:48Z
-  , cardano-haskell-packages 2024-05-24T09:29:56Z
+  , hackage.haskell.org 2024-06-13T08:49:27Z
+  , cardano-haskell-packages 2024-06-19T09:05:06Z
 
 packages:
     cardano-api
     cardano-api-gen
 
+extra-packages: Cabal, process
+
+if impl(ghc < 9.8)
+  constraints: interpolatedstring-perl6:setup.time source
+
 program-options
   ghc-options: -Werror
 
@@ -33,10 +38,6 @@ package cryptonite
 package bitvec
    flags: -simd
 
-constraints:
-  -- io-classes-mtl-0.1.2.0 is not buildable
-  io-classes-mtl < 0.1.2.0
-
 tests: True
 
 test-show-details: direct
@@ -47,4 +48,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.
-
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -163,17 +163,17 @@ library internal
                       , cardano-crypto-class ^>= 2.1.2
                       , cardano-crypto-wrapper ^>= 1.5
                       , cardano-data >= 1.0
-                      , cardano-ledger-alonzo >= 1.8.0
-                      , cardano-ledger-allegra >= 1.3
-                      , cardano-ledger-api ^>= 1.9
-                      , cardano-ledger-babbage >= 1.6.0
-                      , cardano-ledger-binary ^>= 1.3
-                      , cardano-ledger-byron >= 1.0.0.4
-                      , cardano-ledger-conway >= 1.12.0
-                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.10
-                      , cardano-ledger-mary >= 1.5
-                      , cardano-ledger-shelley >= 1.9.0
-                      , cardano-protocol-tpraos >= 1.0.3.6
+                      , cardano-ledger-alonzo >= 1.8.1
+                      , cardano-ledger-allegra >= 1.5
+                      , cardano-ledger-api ^>= 1.9.2
+                      , cardano-ledger-babbage >= 1.8.1
+                      , cardano-ledger-binary ^>= 1.3.3
+                      , cardano-ledger-byron >= 1.0.1
+                      , cardano-ledger-conway >= 1.15
+                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8
+                      , cardano-ledger-mary >= 1.6.1
+                      , cardano-ledger-shelley >= 1.12
+                      , cardano-protocol-tpraos >= 1.2
                       , cardano-slotting >= 0.2.0.0
                       , cardano-strict-containers >= 0.1
                       , cborg
@@ -194,19 +194,19 @@ library internal
                       , mtl
                       , network
                       , optparse-applicative-fork
-                      , ouroboros-consensus ^>= 0.18
-                      , ouroboros-consensus-cardano ^>= 0.16
-                      , ouroboros-consensus-diffusion ^>= 0.16
-                      , ouroboros-consensus-protocol ^>= 0.9
+                      , ouroboros-consensus ^>= 0.19
+                      , ouroboros-consensus-cardano ^>= 0.17
+                      , ouroboros-consensus-diffusion ^>= 0.17
+                      , ouroboros-consensus-protocol ^>= 0.9.0.1
                       , ouroboros-network
-                      , ouroboros-network-api ^>= 0.7
+                      , ouroboros-network-api ^>= 0.7.3
                       , ouroboros-network-framework
                       , ouroboros-network-protocols
                       , parsec
-                      , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.27.0
+                      , plutus-ledger-api:{plutus-ledger-api, plutus-ledger-api-testlib} ^>= 1.30
                       , prettyprinter
                       , prettyprinter-ansi-terminal
-                      , prettyprinter-configurable ^>= 1.27.0
+                      , prettyprinter-configurable ^>= 1.30
                       , random
                       , safe-exceptions
                       , scientific
@@ -285,9 +285,9 @@ library gen
                       , cardano-crypto-class ^>= 2.1.2
                       , cardano-crypto-test ^>= 1.5
                       , cardano-data
-                      , cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >= 1.6.0
+                      , cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib} >= 1.8.1
                       , cardano-ledger-byron-test >= 1.5
-                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8.0
+                      , cardano-ledger-core:{cardano-ledger-core, testlib} >= 1.8
                       , cardano-ledger-shelley >= 1.7.0
                       , cardano-ledger-conway:testlib >= 1.10.0
                       , containers
@@ -380,8 +380,8 @@ test-suite cardano-api-golden
                       , hedgehog-extras ^>= 0.6.1.0
                       , microlens
                       , parsec
-                      , plutus-core ^>= 1.27
-                      , plutus-ledger-api ^>= 1.27.0
+                      , plutus-core ^>= 1.30
+                      , plutus-ledger-api ^>= 1.30
                       , tasty
                       , tasty-hedgehog
                       , time

diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -491,7 +491,12 @@ data ScriptExecutionError =
 
        -- | A cost model was missing for a language which was used.
      | ScriptErrorMissingCostModel Plutus.Language
-  deriving Show
+
+     | forall era. ( Plutus.EraPlutusContext (ShelleyLedgerEra era)
+                   , Show (Plutus.ContextError (ShelleyLedgerEra era))
+                   ) => ScriptErrorTranslationError (Plutus.ContextError (ShelleyLedgerEra era))
+
+deriving instance Show ScriptExecutionError
 
 instance Error ScriptExecutionError where
   prettyError = \case
@@ -548,6 +553,10 @@ instance Error ScriptExecutionError where
     ScriptErrorMissingCostModel language ->
       "No cost model was found for language " <> pshow language
 
+    ScriptErrorTranslationError e -> 
+      "Error translating the transaction context: " <> pshow e
+
+
 data TransactionValidityError era  where
     -- | The transaction validity interval is too far into the future.
     --
@@ -568,11 +577,6 @@ data TransactionValidityError era  where
     TransactionValidityIntervalError
       :: Consensus.PastHorizonException -> TransactionValidityError era
 
-    TransactionValidityTranslationError
-      :: Plutus.EraPlutusContext (ShelleyLedgerEra era)
-      => Plutus.ContextError (ShelleyLedgerEra era)
-      -> TransactionValidityError era
-
     TransactionValidityCostModelError
       :: (Map AnyPlutusScriptVersion CostModel) -> String -> TransactionValidityError era
 
@@ -600,8 +604,6 @@ instance Error (TransactionValidityError era) where
 
           | otherwise
           = 0 -- This should be impossible.
-    TransactionValidityTranslationError errmsg ->
-      "Error translating the transaction context: " <> pshow errmsg
 
     TransactionValidityCostModelError cModels err ->
       mconcat
@@ -640,10 +642,9 @@ evaluateTransactionExecutionUnitsShelley :: forall era. ()
 evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx =
   caseShelleyToMaryOrAlonzoEraOnwards
     (const (Right Map.empty))
-    (\w -> case alonzoEraOnwardsConstraints w $ L.evalTxExUnitsWithLogs pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart of
-             Left err    -> Left $ alonzoEraOnwardsConstraints w
-                                 $ TransactionValidityTranslationError err
-             Right exmap -> Right (fromLedgerScriptExUnitsMap w exmap)
+    (\w -> pure . fromLedgerScriptExUnitsMap w 
+             $ alonzoEraOnwardsConstraints w 
+             $ L.evalTxExUnitsWithLogs pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart 
     )
     sbe
   where
@@ -689,6 +690,9 @@ evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtoc
           in ScriptErrorMissingScript scriptWitnessedItemIndex
                $ ResolvablePointers sbe $ Map.map extractScriptBytesAndLanguage resolveable
         L.NoCostModelInLedgerState l -> ScriptErrorMissingCostModel l
+        L.ContextError e -> 
+           alonzoEraOnwardsConstraints aOnwards 
+            $ ScriptErrorTranslationError e
 
 
 extractScriptBytesAndLanguage

diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
@@ -193,13 +193,13 @@ fromProposalProcedure sbe (Proposal pp) =
 createPreviousGovernanceActionId
   :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
   => TxId
-  -> Word32 -- ^ Governance action transation index
+  -> Word16 -- ^ Governance action transation index
   -> Ledger.GovPurposeId (r :: Ledger.GovActionPurpose) (ShelleyLedgerEra era)
 createPreviousGovernanceActionId  txid index =
    Ledger.GovPurposeId $ createGovernanceActionId txid index
 
 
-createGovernanceActionId :: TxId -> Word32 -> Gov.GovActionId StandardCrypto
+createGovernanceActionId :: TxId -> Word16 -> Gov.GovActionId StandardCrypto
 createGovernanceActionId txid index =
    Ledger.GovActionId
      { Ledger.gaidTxId = toShelleyTxId txid

diff --git a/cardano-api/internal/Cardano/Api/LedgerState.hs b/cardano-api/internal/Cardano/Api/LedgerState.hs
@@ -887,12 +887,16 @@ readNodeConfig
   => NodeConfigFile 'In
   -> m NodeConfig
 readNodeConfig (File ncf) = do
-    ncfg <- (liftEither . parseNodeConfig) =<< readByteString ncf "node"
+    ncfg <- liftEither . parseNodeConfig =<< readByteString ncf "node"
     return ncfg
-      { ncByronGenesisFile = mapFile (mkAdjustPath ncf) (ncByronGenesisFile ncfg)
-      , ncShelleyGenesisFile = mapFile (mkAdjustPath ncf) (ncShelleyGenesisFile ncfg)
-      , ncAlonzoGenesisFile = mapFile (mkAdjustPath ncf) (ncAlonzoGenesisFile ncfg)
-      , ncConwayGenesisFile = mapFile (mkAdjustPath ncf) (ncConwayGenesisFile ncfg)
+      { ncByronGenesisFile =
+          mapFile (mkAdjustPath ncf) (ncByronGenesisFile ncfg)
+      , ncShelleyGenesisFile =
+          mapFile (mkAdjustPath ncf) (ncShelleyGenesisFile ncfg)
+      , ncAlonzoGenesisFile =
+          mapFile (mkAdjustPath ncf) (ncAlonzoGenesisFile ncfg)
+      , ncConwayGenesisFile =
+          mapFile (mkAdjustPath ncf) <$> ncConwayGenesisFile ncfg
       }
 
 data NodeConfig = NodeConfig
@@ -903,8 +907,8 @@ data NodeConfig = NodeConfig
   , ncShelleyGenesisHash :: !GenesisHashShelley
   , ncAlonzoGenesisFile :: !(File AlonzoGenesis 'In)
   , ncAlonzoGenesisHash :: !GenesisHashAlonzo
-  , ncConwayGenesisFile :: !(File ConwayGenesisConfig 'In)
-  , ncConwayGenesisHash :: !GenesisHashConway
+  , ncConwayGenesisFile :: !(Maybe (File ConwayGenesisConfig 'In))
+  , ncConwayGenesisHash :: !(Maybe GenesisHashConway)
   , ncRequiresNetworkMagic :: !Cardano.Crypto.RequiresNetworkMagic
   , ncByronProtocolVersion :: !Cardano.Chain.Update.ProtocolVersion
   , ncHardForkTriggers :: !Consensus.CardanoHardForkTriggers
@@ -924,8 +928,8 @@ instance FromJSON NodeConfig where
           <*> fmap GenesisHashShelley (o .: "ShelleyGenesisHash")
           <*> fmap File (o .: "AlonzoGenesisFile")
           <*> fmap GenesisHashAlonzo (o .: "AlonzoGenesisHash")
-          <*> fmap File (o .: "ConwayGenesisFile")
-          <*> fmap GenesisHashConway (o .: "ConwayGenesisHash")
+          <*> (fmap . fmap) File (o .:? "ConwayGenesisFile")
+          <*> (fmap . fmap) GenesisHashConway (o .:? "ConwayGenesisHash")
           <*> o .: "RequiresNetworkMagic"
           <*> parseByronProtocolVersion o
           <*> parseHardForkTriggers o
@@ -1257,14 +1261,18 @@ readAlonzoGenesisConfig enc = do
   modifyError (NEAlonzoConfig (unFile file) . renderAlonzoGenesisError)
     $ readAlonzoGenesis file (ncAlonzoGenesisHash enc)
 
+-- | If the conway genesis file does not exist we simply put in a default.
 readConwayGenesisConfig
   :: MonadIOTransError GenesisConfigError t m
   => NodeConfig
   -> t m (ConwayGenesis Consensus.StandardCrypto)
 readConwayGenesisConfig enc = do
-  let file = ncConwayGenesisFile enc
-  modifyError (NEConwayConfig (unFile file) . renderConwayGenesisError)
-    $ readConwayGenesis file (ncConwayGenesisHash enc)
+  let mFile = ncConwayGenesisFile enc
+  case mFile of
+    Nothing -> return conwayGenesisDefaults
+    Just fp ->
+      modifyError (NEConwayConfig (unFile fp) . renderConwayGenesisError)
+        $ readConwayGenesis (ncConwayGenesisFile enc) (ncConwayGenesisHash enc)
 
 readShelleyGenesis
   :: forall m t. MonadIOTransError ShelleyGenesisError t m
@@ -1363,10 +1371,13 @@ renderAlonzoGenesisError sge =
 
 readConwayGenesis
   :: forall m t. MonadIOTransError ConwayGenesisError t m
-  => ConwayGenesisFile 'In
-  -> GenesisHashConway
+  => Maybe (ConwayGenesisFile 'In)
+  -> Maybe GenesisHashConway
   -> t m (ConwayGenesis Consensus.StandardCrypto)
-readConwayGenesis (File file) expectedGenesisHash = do
+readConwayGenesis Nothing Nothing = return conwayGenesisDefaults
+readConwayGenesis (Just fp) Nothing = throwError $ ConwayGenesisHashMissing $ unFile fp
+readConwayGenesis Nothing (Just _) = throwError ConwayGenesisFileMissing
+readConwayGenesis (Just (File file)) (Just expectedGenesisHash) = do
     content <- modifyError id $ handleIOExceptT (ConwayGenesisReadError file . textShow) $ BS.readFile file
     let genesisHash = GenesisHashConway (Cardano.Crypto.Hash.Class.hashWith id content)
     checkExpectedGenesisHash genesisHash
@@ -1380,6 +1391,8 @@ readConwayGenesis (File file) expectedGenesisHash = do
 data ConwayGenesisError
      = ConwayGenesisReadError !FilePath !Text
      | ConwayGenesisHashMismatch !GenesisHashConway !GenesisHashConway -- actual, expected
+     | ConwayGenesisHashMissing !FilePath
+     | ConwayGenesisFileMissing
      | ConwayGenesisDecodeError !FilePath !Text
      deriving Show
 
@@ -1388,6 +1401,15 @@ instance Exception ConwayGenesisError
 renderConwayGenesisError :: ConwayGenesisError -> Text
 renderConwayGenesisError sge =
     case sge of
+      ConwayGenesisFileMissing ->
+        mconcat
+          [ "\"ConwayGenesisFile\" is missing from node configuration. "
+          ]
+      ConwayGenesisHashMissing fp ->
+        mconcat
+          [ "\"ConwayGenesisHash\" is missing from node configuration: "
+          , Text.pack fp
+          ]
       ConwayGenesisReadError fp err ->
         mconcat
           [ "There was an error reading the genesis file: ", Text.pack fp

diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs
@@ -122,6 +122,7 @@ import qualified Ouroboros.Consensus.HardFork.History.Qry as Qry
 import qualified Ouroboros.Consensus.Ledger.Query as Consensus
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
+import qualified Ouroboros.Consensus.Shelley.Ledger.Query.Types as Consensus
 import           Ouroboros.Network.Block (Serialised (..))
 import           Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..))
 import           Ouroboros.Network.Protocol.LocalStateQuery.Client (Some (..))
@@ -461,7 +462,7 @@ decodePoolState (SerialisedPoolState (Serialised ls)) =
   PoolState <$> decodeFull (Core.eraProtVerLow @(ShelleyLedgerEra era)) ls
 
 newtype SerialisedPoolDistribution era
-  = SerialisedPoolDistribution (Serialised (Shelley.PoolDistr (Core.EraCrypto (ShelleyLedgerEra era))))
+  = SerialisedPoolDistribution (Serialised (Consensus.PoolDistr (Core.EraCrypto (ShelleyLedgerEra era))))
 
 newtype PoolDistribution era = PoolDistribution
   { unPoolDistr :: Shelley.PoolDistr (Core.EraCrypto (ShelleyLedgerEra era))
@@ -524,15 +525,15 @@ fromLedgerUTxO sbe (Shelley.UTxO utxo) =
     . Map.toList
     $ utxo
 
-fromShelleyPoolDistr :: Shelley.PoolDistr StandardCrypto
+fromShelleyPoolDistr :: Consensus.PoolDistr StandardCrypto
                      -> Map (Hash StakePoolKey) Rational
 fromShelleyPoolDistr =
     --TODO: write an appropriate property to show it is safe to use
     -- Map.fromListAsc or to use Map.mapKeysMonotonic
     Map.fromList
-  . map (bimap StakePoolKeyHash Shelley.individualPoolStake)
+  . map (bimap StakePoolKeyHash Consensus.individualPoolStake)
   . Map.toList
-  . Shelley.unPoolDistr
+  . Consensus.unPoolDistr
 
 fromShelleyDelegations :: Map (Shelley.Credential Shelley.Staking StandardCrypto)
                               (Shelley.KeyHash Shelley.StakePool StandardCrypto)