diff --git a/bench/locli/locli.cabal b/bench/locli/locli.cabal index c7418a99fb0..7f5a306cc90 100644 --- a/bench/locli/locli.cabal +++ b/bench/locli/locli.cabal @@ -101,7 +101,7 @@ library , attoparsec , attoparsec-iso8601 , bytestring - , cardano-git-rev + , cardano-git-rev ^>= 0.2.2 , cardano-ledger-core , cardano-prelude , cardano-slotting diff --git a/bench/locli/src/Cardano/Analysis/API/LocliVersion.hs b/bench/locli/src/Cardano/Analysis/API/LocliVersion.hs index 1d7729543b8..58c85855a98 100644 --- a/bench/locli/src/Cardano/Analysis/API/LocliVersion.hs +++ b/bench/locli/src/Cardano/Analysis/API/LocliVersion.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TemplateHaskell #-} module Cardano.Analysis.API.LocliVersion (module Cardano.Analysis.API.LocliVersion) where import Cardano.Prelude (NFData, mconcat) @@ -22,7 +23,7 @@ data LocliVersion = getLocliVersion :: LocliVersion getLocliVersion = LocliVersion - Cardano.Git.Rev.gitRev + $(Cardano.Git.Rev.gitRev) (pack (showVersion Paths_locli.version)) renderProgramAndVersion :: LocliVersion -> Text diff --git a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal index 8a43f18258d..b6d386028e0 100644 --- a/bench/plutus-scripts-bench/plutus-scripts-bench.cabal +++ b/bench/plutus-scripts-bench/plutus-scripts-bench.cabal @@ -73,7 +73,7 @@ library -- IOG dependencies -------------------------- build-depends: - , cardano-api ^>= 8.39.3.0 + , cardano-api ^>= 8.42.0.0 , plutus-ledger-api >=1.0.0 , plutus-tx >=1.0.0 , plutus-tx-plugin ^>=1.21 diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs index b1cb6ea0ae9..c448828a34b 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Compiler.hs @@ -10,6 +10,7 @@ where import Cardano.Api import Cardano.Benchmarking.Script.Types +import qualified Cardano.Ledger.Coin as L import Cardano.TxGenerator.Setup.NixService import Cardano.TxGenerator.Setup.SigningKey import Cardano.TxGenerator.Types @@ -159,7 +160,7 @@ splittingPhase srcWallet = do -- testCompiler (error "opts") $ splitSequenceWalletNames (WalletName "w1") (WalletName "w2") (unfoldSplitSequence 1 1000 10000) data Split - = SplitWithChange Lovelace Int + = SplitWithChange L.Coin Int | FullSplits Int deriving Show @@ -171,7 +172,7 @@ splitSequenceWalletNames src dst (split: rest) = do l <- splitSequenceWalletNames tempWallet dst rest return $ ( src, tempWallet, split) : l -unfoldSplitSequence :: Lovelace -> Lovelace -> Int -> [ Split ] +unfoldSplitSequence :: L.Coin -> L.Coin -> Int -> [ Split ] unfoldSplitSequence fee value outputs = if outputs < maxOutputsPerTx then [ SplitWithChange value outputs ] @@ -208,8 +209,8 @@ benchmarkingPhase wallet collateralWallet = do return doneWallet data Fees = Fees { - _safeCollateral :: Lovelace - , _minValuePerInput :: Lovelace + _safeCollateral :: L.Coin + , _minValuePerInput :: L.Coin } evilFeeMagic :: Compiler Fees diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs index 78b7ca6cdc7..5aa9e8a5a0a 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Core.hs @@ -19,62 +19,53 @@ module Cardano.Benchmarking.Script.Core where import "contra-tracer" Control.Tracer (Tracer (..)) - -import Control.Concurrent (threadDelay) -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Trans.Except -import Control.Monad.Trans.Except.Extra -import Data.ByteString.Lazy.Char8 as BSL (writeFile) -import Data.Ratio ((%)) - -import Streaming -import qualified Streaming.Prelude as Streaming - -import qualified Data.Text as Text (unpack) -import Prelude - import Cardano.Api import Cardano.Api.Shelley (PlutusScriptOrReferenceInput (..), ProtocolParameters, ShelleyLedgerEra, convertToLedgerProtocolParameters, protocolParamMaxTxExUnits, protocolParamPrices) -import Cardano.Logging hiding (LocalSocket) - -import qualified Cardano.Ledger.Core as Ledger - -import Cardano.TxGenerator.Fund as Fund -import qualified Cardano.TxGenerator.FundQueue as FundQueue -import Cardano.TxGenerator.Setup.Plutus as Plutus -import Cardano.TxGenerator.Tx -import Cardano.TxGenerator.Types -import qualified Cardano.TxGenerator.Utils as Utils -import Cardano.TxGenerator.UTxO - import Cardano.Benchmarking.GeneratorTx as GeneratorTx (AsyncBenchmarkControl) import qualified Cardano.Benchmarking.GeneratorTx as GeneratorTx (waitBenchmark, walletBenchmark) import Cardano.Benchmarking.GeneratorTx.NodeToNode (ConnectClient, benchmarkConnectTxSubmit) import Cardano.Benchmarking.GeneratorTx.SizedMetadata (mkMetadata) -import qualified Cardano.TxGenerator.Genesis as Genesis -import Cardano.TxGenerator.PlutusContext -import Cardano.TxGenerator.Setup.SigningKey - -import Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, SigningKeyFile, - makeLocalConnectInfo, protocolToCodecConfig) - import Cardano.Benchmarking.LogTypes as Core (TraceBenchTxSubmit (..), btConnect_, btN2N_, btSubmission2_, btTxSubmit_) -import Cardano.Benchmarking.Types as Core (SubmissionErrorPolicy (..)) -import Cardano.Benchmarking.Wallet as Wallet - +import Cardano.Benchmarking.OuroborosImports as Core (LocalSubmitTx, SigningKeyFile, + makeLocalConnectInfo, protocolToCodecConfig) import Cardano.Benchmarking.Script.Aeson (prettyPrintOrdered, readProtocolParametersFile) import Cardano.Benchmarking.Script.Env hiding (Error (TxGenError)) import qualified Cardano.Benchmarking.Script.Env as Env (Error (TxGenError)) import Cardano.Benchmarking.Script.Types +import Cardano.Benchmarking.Types as Core (SubmissionErrorPolicy (..)) import Cardano.Benchmarking.Version as Version +import Cardano.Benchmarking.Wallet as Wallet +import qualified Cardano.Ledger.Coin as L +import qualified Cardano.Ledger.Core as Ledger +import Cardano.Logging hiding (LocalSocket) +import Cardano.TxGenerator.Fund as Fund +import qualified Cardano.TxGenerator.FundQueue as FundQueue +import qualified Cardano.TxGenerator.Genesis as Genesis +import Cardano.TxGenerator.PlutusContext +import Cardano.TxGenerator.Setup.Plutus as Plutus +import Cardano.TxGenerator.Setup.SigningKey +import Cardano.TxGenerator.Tx +import Cardano.TxGenerator.Types +import qualified Cardano.TxGenerator.Utils as Utils +import Cardano.TxGenerator.UTxO import Ouroboros.Network.Protocol.LocalStateQuery.Type (Target (..)) +import Prelude + +import Control.Concurrent (threadDelay) +import Control.Monad +import Data.ByteString.Lazy.Char8 as BSL (writeFile) +import Data.Ratio ((%)) +import qualified Data.Text as Text (unpack) + +import Streaming +import qualified Streaming.Prelude as Streaming + liftCoreWithEra :: AnyCardanoEra -> (forall era. IsShelleyBasedEra era => AsType era -> ExceptT TxGenError IO x) -> ActionM (Either TxGenError x) liftCoreWithEra era coreCall = withEra era ( liftIO . runExceptT . coreCall) @@ -106,7 +97,7 @@ readSigningKey name filePath = defineSigningKey :: String -> SigningKey PaymentKey -> ActionM () defineSigningKey = setEnvKeys -addFund :: AnyCardanoEra -> String -> TxIn -> Lovelace -> String -> ActionM () +addFund :: AnyCardanoEra -> String -> TxIn -> L.Coin -> String -> ActionM () addFund era wallet txIn lovelace keyName = do fundKey <- getEnvKeys keyName let @@ -428,7 +419,7 @@ interpretPayMode payMode = do makePlutusContext :: forall era. IsShelleyBasedEra era => ScriptSpec - -> ActionM (Witness WitCtxTxIn era, ScriptInAnyLang, ScriptData, Lovelace) + -> ActionM (Witness WitCtxTxIn era, ScriptInAnyLang, ScriptData, L.Coin) makePlutusContext ScriptSpec{..} = do protocolParameters <- getProtocolParameters script <- liftIOSafe $ Plutus.readPlutusScript scriptSpecFile diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs index 7e3a7d0f65c..384e3240a17 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Selftest.hs @@ -9,25 +9,24 @@ It actually does use a protocol file taken in from IO. module Cardano.Benchmarking.Script.Selftest where -import Prelude - -import Control.Monad -import qualified Data.ByteString.Lazy.Char8 as BSL - -import Data.Either (fromRight) -import Data.String - import Cardano.Api -import Ouroboros.Network.NodeToClient (IOManager) import Cardano.Benchmarking.Script.Action import Cardano.Benchmarking.Script.Aeson (prettyPrint) import Cardano.Benchmarking.Script.Env as Script import Cardano.Benchmarking.Script.Types import Cardano.Benchmarking.Tracer (initNullTracers) - +import qualified Cardano.Ledger.Coin as L import Cardano.TxGenerator.Setup.SigningKey import Cardano.TxGenerator.Types +import Ouroboros.Network.NodeToClient (IOManager) + +import Prelude + +import Control.Monad +import qualified Data.ByteString.Lazy.Char8 as BSL +import Data.Either (fromRight) +import Data.String import Paths_tx_generator @@ -70,7 +69,7 @@ testScript protocolFile submitMode = , DefineSigningKey key skey , AddFund era genesisWallet (TxIn "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162" (TxIx 0)) - (Lovelace 90000000000000) key + (L.Coin 90000000000000) key , createChange genesisWallet splitWallet1 1 10 , createChange splitWallet1 splitWallet2 10 30 -- 10 TXs with 30 outputs -> in total 300 outputs , createChange splitWallet2 splitWallet3 300 30 diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs index 5fd24d05286..ccb1b44551b 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Script/Types.hs @@ -38,21 +38,21 @@ module Cardano.Benchmarking.Script.Types ( , TxList(..) ) where -import GHC.Generics -import Prelude - -import Data.Function (on) -import Data.List.NonEmpty -import Data.Text (Text) - import Cardano.Api +import qualified Cardano.Api.Ledger as L import Cardano.Api.Shelley import Cardano.Benchmarking.OuroborosImports (SigningKeyFile) import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address) - import Cardano.TxGenerator.Types +import Prelude + +import Data.Function (on) +import Data.List.NonEmpty +import Data.Text (Text) +import GHC.Generics + -- FIXME: temporary workaround instance until Action ADT is refactored instance Eq (SigningKey PaymentKey) where @@ -95,7 +95,7 @@ data Action where -- 'Cardano.Benchmarking.Wallet.walletRefInsertFund' which in turn -- is just 'Control.Concurrent.modifyMVar' around -- 'Cardano.TxGenerator.FundQueue.insert'. - AddFund :: !AnyCardanoEra -> !String -> !TxIn -> !Lovelace -> !String -> Action + AddFund :: !AnyCardanoEra -> !String -> !TxIn -> !L.Coin -> !String -> Action -- | 'WaitBenchmark' signifies a 'Control.Concurrent.Async.waitCatch' -- on the 'Cardano.Benchmarking.GeneratorTx.AsyncBenchmarkControl' -- associated with the ID and also folds tracers into the completion. @@ -138,7 +138,7 @@ data Generator where -- | 'Split' makes payments with change depending on the pay mode. -- The splitting is from potentially sending the change to a -- different place. - Split :: !String -> !PayMode -> !PayMode -> [ Lovelace ] -> Generator + Split :: !String -> !PayMode -> !PayMode -> [ L.Coin ] -> Generator -- | 'SplitN' divides the funds by N and divides them up into that -- many transactions in a finite sequence. The handling starts from -- a case in 'Cardano.Benchmarking.Script.Core.evalGenerator' and diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Version.hs b/bench/tx-generator/src/Cardano/Benchmarking/Version.hs index d6e7b5f7143..5b17a36d714 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Version.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Version.hs @@ -1,13 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} + module Cardano.Benchmarking.Version where +import Cardano.Git.Rev (gitRev) + import Data.Aeson as A import Data.Text as Text import Data.Version (showVersion) -import Paths_tx_generator (version) import System.Info (arch, compilerName, compilerVersion, os) -import Cardano.Git.Rev (gitRev) +import Paths_tx_generator (version) data Version = Version { _package :: !Text @@ -26,7 +29,7 @@ txGeneratorVersion = Version , _arch = Text.pack arch , _compilerName = Text.pack compilerName , _compilerVersion = renderVersion compilerVersion - , _gitRev = gitRev + , _gitRev = $(gitRev) } where renderVersion = Text.pack . showVersion diff --git a/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs b/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs index 654157c72e5..7b1346f11ee 100644 --- a/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs +++ b/bench/tx-generator/src/Cardano/Benchmarking/Wallet.hs @@ -11,18 +11,20 @@ effect, like 'createAndStore' and 'mangle'. -} module Cardano.Benchmarking.Wallet where -import Prelude - -import Control.Concurrent.MVar -import Streaming - import Cardano.Api +import qualified Cardano.Ledger.Coin as L import Cardano.TxGenerator.FundQueue as FundQueue import Cardano.TxGenerator.Tx import Cardano.TxGenerator.Types import Cardano.TxGenerator.UTxO +import Prelude + +import Control.Concurrent.MVar + +import Streaming + -- | All the actual functionality of Wallet / WalletRef has been removed -- and WalletRef has been stripped down to MVar FundQueue. -- The implementation of Wallet has become trivial. @@ -121,7 +123,7 @@ mangleWithChange mkChange mkPayment outs = case outs of -- The only caller not passing a constant list built with 'repeat' -- as the first @fkts@ argument is 'mangleWithChange' above. This -- is likely worth refactoring for the sake of maintainability. -mangle :: Monad m => [ CreateAndStore m era ] -> CreateAndStoreList m era [ Lovelace ] +mangle :: Monad m => [ CreateAndStore m era ] -> CreateAndStoreList m era [ L.Coin ] mangle fkts values = (outs, \txId -> mapM_ (\f -> f txId) fs) where diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Fund.hs b/bench/tx-generator/src/Cardano/TxGenerator/Fund.hs index dbf23f36742..af226dee800 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Fund.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Fund.hs @@ -20,10 +20,12 @@ module Cardano.TxGenerator.Fund ) where -import Data.Function (on) - import Cardano.Api as Api +import qualified Cardano.Ledger.Coin as L + +import Data.Function (on) + -- $Types -- @@ -67,7 +69,7 @@ getFundKey :: Fund -> Maybe (SigningKey PaymentKey) getFundKey (Fund (InAnyCardanoEra _ a)) = _fundSigningKey a -- | Converting a `TxOutValue` to `Lovelace` requires case analysis. -getFundLovelace :: Fund -> Lovelace +getFundLovelace :: Fund -> L.Coin getFundLovelace (Fund (InAnyCardanoEra _ a)) = case _fundVal a of TxOutValueByron l -> l TxOutValueShelleyBased era v -> selectLovelace $ Api.fromLedgerValue era v diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs index 96499447dc8..af2194e2d31 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Genesis.hs @@ -18,20 +18,21 @@ module Cardano.TxGenerator.Genesis ) where -import Data.Bifunctor (bimap, second) -import Data.Function ((&)) -import Data.List (find) -import qualified Data.ListMap as ListMap (toList) - import Cardano.Api -import Cardano.Api.Shelley (ReferenceScript (..), fromShelleyLovelace, - fromShelleyPaymentCredential, fromShelleyStakeReference) -import Cardano.Ledger.Shelley.API (Addr (..), sgInitialFunds) -import Ouroboros.Consensus.Shelley.Node (validateGenesis) +import Cardano.Api.Shelley (ReferenceScript (..), fromShelleyPaymentCredential, + fromShelleyStakeReference) +import qualified Cardano.Ledger.Coin as L +import Cardano.Ledger.Shelley.API (Addr (..), sgInitialFunds) import Cardano.TxGenerator.Fund import Cardano.TxGenerator.Types import Cardano.TxGenerator.Utils +import Ouroboros.Consensus.Shelley.Node (validateGenesis) + +import Data.Bifunctor (bimap, second) +import Data.Function ((&)) +import Data.List (find) +import qualified Data.ListMap as ListMap (toList) genesisValidate :: ShelleyGenesis -> Either String () @@ -59,11 +60,11 @@ genesisSecureInitialFund networkId genesis srcKey destKey TxGenTxParams{txParamF genesisInitialFunds :: forall era. IsShelleyBasedEra era => NetworkId -> ShelleyGenesis - -> [(AddressInEra era, Lovelace)] + -> [(AddressInEra era, L.Coin)] genesisInitialFunds networkId g = [ ( shelleyAddressInEra (shelleyBasedEra @era) $ makeShelleyAddress networkId (fromShelleyPaymentCredential pcr) (fromShelleyStakeReference stref) - , fromShelleyLovelace coin + , coin ) | (Addr _ pcr stref, coin) <- ListMap.toList $ sgInitialFunds g ] @@ -72,7 +73,7 @@ genesisInitialFundForKey :: forall era. IsShelleyBasedEra era => NetworkId -> ShelleyGenesis -> SigningKey PaymentKey - -> Maybe (AddressInEra era, Lovelace) + -> Maybe (AddressInEra era, L.Coin) genesisInitialFundForKey networkId genesis key = find (isTxOutForKey . fst) (genesisInitialFunds networkId genesis) where @@ -94,7 +95,7 @@ genesisExpenditure :: -> SigningKey PaymentKey -> AddressInEra era -> TxOutValue era - -> Lovelace + -> L.Coin -> SlotNo -> SigningKey PaymentKey -> Either TxGenError (Tx era, Fund) @@ -116,7 +117,7 @@ mkGenesisTransaction :: forall era . IsShelleyBasedEra era => SigningKey GenesisUTxOKey -> SlotNo - -> Lovelace + -> L.Coin -> [TxIn] -> [TxOut CtxTx era] -> Either TxGenError (Tx era) diff --git a/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs b/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs index eeba034816f..af1ef036ed4 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/PureExample.hs @@ -6,18 +6,10 @@ module Cardano.TxGenerator.PureExample (demo) where -import Control.Monad (foldM) -import Control.Monad.Trans.State.Strict -import Data.Either (fromRight) -import Data.List (foldl') -import Data.String (fromString) -import System.Exit (die) - import Cardano.Api import Cardano.Api.Shelley (convertToLedgerProtocolParameters) -import Data.Aeson (eitherDecodeFileStrict') - +import qualified Cardano.Ledger.Coin as L import Cardano.TxGenerator.FundQueue import Cardano.TxGenerator.Setup.SigningKey import Cardano.TxGenerator.Tx (genTx, sourceToStoreTransaction) @@ -25,6 +17,14 @@ import Cardano.TxGenerator.Types (TxEnvironment (..), TxGenError (..), import Cardano.TxGenerator.Utils (inputsToOutputsWithFee) import Cardano.TxGenerator.UTxO (makeToUTxOList, mkUTxOVariant) +import Control.Monad (foldM) +import Control.Monad.Trans.State.Strict +import Data.Aeson (eitherDecodeFileStrict') +import Data.Either (fromRight) +import Data.List (foldl') +import Data.String (fromString) +import System.Exit (die) + import Paths_tx_generator @@ -72,7 +72,7 @@ genesisValue :: TxOutValue BabbageEra (genesisTxIn, genesisValue) = ( TxIn "900fc5da77a0747da53f7675cbb7d149d46779346dea2f879ab811ccc72a2162" (TxIx 0) - , lovelaceToTxOutValue ShelleyBasedEraBabbage $ Lovelace 90000000000000 + , lovelaceToTxOutValue ShelleyBasedEraBabbage $ L.Coin 90000000000000 ) genesisFund :: Fund @@ -123,7 +123,7 @@ generateTx TxEnvironment{..} addNewOutputFunds :: [Fund] -> Generator () addNewOutputFunds = put . foldl' insertFund emptyFundQueue - computeOutputValues :: [Lovelace] -> [Lovelace] + computeOutputValues :: [L.Coin] -> [L.Coin] computeOutputValues = inputsToOutputsWithFee fee numOfOutputs where numOfOutputs = 2 @@ -167,7 +167,7 @@ generateTxPure TxEnvironment{..} inQueue outValues = computeOutputValues $ map getFundLovelace inputs (outputs, toFunds) = makeToUTxOList (repeat computeUTxO) outValues - computeOutputValues :: [Lovelace] -> [Lovelace] + computeOutputValues :: [L.Coin] -> [L.Coin] computeOutputValues = inputsToOutputsWithFee fee numOfOutputs where numOfOutputs = 2 diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs index 3b77e1e6b01..49b8ef472e4 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Setup/NixService.hs @@ -15,19 +15,20 @@ module Cardano.TxGenerator.Setup.NixService ) where -import Data.Aeson -import Data.List.NonEmpty (NonEmpty) -import Data.Maybe (fromMaybe) -import GHC.Generics (Generic) +import Cardano.Api (AnyCardanoEra, mapFile) import Cardano.CLI.Types.Common (FileDirection (..), SigningKeyFile) +import qualified Cardano.Ledger.Coin as L import Cardano.Node.Configuration.NodeAddress (NodeIPv4Address) import Cardano.Node.Types (AdjustFilePaths (..)) - -import Cardano.Api (AnyCardanoEra, Lovelace, mapFile) import Cardano.TxGenerator.Internal.Orphans () import Cardano.TxGenerator.Types +import Data.Aeson +import Data.List.NonEmpty (NonEmpty) +import Data.Maybe (fromMaybe) +import GHC.Generics (Generic) + data NixServiceOptions = NixServiceOptions { _nix_debugMode :: Bool @@ -35,8 +36,8 @@ data NixServiceOptions = NixServiceOptions { , _nix_tps :: TPSRate , _nix_inputs_per_tx :: NumberOfInputsPerTx , _nix_outputs_per_tx :: NumberOfOutputsPerTx - , _nix_tx_fee :: Lovelace - , _nix_min_utxo_value :: Lovelace + , _nix_tx_fee :: L.Coin + , _nix_min_utxo_value :: L.Coin , _nix_add_tx_size :: TxAdditionalSize , _nix_init_cooldown :: Double , _nix_era :: AnyCardanoEra diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs index 899d045f5a7..128397a36ef 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Tx.hs @@ -7,24 +7,25 @@ module Cardano.TxGenerator.Tx (module Cardano.TxGenerator.Tx) where -import Data.Bifunctor (bimap, second) -import qualified Data.ByteString as BS (length) -import Data.Function ((&)) -import Data.Maybe (mapMaybe) - import Cardano.Api import Cardano.Api.Shelley (LedgerProtocolParameters) +import qualified Cardano.Ledger.Coin as L import Cardano.TxGenerator.Fund import Cardano.TxGenerator.Types import Cardano.TxGenerator.UTxO (ToUTxOList) +import Data.Bifunctor (bimap, second) +import qualified Data.ByteString as BS (length) +import Data.Function ((&)) +import Data.Maybe (mapMaybe) + -- | 'CreateAndStore' is meant to represent building a transaction -- from a single number and presenting a function to carry out the -- needed side effects. -- This type alias is only used in "Cardano.Benchmarking.Wallet". -type CreateAndStore m era = Lovelace -> (TxOut CtxTx era, TxIx -> TxId -> m ()) +type CreateAndStore m era = L.Coin -> (TxOut CtxTx era, TxIx -> TxId -> m ()) -- | 'CreateAndStoreList' is meant to represent building a transaction -- and presenting a function to carry out the needed side effects. @@ -41,7 +42,7 @@ type CreateAndStoreList m era split = split -> ([TxOut CtxTx era], TxId -> m ()) -- arguments. "Cardano.Benchmarking.Script.PureExample" is the sole caller. -- @txGenerator@ is just 'genTx' partially applied in all uses of all -- these functions. --- @inputFunds@ for this is a list of 'Lovelace' with some extra +-- @inputFunds@ for this is a list of 'L.Coin' with some extra -- fields to throw away and coproducts maintaining distinctions that -- don't matter to these functions. -- The @inToOut@ argument seems to just sum and subtract the fee in @@ -56,7 +57,7 @@ sourceToStoreTransaction :: Monad m => TxGenerator era -> FundSource m - -> ([Lovelace] -> split) + -> ([L.Coin] -> split) -> ToUTxOList era split -> FundToStoreList m --inline to ToUTxOList -> m (Either TxGenError (Tx era)) @@ -93,7 +94,7 @@ sourceToStoreTransactionNew :: Monad m => TxGenerator era -> FundSource m - -> ([Lovelace] -> split) + -> ([L.Coin] -> split) -> CreateAndStoreList m era split -> m (Either TxGenError (Tx era)) sourceToStoreTransactionNew txGenerator fundSource valueSplitter toStore = @@ -136,7 +137,7 @@ sourceToStoreTransactionNew txGenerator fundSource valueSplitter toStore = sourceTransactionPreview :: TxGenerator era -> [Fund] - -> ([Lovelace] -> split) + -> ([L.Coin] -> split) -> CreateAndStoreList m era split -> Either TxGenError (Tx era) sourceTransactionPreview txGenerator inputFunds valueSplitter toStore = diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs index a230cae9d5c..741fbe2794d 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Types.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Types.hs @@ -16,6 +16,7 @@ module Cardano.TxGenerator.Types import Cardano.Api import Cardano.Api.Shelley (ProtocolParameters) +import qualified Cardano.Ledger.Coin as L import Cardano.Ledger.Crypto (StandardCrypto) import qualified Cardano.Ledger.Shelley.API as Ledger (ShelleyGenesis) import Cardano.TxGenerator.Fund (Fund) @@ -42,12 +43,12 @@ type FundToStore m = Fund -> m () type FundToStoreList m = [Fund] -> m () data PayWithChange - = PayExact [Lovelace] - | PayWithChange Lovelace [Lovelace] + = PayExact [L.Coin] + | PayWithChange L.Coin [L.Coin] data TxGenTxParams = TxGenTxParams - { txParamFee :: !Lovelace -- ^ Transaction fee, in Lovelace + { txParamFee :: !L.Coin -- ^ Transaction fee, in Lovelace , txParamAddTxSize :: !Int -- ^ Extra transaction payload, in bytes -- Note [Tx additional size] , txParamTTL :: !SlotNo -- ^ Time-to-live } @@ -73,7 +74,7 @@ data TxEnvironment era = TxEnvironment data TxGenConfig = TxGenConfig - { confMinUtxoValue :: !Lovelace -- ^ Minimum value required per UTxO entry + { confMinUtxoValue :: !L.Coin -- ^ Minimum value required per UTxO entry , confTxsPerSecond :: !Double -- ^ Strength of generated workload, in transactions per second , confInitCooldown :: !Double -- ^ Delay between init and main submissions in seconds , confTxsInputs :: !NumberOfInputsPerTx -- ^ Inputs per transaction diff --git a/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs b/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs index 576efd608bd..6eb93f471fa 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/UTxO.hs @@ -9,14 +9,15 @@ module Cardano.TxGenerator.UTxO import Cardano.Api import Cardano.Api.Shelley (ReferenceScript (..)) +import qualified Cardano.Ledger.Coin as L import Cardano.TxGenerator.Fund (Fund (..), FundInEra (..)) import Cardano.TxGenerator.Utils (keyAddress) -type ToUTxO era = Lovelace -> (TxOut CtxTx era, TxIx -> TxId -> Fund) +type ToUTxO era = L.Coin -> (TxOut CtxTx era, TxIx -> TxId -> Fund) type ToUTxOList era split = split -> ([TxOut CtxTx era], TxId -> [Fund]) -makeToUTxOList :: [ ToUTxO era ] -> ToUTxOList era [ Lovelace ] +makeToUTxOList :: [ ToUTxO era ] -> ToUTxOList era [ L.Coin ] makeToUTxOList fkts values = (outs, \txId -> map (\f -> f txId) fs) where @@ -36,7 +37,7 @@ mkUTxOVariant networkId key value where mkTxOut v = TxOut (keyAddress @era networkId key) (lovelaceToTxOutValue (shelleyBasedEra @era) v) TxOutDatumNone ReferenceScriptNone - mkNewFund :: Lovelace -> TxIx -> TxId -> Fund + mkNewFund :: L.Coin -> TxIx -> TxId -> Fund mkNewFund val txIx txId = Fund $ InAnyCardanoEra (cardanoEra @era) $ FundInEra { _fundTxIn = TxIn txId txIx , _fundWitness = KeyWitness KeyWitnessForSpending @@ -74,7 +75,7 @@ mkUTxOScript networkId (script, txOutDatum) witness value (TxOutDatumHash tag $ hashScriptDataBytes $ unsafeHashableScriptData txOutDatum) ReferenceScriptNone - mkNewFund :: Lovelace -> TxIx -> TxId -> Fund + mkNewFund :: L.Coin -> TxIx -> TxId -> Fund mkNewFund val txIx txId = Fund $ InAnyCardanoEra (cardanoEra @era) $ FundInEra { _fundTxIn = TxIn txId txIx , _fundWitness = witness diff --git a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs index e8e2390a6b6..0631d1fc768 100644 --- a/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs +++ b/bench/tx-generator/src/Cardano/TxGenerator/Utils.hs @@ -11,12 +11,13 @@ module Cardano.TxGenerator.Utils (module Cardano.TxGenerator.Utils) where -import Data.Maybe (fromJust) - import Cardano.Api as Api +import qualified Cardano.Ledger.Coin as L import Cardano.TxGenerator.Types +import Data.Maybe (fromJust) + -- | `liftAnyEra` applies a function to the value in `InAnyCardanoEra` -- regardless of which particular era. @@ -40,7 +41,7 @@ keyAddress networkId k NoStakeAddress -- TODO: check sufficient funds and minimumValuePerUtxo -inputsToOutputsWithFee :: Lovelace -> Int -> [Lovelace] -> [Lovelace] +inputsToOutputsWithFee :: L.Coin -> Int -> [L.Coin] -> [L.Coin] inputsToOutputsWithFee fee count inputs = map (quantityToLovelace . Quantity) outputs where (Quantity totalAvailable) = lovelaceToQuantity $ sum inputs - fee @@ -50,7 +51,7 @@ inputsToOutputsWithFee fee count inputs = map (quantityToLovelace . Quantity) ou -- | 'includeChange' gets use made of it as a value splitter in -- 'Cardano.TxGenerator.Tx.sourceToStoreTransactionNew' by -- 'Cardano.Benchmarking.Script.Core.evalGenerator'. -includeChange :: Lovelace -> [Lovelace] -> [Lovelace] -> PayWithChange +includeChange :: L.Coin -> [L.Coin] -> [L.Coin] -> PayWithChange includeChange fee spend have = case compare changeValue 0 of GT -> PayWithChange changeValue spend EQ -> PayExact spend @@ -65,7 +66,7 @@ includeChange fee spend have = case compare changeValue 0 of -- | `mkTxFee` reinterprets the `Either` returned by -- `txFeesExplicitInEra` with `TxFee` constructors. -mkTxFee :: IsShelleyBasedEra era => Lovelace -> TxFee era +mkTxFee :: IsShelleyBasedEra era => L.Coin -> TxFee era mkTxFee = TxFeeExplicit shelleyBasedEra -- | `mkTxValidityUpperBound` rules out needing the diff --git a/bench/tx-generator/test/ApiTest.hs b/bench/tx-generator/test/ApiTest.hs index 540123943e9..34bec085cfd 100644 --- a/bench/tx-generator/test/ApiTest.hs +++ b/bench/tx-generator/test/ApiTest.hs @@ -30,6 +30,7 @@ import System.Exit (die, exitSuccess) import System.FilePath import Cardano.Api +import qualified Cardano.Api.Ledger as Api import Cardano.Api.Shelley (ProtocolParameters (..), fromPlutusData) import Cardano.Node.Configuration.POM (NodeConfiguration (..)) import Cardano.Node.Types (AdjustFilePaths (..), GenesisFile (..)) @@ -125,13 +126,13 @@ main -- the alternatives would make lines exceed 80 columns, so these -- helper functions move them out-of-line, with an extra helper to -- avoid repeating the failure message. -showFundCore :: IsShelleyBasedEra era => Maybe (AddressInEra era, Lovelace) -> String +showFundCore :: IsShelleyBasedEra era => Maybe (AddressInEra era, Api.Coin) -> String showFundCore = maybe "fund check failed" show -showBabbage :: Maybe (AddressInEra BabbageEra, Lovelace) -> String +showBabbage :: Maybe (AddressInEra BabbageEra, Api.Coin) -> String showBabbage = ("Babbage: " ++) . showFundCore -showConway :: Maybe (AddressInEra ConwayEra, Lovelace) -> String +showConway :: Maybe (AddressInEra ConwayEra, Api.Coin) -> String showConway = ("Conway: " ++) . showFundCore checkFund :: @@ -151,7 +152,7 @@ checkFundCore :: IsShelleyBasedEra era => ShelleyGenesis -> SigningKey PaymentKey - -> Maybe (AddressInEra era, Lovelace) + -> Maybe (AddressInEra era, Api.Coin) checkFundCore = genesisInitialFundForKey Mainnet checkPlutusBuiltin :: FilePath -> IO () diff --git a/bench/tx-generator/tx-generator.cabal b/bench/tx-generator/tx-generator.cabal index 29bf628c290..3fd75c4fa34 100644 --- a/bench/tx-generator/tx-generator.cabal +++ b/bench/tx-generator/tx-generator.cabal @@ -100,13 +100,13 @@ library , attoparsec-aeson , base16-bytestring , bytestring - , cardano-api ^>= 8.39.3.0 + , cardano-api ^>= 8.42.0.0 , cardano-binary - , cardano-cli ^>= 8.20.3.0 + , cardano-cli ^>= 8.21.0.0 , cardano-crypto-class , cardano-crypto-wrapper , cardano-data - , cardano-git-rev + , cardano-git-rev ^>= 0.2.2 , cardano-ledger-alonzo , cardano-ledger-api , cardano-ledger-byron diff --git a/cabal.project b/cabal.project index 302529aa9ac..855ad8121e4 100644 --- a/cabal.project +++ b/cabal.project @@ -13,11 +13,10 @@ 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-03-22T11:04:03Z - , cardano-haskell-packages 2024-03-18T16:52:28Z + , hackage.haskell.org 2024-03-26T06:28:59Z + , cardano-haskell-packages 2024-03-25T11:11:00Z packages: - cardano-git-rev cardano-node cardano-node-capi cardano-node-chairman diff --git a/cardano-git-rev/LICENSE b/cardano-git-rev/LICENSE deleted file mode 100644 index f433b1a53f5..00000000000 --- a/cardano-git-rev/LICENSE +++ /dev/null @@ -1,177 +0,0 @@ - - Apache License - Version 2.0, January 2004 - http://www.apache.org/licenses/ - - TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION - - 1. Definitions. - - "License" shall mean the terms and conditions for use, reproduction, - and distribution as defined by Sections 1 through 9 of this document. - - "Licensor" shall mean the copyright owner or entity authorized by - the copyright owner that is granting the License. - - "Legal Entity" shall mean the union of the acting entity and all - other entities that control, are controlled by, or are under common - control with that entity. For the purposes of this definition, - "control" means (i) the power, direct or indirect, to cause the - direction or management of such entity, whether by contract or - otherwise, or (ii) ownership of fifty percent (50%) or more of the - outstanding shares, or (iii) beneficial ownership of such entity. - - "You" (or "Your") shall mean an individual or Legal Entity - exercising permissions granted by this License. - - "Source" form shall mean the preferred form for making modifications, - including but not limited to software source code, documentation - source, and configuration files. - - "Object" form shall mean any form resulting from mechanical - transformation or translation of a Source form, including but - not limited to compiled object code, generated documentation, - and conversions to other media types. - - "Work" shall mean the work of authorship, whether in Source or - Object form, made available under the License, as indicated by a - copyright notice that is included in or attached to the work - (an example is provided in the Appendix below). - - "Derivative Works" shall mean any work, whether in Source or Object - form, that is based on (or derived from) the Work and for which the - editorial revisions, annotations, elaborations, or other modifications - represent, as a whole, an original work of authorship. For the purposes - of this License, Derivative Works shall not include works that remain - separable from, or merely link (or bind by name) to the interfaces of, - the Work and Derivative Works thereof. - - "Contribution" shall mean any work of authorship, including - the original version of the Work and any modifications or additions - to that Work or Derivative Works thereof, that is intentionally - submitted to Licensor for inclusion in the Work by the copyright owner - or by an individual or Legal Entity authorized to submit on behalf of - the copyright owner. For the purposes of this definition, "submitted" - means any form of electronic, verbal, or written communication sent - to the Licensor or its representatives, including but not limited to - communication on electronic mailing lists, source code control systems, - and issue tracking systems that are managed by, or on behalf of, the - Licensor for the purpose of discussing and improving the Work, but - excluding communication that is conspicuously marked or otherwise - designated in writing by the copyright owner as "Not a Contribution." - - "Contributor" shall mean Licensor and any individual or Legal Entity - on behalf of whom a Contribution has been received by Licensor and - subsequently incorporated within the Work. - - 2. Grant of Copyright License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - copyright license to reproduce, prepare Derivative Works of, - publicly display, publicly perform, sublicense, and distribute the - Work and such Derivative Works in Source or Object form. - - 3. Grant of Patent License. Subject to the terms and conditions of - this License, each Contributor hereby grants to You a perpetual, - worldwide, non-exclusive, no-charge, royalty-free, irrevocable - (except as stated in this section) patent license to make, have made, - use, offer to sell, sell, import, and otherwise transfer the Work, - where such license applies only to those patent claims licensable - by such Contributor that are necessarily infringed by their - Contribution(s) alone or by combination of their Contribution(s) - with the Work to which such Contribution(s) was submitted. If You - institute patent litigation against any entity (including a - cross-claim or counterclaim in a lawsuit) alleging that the Work - or a Contribution incorporated within the Work constitutes direct - or contributory patent infringement, then any patent licenses - granted to You under this License for that Work shall terminate - as of the date such litigation is filed. - - 4. Redistribution. You may reproduce and distribute copies of the - Work or Derivative Works thereof in any medium, with or without - modifications, and in Source or Object form, provided that You - meet the following conditions: - - (a) You must give any other recipients of the Work or - Derivative Works a copy of this License; and - - (b) You must cause any modified files to carry prominent notices - stating that You changed the files; and - - (c) You must retain, in the Source form of any Derivative Works - that You distribute, all copyright, patent, trademark, and - attribution notices from the Source form of the Work, - excluding those notices that do not pertain to any part of - the Derivative Works; and - - (d) If the Work includes a "NOTICE" text file as part of its - distribution, then any Derivative Works that You distribute must - include a readable copy of the attribution notices contained - within such NOTICE file, excluding those notices that do not - pertain to any part of the Derivative Works, in at least one - of the following places: within a NOTICE text file distributed - as part of the Derivative Works; within the Source form or - documentation, if provided along with the Derivative Works; or, - within a display generated by the Derivative Works, if and - wherever such third-party notices normally appear. The contents - of the NOTICE file are for informational purposes only and - do not modify the License. You may add Your own attribution - notices within Derivative Works that You distribute, alongside - or as an addendum to the NOTICE text from the Work, provided - that such additional attribution notices cannot be construed - as modifying the License. - - You may add Your own copyright statement to Your modifications and - may provide additional or different license terms and conditions - for use, reproduction, or distribution of Your modifications, or - for any such Derivative Works as a whole, provided Your use, - reproduction, and distribution of the Work otherwise complies with - the conditions stated in this License. - - 5. Submission of Contributions. Unless You explicitly state otherwise, - any Contribution intentionally submitted for inclusion in the Work - by You to the Licensor shall be under the terms and conditions of - this License, without any additional terms or conditions. - Notwithstanding the above, nothing herein shall supersede or modify - the terms of any separate license agreement you may have executed - with Licensor regarding such Contributions. - - 6. Trademarks. This License does not grant permission to use the trade - names, trademarks, service marks, or product names of the Licensor, - except as required for reasonable and customary use in describing the - origin of the Work and reproducing the content of the NOTICE file. - - 7. Disclaimer of Warranty. Unless required by applicable law or - agreed to in writing, Licensor provides the Work (and each - Contributor provides its Contributions) on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or - implied, including, without limitation, any warranties or conditions - of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A - PARTICULAR PURPOSE. You are solely responsible for determining the - appropriateness of using or redistributing the Work and assume any - risks associated with Your exercise of permissions under this License. - - 8. Limitation of Liability. In no event and under no legal theory, - whether in tort (including negligence), contract, or otherwise, - unless required by applicable law (such as deliberate and grossly - negligent acts) or agreed to in writing, shall any Contributor be - liable to You for damages, including any direct, indirect, special, - incidental, or consequential damages of any character arising as a - result of this License or out of the use or inability to use the - Work (including but not limited to damages for loss of goodwill, - work stoppage, computer failure or malfunction, or any and all - other commercial damages or losses), even if such Contributor - has been advised of the possibility of such damages. - - 9. Accepting Warranty or Additional Liability. While redistributing - the Work or Derivative Works thereof, You may choose to offer, - and charge a fee for, acceptance of support, warranty, indemnity, - or other liability obligations and/or rights consistent with this - License. However, in accepting such obligations, You may act only - on Your own behalf and on Your sole responsibility, not on behalf - of any other Contributor, and only if You agree to indemnify, - defend, and hold each Contributor harmless for any liability - incurred by, or claims asserted against, such Contributor by reason - of your accepting any such warranty or additional liability. - - END OF TERMS AND CONDITIONS diff --git a/cardano-git-rev/NOTICE b/cardano-git-rev/NOTICE deleted file mode 100644 index 3444d4dd12f..00000000000 --- a/cardano-git-rev/NOTICE +++ /dev/null @@ -1,14 +0,0 @@ -Copyright 2022-2023 Input Output Global Inc (IOG). - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. - diff --git a/cardano-git-rev/README.md b/cardano-git-rev/README.md deleted file mode 100644 index 03c5dfb1b02..00000000000 --- a/cardano-git-rev/README.md +++ /dev/null @@ -1,17 +0,0 @@ -# Cardano Git Rev - -This package exposes functions to provide git information for `cardano-node`. - -`cardano-node` support building via `nix` and `cabal` - -When building with `nix` the git executable and git metadata isn't available so the -git revision is embedded as a series of 40 zeros during the build. After the nix build -is finished the executable is patched with the correct git sha. See [set-git-rev.hs][set-git-rev.hs] - -For `cabal` the Template Haskell function `gitRev` executes in the context of the current git checkout, -requiring the `git` executable and git metadata is available at compile time. - -To use this library copy reference `Cardano.Git.Rev` module into the desired cli project and setup `nix` -to use [set-git-rev.hs][set-git-rev.hs]. - -[set-git-rev.hs]: https://github.com/input-output-hk/iohk-nix/blob/master/overlays/haskell-nix-extra/utils/set-git-rev.hs \ No newline at end of file diff --git a/cardano-git-rev/Setup.hs b/cardano-git-rev/Setup.hs deleted file mode 100644 index 44671092b28..00000000000 --- a/cardano-git-rev/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cardano-git-rev/cardano-git-rev.cabal b/cardano-git-rev/cardano-git-rev.cabal deleted file mode 100644 index 2731de02540..00000000000 --- a/cardano-git-rev/cardano-git-rev.cabal +++ /dev/null @@ -1,41 +0,0 @@ -cabal-version: 3.0 - -name: cardano-git-rev -version: 0.1.3.0 -synopsis: Git revisioning -description: Embeds git revision into Haskell packages. -category: Cardano, - Versioning, -copyright: 2022-2023 Input Output Global Inc (IOG). -author: IOHK -maintainer: operations@iohk.io -license: Apache-2.0 -license-files: LICENSE - NOTICE -build-type: Simple -extra-source-files: README.md - -common project-config - default-language: Haskell2010 - build-depends: base >= 4.14 && < 5 - - ghc-options: -Wall - -Wcompat - -Wincomplete-record-updates - -Wincomplete-uni-patterns - -Wpartial-fields - -Wredundant-constraints - -Wunused-packages - -library - import: project-config - - hs-source-dirs: src - c-sources: cbits/rev.c - - exposed-modules: Cardano.Git.Rev - Cardano.Git.RevFromGit - - build-depends: process - , template-haskell - , text diff --git a/cardano-git-rev/cbits/rev.c b/cardano-git-rev/cbits/rev.c deleted file mode 100644 index 9278983888d..00000000000 --- a/cardano-git-rev/cbits/rev.c +++ /dev/null @@ -1,11 +0,0 @@ -// -char _cardano_git_rev[68] - = "fe" - "gitrev" - "0000000000" - "0000000040" - "0000000000" - "0000000000" - "0000000000" - "0000000000" - ; \ No newline at end of file diff --git a/cardano-git-rev/src/Cardano/Git/Rev.hs b/cardano-git-rev/src/Cardano/Git/Rev.hs deleted file mode 100644 index 7d8972465af..00000000000 --- a/cardano-git-rev/src/Cardano/Git/Rev.hs +++ /dev/null @@ -1,44 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ForeignFunctionInterface #-} - -module Cardano.Git.Rev - ( gitRev - ) where - -import Data.Text (Text) -import qualified Data.Text as T - -#if !defined(arm_HOST_ARCH) -import Cardano.Git.RevFromGit (gitRevFromGit) -#endif -import GHC.Foreign (peekCStringLen) -import Foreign.C.String (CString) -import System.IO (utf8) -import System.IO.Unsafe (unsafeDupablePerformIO) - -foreign import ccall "&_cardano_git_rev" c_gitrev :: CString - -gitRev :: Text -gitRev | gitRevEmbed /= zeroRev = gitRevEmbed - | T.null fromGit = zeroRev - | otherwise = fromGit - where - -- Git revision embedded after compilation using - -- Data.FileEmbed.injectWith. If nothing has been injected, - -- this will be filled with 0 characters. - gitRevEmbed :: Text - gitRevEmbed = T.pack $ drop 28 $ unsafeDupablePerformIO (peekCStringLen utf8 (c_gitrev, 68)) - - -- Git revision found during compilation by running git. If - -- git could not be run, then this will be empty. -#if defined(arm_HOST_ARCH) - -- cross compiling to arm fails; due to a linker bug - fromGit = "" -#else - fromGit = T.strip (T.pack $(gitRevFromGit)) -#endif - -zeroRev :: Text -zeroRev = "0000000000000000000000000000000000000000" diff --git a/cardano-git-rev/src/Cardano/Git/RevFromGit.hs b/cardano-git-rev/src/Cardano/Git/RevFromGit.hs deleted file mode 100644 index b60314ff236..00000000000 --- a/cardano-git-rev/src/Cardano/Git/RevFromGit.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Cardano.Git.RevFromGit - ( gitRevFromGit - ) where - -import Control.Exception (catch) -import System.Exit (ExitCode (..)) -import qualified System.IO as IO -import System.IO.Error (isDoesNotExistError) -import System.Process (readProcessWithExitCode) - -import qualified Language.Haskell.TH as TH - --- | Git revision found by running git rev-parse. If git could not be --- executed, then this will be an empty string. -gitRevFromGit :: TH.Q TH.Exp -gitRevFromGit = - TH.LitE . TH.StringL <$> TH.runIO runGitRevParse - where - runGitRevParse :: IO String - runGitRevParse = do - (exitCode, output, errorMessage) <- readProcessWithExitCode_ "git" ["rev-parse", "--verify", "HEAD"] "" - case exitCode of - ExitSuccess -> pure output - ExitFailure _ -> do - IO.hPutStrLn IO.stderr $ "WARNING: " ++ errorMessage - pure "" - - readProcessWithExitCode_ :: FilePath -> [String] -> String -> IO (ExitCode, String, String) - readProcessWithExitCode_ cmd args input = - catch (readProcessWithExitCode cmd args input) $ \e -> - if isDoesNotExistError e - then return (ExitFailure 127, "", show e) - else return (ExitFailure 999, "", show e) diff --git a/cardano-node-chairman/app/Cardano/Chairman/Commands/Version.hs b/cardano-node-chairman/app/Cardano/Chairman/Commands/Version.hs index 38f59a37497..3085fae88b4 100644 --- a/cardano-node-chairman/app/Cardano/Chairman/Commands/Version.hs +++ b/cardano-node-chairman/app/Cardano/Chairman/Commands/Version.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TemplateHaskell #-} module Cardano.Chairman.Commands.Version ( VersionOptions(..) , cmdVersion @@ -25,7 +26,7 @@ runVersionOptions VersionOptions = do [ "cardano-node ", showVersion version , " - ", os, "-", arch , " - ", compilerName, "-", showVersion compilerVersion - , "\ngit rev ", T.unpack gitRev + , "\ngit rev ", T.unpack $(gitRev) ] cmdVersion :: Mod CommandFields (IO ()) diff --git a/cardano-node-chairman/cardano-node-chairman.cabal b/cardano-node-chairman/cardano-node-chairman.cabal index 7142e606c37..68d2fe8390e 100644 --- a/cardano-node-chairman/cardano-node-chairman.cabal +++ b/cardano-node-chairman/cardano-node-chairman.cabal @@ -43,7 +43,7 @@ executable cardano-node-chairman "-with-rtsopts=-T" build-depends: cardano-api , cardano-crypto-class - , cardano-git-rev + , cardano-git-rev ^>=0.2.2 , cardano-node ^>= 8.9 , cardano-prelude , containers @@ -88,5 +88,5 @@ test-suite chairman-tests ghc-options: -threaded -rtsopts "-with-rtsopts=-N -T" build-tool-depends: cardano-node:cardano-node - , cardano-cli:cardano-cli ^>= 8.20.3.0 + , cardano-cli:cardano-cli ^>= 8.21.0.0 , cardano-node-chairman:cardano-node-chairman diff --git a/cardano-node/app/cardano-node.hs b/cardano-node/app/cardano-node.hs index 9d10aa509ec..2056232b0f3 100644 --- a/cardano-node/app/cardano-node.hs +++ b/cardano-node/app/cardano-node.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} import qualified Cardano.Crypto.Init as Crypto import Cardano.Git.Rev (gitRev) @@ -89,7 +90,7 @@ runVersionCommand = [ "cardano-node ", renderVersion version , " - ", Text.pack os, "-", Text.pack arch , " - ", Text.pack compilerName, "-", renderVersion compilerVersion - , "\ngit rev ", gitRev + , "\ngit rev ", $(gitRev) ] where renderVersion = Text.pack . showVersion diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index c92f706a1f9..539c545dd00 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -144,10 +144,10 @@ library , async , base16-bytestring , bytestring - , cardano-api ^>= 8.39.3.0 + , cardano-api ^>= 8.42.0.0 , cardano-crypto-class , cardano-crypto-wrapper - , cardano-git-rev + , cardano-git-rev ^>=0.2.2 , cardano-ledger-alonzo , cardano-ledger-allegra , cardano-ledger-api diff --git a/cardano-node/src/Cardano/Node/Configuration/Logging.hs b/cardano-node/src/Cardano/Node/Configuration/Logging.hs index b522004c7be..cad45ea0495 100644 --- a/cardano-node/src/Cardano/Node/Configuration/Logging.hs +++ b/cardano-node/src/Cardano/Node/Configuration/Logging.hs @@ -5,6 +5,7 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} module Cardano.Node.Configuration.Logging @@ -173,7 +174,7 @@ createLoggingLayer ver nodeConfig' p = do -- These have to be set before the switchboard is set up. liftIO $ do Config.setTextOption logConfig "appversion" ver - Config.setTextOption logConfig "appcommit" gitRev + Config.setTextOption logConfig "appcommit" $(gitRev) (baseTrace', switchBoard) <- liftIO $ setupTrace_ logConfig "cardano" @@ -352,7 +353,7 @@ nodeBasicInfo nc (SomeConsensusProtocol whichP pForInfo) nodeStartTime' = do items = nub $ [ ("protocol", pack . show $ ncProtocol nc) , ("version", pack . showVersion $ version) - , ("commit", gitRev) + , ("commit", $(gitRev)) , ("nodeStartTime", textShow nodeStartTime') ] ++ protocolDependentItems logObjects = diff --git a/cardano-node/src/Cardano/Node/Startup.hs b/cardano-node/src/Cardano/Node/Startup.hs index 6b2289caaa9..d290b8b460b 100644 --- a/cardano-node/src/Cardano/Node/Startup.hs +++ b/cardano-node/src/Cardano/Node/Startup.hs @@ -4,6 +4,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} @@ -213,7 +214,7 @@ prepareNodeInfo nc (SomeConsensusProtocol whichP pForInfo) tc nodeStartTime = do { niName = nodeName , niProtocol = pack . show . ncProtocol $ nc , niVersion = pack . showVersion $ version - , niCommit = gitRev + , niCommit = $(gitRev) , niStartTime = nodeStartTime , niSystemStartTime = systemStartTime } diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index 341ab3dac10..5ff68f54bb1 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs @@ -3,6 +3,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-name-shadowing -Wno-orphans #-} @@ -69,7 +70,7 @@ getStartupInfo nc (SomeConsensusProtocol whichP pForInfo) fp = do basicInfoCommon = BICommon $ BasicInfoCommon { biProtocol = pack . show $ ncProtocol nc , biVersion = pack . showVersion $ version - , biCommit = gitRev + , biCommit = $(gitRev) , biNodeStartTime = nodeStartTime , biConfigPath = fp , biNetworkMagic = getNetworkMagic $ Consensus.configBlock cfg diff --git a/cardano-submit-api/cardano-submit-api.cabal b/cardano-submit-api/cardano-submit-api.cabal index e587c260290..f1fb46b0463 100644 --- a/cardano-submit-api/cardano-submit-api.cabal +++ b/cardano-submit-api/cardano-submit-api.cabal @@ -39,9 +39,9 @@ library , aeson , async , bytestring - , cardano-api ^>= 8.39.3.0 + , cardano-api ^>= 8.42.0.0 , cardano-binary - , cardano-cli ^>= 8.20.3.0 + , cardano-cli ^>= 8.21.0.0 , cardano-crypto-class ^>= 2.1.2 , http-media , iohk-monitoring diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal index e181e6c13f1..0343db57ec8 100644 --- a/cardano-testnet/cardano-testnet.cabal +++ b/cardano-testnet/cardano-testnet.cabal @@ -34,11 +34,11 @@ library build-depends: aeson , ansi-terminal , bytestring - , cardano-api ^>= 8.39.3.0 - , cardano-cli ^>= 8.20.3.0 + , cardano-api ^>= 8.42.0.0 + , cardano-cli ^>= 8.21.0.0 , cardano-crypto-class , cardano-crypto-wrapper - , cardano-git-rev + , cardano-git-rev ^>= 0.2.2 , cardano-ledger-alonzo , cardano-ledger-binary , cardano-ledger-byron @@ -207,6 +207,7 @@ test-suite cardano-testnet-test , cardano-testnet , containers , directory + , exceptions , filepath , hedgehog , hedgehog-extras diff --git a/cardano-testnet/src/Parsers/Version.hs b/cardano-testnet/src/Parsers/Version.hs index 4ccba72d56c..8ca9a67409b 100644 --- a/cardano-testnet/src/Parsers/Version.hs +++ b/cardano-testnet/src/Parsers/Version.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE TemplateHaskell #-} + module Parsers.Version ( VersionOptions(..) , cmdVersion @@ -30,7 +32,7 @@ runVersionOptions VersionOptions = do [ "cardano-node ", showVersion version , " - ", os, "-", arch , " - ", compilerName, "-", showVersion compilerVersion - , "\ngit rev ", T.unpack gitRev + , "\ngit rev ", T.unpack $(gitRev) ] cmdVersion :: Mod CommandFields VersionOptions diff --git a/cardano-testnet/src/Testnet/Components/Configuration.hs b/cardano-testnet/src/Testnet/Components/Configuration.hs index 3ddb9613c8b..9abaf49d0e8 100644 --- a/cardano-testnet/src/Testnet/Components/Configuration.hs +++ b/cardano-testnet/src/Testnet/Components/Configuration.hs @@ -41,7 +41,7 @@ import qualified Data.Text as Text import GHC.Stack (HasCallStack) import qualified GHC.Stack as GHC import Lens.Micro -import System.FilePath.Posix (takeDirectory, takeFileName, ()) +import System.FilePath.Posix (takeDirectory, ()) import Testnet.Defaults import Testnet.Filepath @@ -97,6 +97,8 @@ createSPOGenesisAndFiles -> m FilePath -- ^ Shelley genesis directory createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis alonzoGenesis conwayGenesis (TmpAbsolutePath tempAbsPath) = do let genesisShelleyFpAbs = tempAbsPath defaultGenesisFilepath ShelleyEra + genesisAlonzoFpAbs = tempAbsPath defaultGenesisFilepath AlonzoEra + genesisConwayFpAbs = tempAbsPath defaultGenesisFilepath ConwayEra genesisShelleyDirAbs = takeDirectory genesisShelleyFpAbs genesisShelleyDir <- H.createDirectoryIfMissing genesisShelleyDirAbs let testnetMagic = sgNetworkMagic shelleyGenesis @@ -108,7 +110,10 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis alonzoGenesi -- We should *never* be modifying the genesis file after @cardanoTestnet@ is run because this -- is sure to be a source of confusion if users provide genesis files and we are mutating them -- without their knowledge. - H.evalIO $ LBS.writeFile genesisShelleyFpAbs $ encode shelleyGenesis + H.evalIO $ do + LBS.writeFile genesisShelleyFpAbs $ encode shelleyGenesis + LBS.writeFile genesisAlonzoFpAbs $ encode alonzoGenesis + LBS.writeFile genesisConwayFpAbs $ encode conwayGenesis -- TODO: Remove this rewrite. -- 50 second epochs @@ -131,6 +136,8 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis alonzoGenesi execCli_ [ anyEraToString era, "genesis", "create-testnet-data" , "--spec-shelley", genesisShelleyFpAbs + , "--spec-alonzo", genesisAlonzoFpAbs + , "--spec-conway", genesisConwayFpAbs , "--testnet-magic", show testnetMagic , "--pools", show numPoolNodes , "--total-supply", show @Int 2_000_000_000_000 @@ -153,14 +160,8 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis alonzoGenesi forM_ files $ \file -> do H.note file - -- TODO: This conway and alonzo genesis creation can be removed, - -- as this will be done by create-testenet-data when cardano-cli is upgraded above 8.20.3.0. - writeGenesisFile genesisShelleyDir AlonzoEra alonzoGenesis - writeGenesisFile genesisShelleyDir ConwayEra conwayGenesis - H.renameFile (tempAbsPath "byron-gen-command" "genesis.json") (genesisByronDir "genesis.json") - -- TODO: create-testnet-data outputs the new shelley genesis to genesis.json - H.renameFile (tempAbsPath "genesis.json") (genesisShelleyDir "genesis.shelley.json") + H.renameFile (tempAbsPath "shelley-genesis.json") (genesisShelleyDir "genesis.shelley.json") -- For some reason when setting "--total-supply 10E16" in create-testnet-data, we're getting negative -- treasury. TODO: This should be fixed by https://github.com/IntersectMBO/cardano-cli/pull/644 @@ -169,12 +170,6 @@ createSPOGenesisAndFiles (NumPools numPoolNodes) era shelleyGenesis alonzoGenesi & L.key "maxLovelaceSupply" . L._Integer .~ 10_000_000_000_000_000 return genesisShelleyDir - where - writeGenesisFile :: (MonadTest m, MonadIO m, HasCallStack) => ToJSON b => FilePath -> CardanoEra a -> b -> m () - writeGenesisFile dir era' toWrite = GHC.withFrozenCallStack $ do - let filename = takeFileName $ defaultGenesisFilepath era' - targetJsonFile <- H.noteShow (dir filename) - H.evalIO $ LBS.writeFile targetJsonFile $ Aeson.encode toWrite ifaceAddress :: String ifaceAddress = "127.0.0.1" diff --git a/cardano-testnet/src/Testnet/Components/Query.hs b/cardano-testnet/src/Testnet/Components/Query.hs index 444dc0dbb7a..313e7c55c9a 100644 --- a/cardano-testnet/src/Testnet/Components/Query.hs +++ b/cardano-testnet/src/Testnet/Components/Query.hs @@ -63,7 +63,7 @@ import Hedgehog.Internal.Property (MonadTest) -- | Block and wait for the desired epoch. waitUntilEpoch - :: (MonadIO m, MonadTest m, HasCallStack) + :: (MonadCatch m, MonadIO m, MonadTest m, HasCallStack) => NodeConfigFile In -> SocketPath -> EpochNo -- ^ Desired epoch @@ -71,7 +71,7 @@ waitUntilEpoch waitUntilEpoch nodeConfigFile socketPath desiredEpoch = withFrozenCallStack $ do result <- runExceptT $ foldEpochState - nodeConfigFile socketPath QuickValidation desiredEpoch () (const $ pure ConditionNotMet) + nodeConfigFile socketPath QuickValidation desiredEpoch () (\_ _ _ -> pure ConditionNotMet) case result of Left (FoldBlocksApplyBlockError (TerminationEpochReached epochNo)) -> pure epochNo @@ -133,7 +133,7 @@ getEpochStateView getEpochStateView nodeConfigFile socketPath = withFrozenCallStack $ do epochStateView <- liftIO $ newIORef Nothing runInBackground . runExceptT . foldEpochState nodeConfigFile socketPath QuickValidation (EpochNo maxBound) Nothing - $ \epochState -> do + $ \epochState _slotNb _blockNb -> do liftIO $ writeIORef epochStateView (Just epochState) pure ConditionNotMet pure . EpochStateView $ epochStateView @@ -229,7 +229,7 @@ findLargestUtxoForPaymentKey epochStateView sbe address = -- wait for the number of DReps being @n@ for two epochs. If -- this number is not attained before two epochs, the test is failed. checkDRepsNumber :: - (HasCallStack, MonadIO m, MonadCatch m, MonadTest m) + (HasCallStack, MonadCatch m, MonadIO m, MonadTest m) => ShelleyBasedEra ConwayEra -- ^ The era in which the test runs -> NodeConfigFile 'In -> SocketPath @@ -248,7 +248,7 @@ checkDRepsNumber sbe configurationFile socketPath execConfig expectedDRepsNb = d -- So if you call this function, you are expecting the number of DReps to already -- be @n@, or to be @n@ before @terminationEpoch@ checkDRepsNumber' :: - (HasCallStack, MonadIO m, MonadTest m) + (HasCallStack, MonadCatch m, MonadIO m, MonadTest m) => ShelleyBasedEra ConwayEra -- ^ The era in which the test runs -> NodeConfigFile In -> SocketPath @@ -257,7 +257,7 @@ checkDRepsNumber' :: -> m (Maybe [L.DRepState StandardCrypto]) -- ^ The DReps when the expected number of DReps was attained. checkDRepsNumber' sbe nodeConfigFile socketPath maxEpoch expectedDRepsNb = do result <- runExceptT $ foldEpochState nodeConfigFile socketPath QuickValidation maxEpoch Nothing - $ \(AnyNewEpochState actualEra newEpochState) -> do + $ \(AnyNewEpochState actualEra newEpochState) _slotNb _blockNb -> do case testEquality sbe actualEra of Just Refl -> do let dreps = Map.elems $ shelleyBasedEraConstraints sbe newEpochState diff --git a/cardano-testnet/src/Testnet/Runtime.hs b/cardano-testnet/src/Testnet/Runtime.hs index acfd50c589d..b0a4c9634c0 100644 --- a/cardano-testnet/src/Testnet/Runtime.hs +++ b/cardano-testnet/src/Testnet/Runtime.hs @@ -321,7 +321,7 @@ startLedgerNewEpochStateLogging testnetRuntime tmpWorkspace = withFrozenCallStac Api.QuickValidation (EpochNo maxBound) () - (handler logFile) + (\epochState _ _ -> handler logFile epochState) H.note_ $ "Started logging epoch states to to: " <> logFile where handler :: FilePath -> AnyNewEpochState -> StateT () IO LedgerStateCondition diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs index fa1c1820429..616dc3193e9 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/Cli/Babbage/Transaction.hs @@ -118,4 +118,4 @@ txOutValue (TxOut _ v _ _) = v txOutValueLovelace ::TxOutValue era -> L.Coin txOutValueLovelace = \case TxOutValueShelleyBased sbe v -> v ^. A.adaAssetL sbe - TxOutValueByron (Lovelace v) -> L.Coin v + TxOutValueByron v -> v diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs index d9acea41f7e..1f61139a3a8 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitution.hs @@ -315,7 +315,7 @@ hprop_ledger_events_propose_new_constitution = H.integrationWorkspace "propose-n FullValidation (EpochNo 10) () - (foldBlocksCheckConstitutionWasRatified constitutionHash constitutionScriptHash) + (\epochState _ _ -> foldBlocksCheckConstitutionWasRatified constitutionHash constitutionScriptHash epochState) void $ evalEither eConstitutionAdopted diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitutionSPO.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitutionSPO.hs index b6b050900a6..e57d31ff279 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitutionSPO.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/Gov/ProposeNewConstitutionSPO.hs @@ -29,6 +29,7 @@ import Cardano.Testnet import Prelude +import Control.Monad.Catch (MonadCatch) import Control.Monad.Trans.State.Strict (put) import Data.Bifunctor (Bifunctor (..)) import Data.List (isInfixOf) @@ -231,16 +232,14 @@ hprop_ledger_events_propose_new_constitution_spo = H.integrationWorkspace "propo H.assert $ "DisallowedVoters" `isInfixOf` stderr -- Did it fail for the expected reason? getConstitutionProposal - :: HasCallStack - => MonadIO m - => MonadTest m + :: (HasCallStack, MonadCatch m, MonadIO m, MonadTest m) => NodeConfigFile In -> SocketPath -> EpochNo -- ^ The termination epoch: the constitution proposal must be found *before* this epoch -> m (Maybe (L.GovActionId StandardCrypto)) getConstitutionProposal nodeConfigFile socketPath maxEpoch = do result <- runExceptT $ foldEpochState nodeConfigFile socketPath QuickValidation maxEpoch Nothing - $ \(AnyNewEpochState actualEra newEpochState) -> + $ \(AnyNewEpochState actualEra newEpochState) _slotNb _blockNb -> caseShelleyToBabbageOrConwayEraOnwards (error $ "Expected Conway era onwards, got state in " <> docToString (pretty actualEra)) (\cEra -> conwayEraOnwardsConstraints cEra $ do diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/TreasuryGrowth.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/TreasuryGrowth.hs index 7427b98dcfb..0e35a0c401f 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/TreasuryGrowth.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/LedgerEvents/TreasuryGrowth.hs @@ -67,15 +67,15 @@ prop_check_if_treasury_is_growing = H.integrationRetryWorkspace 0 "growing-treas H.note_ "treasury is not growing" H.failure where - handler :: AnyNewEpochState -> StateT (Map EpochNo Integer) IO LedgerStateCondition - handler (AnyNewEpochState _ newEpochState) = do + handler :: AnyNewEpochState -> SlotNo -> BlockNo -> StateT (Map EpochNo Integer) IO LedgerStateCondition + handler (AnyNewEpochState _ newEpochState) _slotNo _blockNo = do let (Coin coin) = newEpochState ^. L.nesEsL . L.esAccountStateL . L.asTreasuryL epochNo = newEpochState ^. L.nesELL -- handler is executed multiple times per epoch, so we keep only the latest treasury value modify $ M.insert epochNo coin - if epochNo >= EpochNo 5 - then pure ConditionMet - else pure ConditionNotMet + pure $ if epochNo >= EpochNo 5 + then ConditionMet + else ConditionNotMet -- | Check if the last element > first element checkHasIncreased :: (Ord a) => [a] -> Bool diff --git a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs index 84fba48eef4..13e29cb6bb5 100644 --- a/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs +++ b/cardano-testnet/test/cardano-testnet-test/Cardano/Testnet/Test/SubmitApi/Babbage/Transaction.hs @@ -223,4 +223,4 @@ txOutValue (TxOut _ v _ _) = v txOutValueLovelace ::TxOutValue era -> L.Coin txOutValueLovelace = \case TxOutValueShelleyBased sbe v -> v ^. A.adaAssetL sbe - TxOutValueByron (Lovelace v) -> L.Coin v + TxOutValueByron v -> v diff --git a/cardano-tracer/cardano-tracer.cabal b/cardano-tracer/cardano-tracer.cabal index e2904cff589..81e4b18f821 100644 --- a/cardano-tracer/cardano-tracer.cabal +++ b/cardano-tracer/cardano-tracer.cabal @@ -137,7 +137,7 @@ library , bimap >= 0.4.0 , blaze-html , bytestring - , cardano-git-rev + , cardano-git-rev ^>=0.2.2 , cardano-node , cassava , cborg diff --git a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/About.hs b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/About.hs index 4fa483f9f07..06f0689e9b6 100644 --- a/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/About.hs +++ b/cardano-tracer/src/Cardano/Tracer/Handlers/RTView/UI/HTML/About.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} module Cardano.Tracer.Handlers.RTView.UI.HTML.About ( mkAboutInfo @@ -106,7 +107,7 @@ mkAboutInfo = do on UI.click closeIt . const $ element info #. "modal" return info where - commit = T.unpack . T.take 7 $ gitRev + commit = T.unpack . T.take 7 $ $(gitRev) currentOS :: String currentOS = diff --git a/flake.lock b/flake.lock index ba533ab7146..0bba46c01a3 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1711044046, - "narHash": "sha256-EdcE43LQtfzNFiwQfQp9RGqZizpfMR7fAT4XG3M9iO8=", + "lastModified": 1711365846, + "narHash": "sha256-sM0Z4WL/Xu+WCuxoM3rSt/lX+tgS/0fKLsiuYXePaJo=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "50ff95f584e05c942c9fabdd1b176996a0fb0cc5", + "rev": "ba421ee9ce54533f5953a9468cdcf5ab33c36599", "type": "github" }, "original": { @@ -624,11 +624,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1711066960, - "narHash": "sha256-KJtft6ryg++1PfwbbBkFZedOv4xeuge6IV5FBRa0f7s=", + "lastModified": 1711412520, + "narHash": "sha256-48Aw1X7IuXZR6Wi2WOlvj9HpoUHty/JW1MqAehgnoHo=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "dca16b7a7eb69d9c0fdf5a4f205b347c19eb80bb", + "rev": "fc84d1170ccc83d50db7b71a6edd090b2cef7657", "type": "github" }, "original": { diff --git a/nix/haskell.nix b/nix/haskell.nix index 437a1755124..541f31efc4d 100644 --- a/nix/haskell.nix +++ b/nix/haskell.nix @@ -332,7 +332,7 @@ let lib.mkIf (pkgs.stdenv.hostPlatform.isMusl && config.package.isLocal) { # Module options which adds GHC flags and libraries for a fully static build - enableShared = false; + enableShared = true; # TH code breaks if this is false. enableStatic = true; } )); @@ -342,10 +342,6 @@ let { # Haddock not working and not needed for cross builds doHaddock = false; - packages.cardano-cli.enableShared = false; - packages.cardano-cli.enableStatic = true; - # Needed for TH code in cardano-cli - packages.cardano-git-rev.enableShared = lib.mkForce true; }; }) ({ lib, pkgs, ... }: lib.mkIf (pkgs.stdenv.hostPlatform != pkgs.stdenv.buildPlatform) {