From 9063377c6359396e5f86d62bdd22ca448c894de9 Mon Sep 17 00:00:00 2001 From: card Date: Wed, 29 Nov 2023 13:56:29 -0500 Subject: [PATCH] bugfixes, end to end offline mode tests --- hydra-cluster/hydra-cluster.cabal | 2 - hydra-cluster/src/Hydra/Cluster/Faucet.hs | 3 +- hydra-cluster/src/Hydra/Cluster/Util.hs | 121 ++++++++++++++---- hydra-cluster/src/HydraNode.hs | 83 ++++++------ hydra-cluster/test/Test/ChainSpec.hs | 36 ------ hydra-cluster/test/Test/DirectChainSpec.hs | 13 +- hydra-cluster/test/Test/EndToEndSpec.hs | 43 +++++-- hydra-cluster/test/Test/OfflineChainSpec.hs | 64 --------- hydra-node/src/Hydra/Chain/Direct.hs | 1 - .../src/Hydra/Chain/Offline/Handlers.hs | 14 +- .../src/Hydra/Chain/Offline/Persistence.hs | 13 +- hydra-node/src/Hydra/Node/Run.hs | 94 +++++++------- hydra-node/src/Hydra/Options.hs | 11 +- nix/hydra/shell.nix | 62 ++++----- 14 files changed, 261 insertions(+), 299 deletions(-) delete mode 100644 hydra-cluster/test/Test/ChainSpec.hs delete mode 100644 hydra-cluster/test/Test/OfflineChainSpec.hs diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index ce76218a493..d02505838d3 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -148,12 +148,10 @@ test-suite tests other-modules: Paths_hydra_cluster Spec - Test.ChainSpec Test.CardanoClientSpec Test.CardanoNodeSpec Test.ChainObserverSpec Test.DirectChainSpec - Test.OfflineChainSpec Test.EndToEndSpec Test.GeneratorSpec Test.Hydra.Cluster.CardanoCliSpec diff --git a/hydra-cluster/src/Hydra/Cluster/Faucet.hs b/hydra-cluster/src/Hydra/Cluster/Faucet.hs index 6d192cc8bf6..d51d991be5c 100644 --- a/hydra-cluster/src/Hydra/Cluster/Faucet.hs +++ b/hydra-cluster/src/Hydra/Cluster/Faucet.hs @@ -98,8 +98,9 @@ seedFromFaucet_ :: seedFromFaucet_ node vk ll tracer = void $ seedFromFaucet node vk ll tracer ---TODO(Elaine): we probably want a simplified but parallel version of this/createOutputAddress for offline mode , that just constructs a UTxO +-- TODO(Elaine): we probably want a simplified but parallel version of this/createOutputAddress for offline mode , that just constructs a UTxO -- actually no take a look at seedFromFaucet + -- | Return the remaining funds to the faucet returnFundsToFaucet :: Tracer IO FaucetLog -> diff --git a/hydra-cluster/src/Hydra/Cluster/Util.hs b/hydra-cluster/src/Hydra/Cluster/Util.hs index f1e172d8a11..03720557d3b 100644 --- a/hydra-cluster/src/Hydra/Cluster/Util.hs +++ b/hydra-cluster/src/Hydra/Cluster/Util.hs @@ -1,40 +1,68 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DisambiguateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE AllowAmbiguousTypes #-} - +{-# LANGUAGE ScopedTypeVariables #-} -- | Utilities used across hydra-cluster -module Hydra.Cluster.Util where +module Hydra.Cluster.Util ( + readConfigFile, + keysFor, + createAndSaveSigningKey, + offlineConfigFor, + offlineConfigForUTxO, + chainConfigFor, + initialUtxoWithFunds, + buildAddress, +) where import Hydra.Prelude import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS +import Data.Map qualified as Map import Hydra.Cardano.Api ( + Address, AsType (AsPaymentKey, AsSigningKey), HasTypeProxy (AsType), - Key (VerificationKey, getVerificationKey), + IsCardanoEra, + IsShelleyBasedEra, + Key (VerificationKey, getVerificationKey, verificationKeyHash), + Lovelace, + NetworkId, PaymentKey, - SigningKey, + ShelleyAddr, + SigningKey (GenesisUTxOSigningKey, PaymentSigningKey), SocketPath, + StakeAddressReference (NoStakeAddress), TextEnvelopeError (TextEnvelopeAesonDecodeError), + Tx, + TxOutValue (TxOutValue), + UTxO' (UTxO), + VerificationKey (GenesisUTxOVerificationKey, PaymentVerificationKey), + castSigningKey, + castVerificationKey, deserialiseFromTextEnvelope, + genesisUTxOPseudoTxIn, + lovelaceToTxOutValue, + mkTxOutValue, + shelleyAddressInEra, textEnvelopeToJSON, ) +import Hydra.Cardano.Api.MultiAssetSupportedInEra (HasMultiAsset) +import Hydra.Cardano.Api.Prelude (PaymentCredential (PaymentCredentialByKey), ReferenceScript (ReferenceScriptNone), TxOut (TxOut), TxOutDatum (TxOutDatumNone), Value, lovelaceToTxOutValue, makeShelleyAddress, shelleyAddressInEra) +import Hydra.Chain (ChainEvent, OnChainTx (OnInitTx, contestationPeriod, parties), PostChainTx) import Hydra.Cluster.Fixture (Actor, actorName) import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Ledger.Cardano (genSigningKey) -import Hydra.Options (ChainConfig (..), defaultChainConfig) +import Hydra.Options (ChainConfig (..), OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), defaultChainConfig) +import Hydra.Party (Party) import Paths_hydra_cluster qualified as Pkg import System.FilePath ((<.>), ()) -import Test.Hydra.Prelude (failure, Expectation, shouldBe) +import Test.Hydra.Prelude (Expectation, failure, shouldBe) import Test.QuickCheck (generate) -import Hydra.Chain (PostChainTx) -import Hydra.Chain (ChainEvent) -import Hydra.Ledger (IsTx) -import Hydra.Party (Party) -import Hydra.Chain (OnChainTx(OnInitTx, contestationPeriod, parties)) -import Hydra.Ledger (IsTx(UTxOType)) + +-- import CardanoClient (buildAddress) -- | Lookup a config file similar reading a file from disk. -- If the env variable `HYDRA_CONFIG_DIR` is set, filenames will be @@ -70,6 +98,62 @@ createAndSaveSigningKey path = do writeFileLBS path $ textEnvelopeToJSON (Just "Key used to commit funds into a Head") sk pure sk +offlineConfigFor :: [(Actor, Value)] -> FilePath -> NetworkId -> IO OfflineConfig +offlineConfigFor actorToVal targetDir networkId = do + initialUtxoForActors actorToVal networkId >>= offlineConfigForUTxO @Tx targetDir + +offlineConfigForUTxO :: forall tx. IsTx tx => FilePath -> UTxOType tx -> IO OfflineConfig +offlineConfigForUTxO targetDir utxo = do + utxoPath <- seedInitialUTxOFromOffline @tx targetDir utxo + pure $ + OfflineConfig + { initialUTxOFile = utxoPath + , ledgerGenesisFile = Nothing + } + +seedInitialUTxOFromOffline :: IsTx tx => FilePath -> UTxOType tx -> IO FilePath +seedInitialUTxOFromOffline targetDir utxo = do + let destinationPath = targetDir "utxo.json" + writeFileBS destinationPath . toStrict . Aeson.encode $ utxo + + -- Aeson.throwDecodeStrict =<< readFileBS (targetDir "utxo.json") + pure destinationPath + +buildAddress :: VerificationKey PaymentKey -> NetworkId -> Address ShelleyAddr +buildAddress vKey networkId = + makeShelleyAddress networkId (PaymentCredentialByKey $ verificationKeyHash vKey) NoStakeAddress + +initialUtxoWithFunds :: + forall era ctx. + (IsShelleyBasedEra era, HasMultiAsset era) => + NetworkId -> + [(VerificationKey PaymentKey, Value)] -> + IO (UTxO' (TxOut ctx era)) +initialUtxoWithFunds networkId valueMap = + pure + . UTxO + . Map.fromList + . map (\(vKey, val) -> (txin vKey, txout vKey val)) + $ valueMap + where + txout vKey val = + TxOut + (shelleyAddressInEra @era $ buildAddress vKey networkId) + (mkTxOutValue val) + TxOutDatumNone + ReferenceScriptNone + txin vKey = genesisUTxOPseudoTxIn networkId (verificationKeyHash . castKey $ vKey) + castKey (PaymentVerificationKey vkey) = GenesisUTxOVerificationKey vkey + +initialUtxoForActors :: [(Actor, Value)] -> NetworkId -> IO (UTxOType Tx) +initialUtxoForActors actorToVal networkId = do + initialUtxoWithFunds networkId =<< vkToVal + where + vkForActor actor = fmap fst (keysFor actor) + vkToVal = + forM actorToVal $ \(actor, val) -> + vkForActor actor <&> (,val) + chainConfigFor :: HasCallStack => Actor -> FilePath -> SocketPath -> [Actor] -> ContestationPeriod -> IO ChainConfig chainConfigFor me targetDir nodeSocket them cp = do when (me `elem` them) $ @@ -91,14 +175,3 @@ chainConfigFor me targetDir nodeSocket them cp = do vkTarget x = targetDir vkName x skName x = actorName x <.> ".sk" vkName x = actorName x <.> ".vk" - -seedInitialUTxOFromOffline :: IsTx tx => UTxOType tx -> FilePath -> IO () -seedInitialUTxOFromOffline utxo targetDir = do - -- i assume a static file might be too rigid ? we can keep around constants and then write them to disk for each test - -- readConfigFile "initial-utxo.json" >>= writeFileBS (targetDir "initial-utxo.json") - - writeFileBS (targetDir "utxo.json") . toStrict . Aeson.encode $ utxo - - -- Aeson.throwDecodeStrict =<< readFileBS (targetDir "utxo.json") - pure () - diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index b8b4e56d065..1d297183173 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -25,10 +25,11 @@ import Hydra.Ledger.Cardano () import Hydra.Logging (Tracer, Verbosity (..), traceWith) import Hydra.Network (Host (Host), NodeId (NodeId)) import Hydra.Network qualified as Network -import Hydra.Options (ChainConfig (..), LedgerConfig (..), RunOptions (..), defaultChainConfig, toArgs) +import Hydra.Options (ChainConfig (..), LedgerConfig (..), OfflineConfig, RunOptions (..), defaultChainConfig, toArgs) import Network.HTTP.Req (GET (..), HttpException, JsonResponse, NoReqBody (..), POST (..), ReqBodyJson (..), defaultHttpConfig, responseBody, runReq, (/:)) import Network.HTTP.Req qualified as Req import Network.WebSockets (Connection, receiveData, runClient, sendClose, sendTextData) +import System.Directory (createDirectoryIfMissing) import System.FilePath ((<.>), ()) import System.IO.Temp (withSystemTempDirectory) import System.Process ( @@ -40,7 +41,6 @@ import System.Process ( ) import Test.Hydra.Prelude (checkProcessHasNotDied, failAfter, failure, withLogFile) import Prelude qualified -import Hydra.Options (OfflineConfig) data HydraClient = HydraClient { hydraNodeId :: Int @@ -201,20 +201,6 @@ data HydraNodeLog deriving stock (Eq, Show, Generic) deriving anyclass (ToJSON, FromJSON, ToObject) --- run a single hydra node in offline mode --- withHydraClusterOffline :: --- HasCallStack => --- Tracer IO EndToEndLog -> --- FilePath -> --- -- (VerificationKey PaymentKey, SigningKey PaymentKey) -> --- SigningKey HydraKey -> --- ContestationPeriod -> --- (HydraClient -> IO a) -> --- IO a --- withHydraClusterOffline tracer workDir hydraKey contestationPeriod action = --- withConfiguredHydraCluster tracer workDir "" firstNodeId allKeys hydraKeys ("9fdc525c20bc00d9dfa9d14904b65e01910c0dfe3bb39865523c1e20eaeb0903") (const $ id) contestationPeriod action --- NOTE(Elaine): txid constant taken from EndToEndSpec someTxId, lift the whole cyclic dependency thing - -- XXX: The two lists need to be of same length. Also the verification keys can -- be derived from the signing keys. withHydraCluster :: @@ -296,18 +282,18 @@ withConfiguredHydraCluster tracer workDir nodeSocket firstNodeId allKeys hydraKe hydraScriptsTxId (\c -> startNodes (c : clients) rest) -withOfflineHydraNode :: - Tracer IO EndToEndLog - -> OfflineConfig - -> FilePath - -> Int - -> SigningKey HydraKey - -> (HydraClient -> IO a) - -> IO a +withOfflineHydraNode :: + Tracer IO HydraNodeLog -> + OfflineConfig -> + FilePath -> + Int -> + SigningKey HydraKey -> + (HydraClient -> IO a) -> + IO a withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = withLogFile logFilePath $ \logFileHandle -> do - withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey (Just logFileHandle) $ do - \_ _err processHandle -> do + withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey (Just logFileHandle) $ do + \_stdoutHandle _stderrHandle processHandle -> do result <- race (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle) @@ -318,19 +304,24 @@ withOfflineHydraNode tracer offlineConfig workDir hydraNodeId hydraSKey action = where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" +withPersistentDirectoryDebug :: MonadIO m => FilePath -> (FilePath -> m a) -> m a +withPersistentDirectoryDebug name action = do + liftIO $ createDirectoryIfMissing True name + putStrLn $ "Persistent Directory Created: " <> name + action name + withOfflineHydraNode' :: - Tracer IO EndToEndLog - -> OfflineConfig - -> FilePath - -> Int - -> SigningKey HydraKey + OfflineConfig -> + FilePath -> + Int -> + SigningKey HydraKey -> -- | If given use this as std out. - -> Maybe Handle + Maybe Handle -> -- -> (HydraClient -> IO a) - -> (Handle -> Handle -> ProcessHandle -> IO a) - -> IO a -withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = - withSystemTempDirectory "hydra-node" $ \dir -> do + (Handle -> Handle -> ProcessHandle -> IO a) -> + IO a +withOfflineHydraNode' offlineConfig workDir hydraNodeId hydraSKey mGivenStdOut action = + withPersistentDirectoryDebug "hydra-node-tempdir" $ \dir -> do let cardanoLedgerProtocolParametersFile = dir "protocol-parameters.json" readConfigFile "protocol-parameters.json" >>= writeFileBS cardanoLedgerProtocolParametersFile let hydraSigningKey = dir (show hydraNodeId <> ".sk") @@ -340,12 +331,14 @@ withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey mGivenS { cardanoLedgerProtocolParametersFile } let p = + -- ( hydraNodeProcess . (\args -> trace ("ARGS DUMP: " <> foldMap (" "<>) (toArgs args)) args) $ ( hydraNodeProcess $ RunOptions { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId , host = "127.0.0.1" - , port = fromIntegral $ 5_000 + hydraNodeId + , -- NOTE(Elaine): port 5000 is used on recent versions of macos + port = fromIntegral $ 5_100 + hydraNodeId , peers , apiHost = "127.0.0.1" , apiPort = fromIntegral $ 4_000 + hydraNodeId @@ -373,7 +366,7 @@ withOfflineHydraNode' tracer offlineConfig workDir hydraNodeId hydraSKey mGivenS -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. withHydraNode :: - Tracer IO EndToEndLog -> + Tracer IO HydraNodeLog -> ChainConfig -> FilePath -> Int -> @@ -395,11 +388,9 @@ withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNod where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" - -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. withHydraNode' :: - -- Either OfflineConfig ChainConfig -> ChainConfig -> FilePath -> Int -> @@ -431,7 +422,7 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h { verbosity = Verbose "HydraNode" , nodeId = NodeId $ show hydraNodeId , host = "127.0.0.1" - , port = fromIntegral $ 5_000 + hydraNodeId + , port = fromIntegral $ 5_100 + hydraNodeId , peers , apiHost = "127.0.0.1" , apiPort = fromIntegral $ 4_000 + hydraNodeId @@ -440,11 +431,11 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h , hydraVerificationKeys , hydraScriptsTxId , persistenceDir = workDir "state-" <> show hydraNodeId - -- , chainConfig = fromRight defaultChainConfig chainConfig - , chainConfig + , -- , chainConfig = fromRight defaultChainConfig chainConfig + chainConfig , ledgerConfig - -- , offlineConfig = leftToMaybe chainConfig - , offlineConfig = Nothing + , -- , offlineConfig = leftToMaybe chainConfig + offlineConfig = Nothing } ) { std_out = maybe CreatePipe UseHandle mGivenStdOut @@ -459,7 +450,7 @@ withHydraNode' chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds h peers = [ Host { Network.hostname = "127.0.0.1" - , Network.port = fromIntegral $ 5_000 + i + , Network.port = fromIntegral $ 5_100 + i } | i <- allNodeIds , i /= hydraNodeId diff --git a/hydra-cluster/test/Test/ChainSpec.hs b/hydra-cluster/test/Test/ChainSpec.hs deleted file mode 100644 index 91290637ae5..00000000000 --- a/hydra-cluster/test/Test/ChainSpec.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FunctionalDependencies #-} - -module Test.ChainSpec - ( --- ( ChainTest(postTx, waitCallback) --- , hasInitTxWith --- , observesInTime --- , observesInTimeSatisfying - spec - ) where - -import Test.Hydra.Prelude --- import Hydra.Chain (ChainEvent(Observation, observedTx)) --- import Hydra.Chain (PostChainTx) --- import Hydra.ContestationPeriod (ContestationPeriod) --- import Hydra.Party (Party) --- import Hydra.Chain (OnChainTx) --- import Hydra.Ledger (IsTx) --- import Hydra.Chain (OnChainTx(OnInitTx, contestationPeriod, parties)) -import Hydra.Prelude --- import Test.DirectChainSpec (DirectChainTest(DirectChainTest)) - --- Abstract over DirectChainTest and OfflineChainTest --- class DirectChainTest tx IO m | c -> tx m where --TODO(Elaine): additional constraints? alternative: manual vtable ChainTest, directchain wraps --- postTx :: c -> PostChainTx tx -> m () --- waitCallback :: c -> m (ChainEvent tx) - --- offlineConfigFor :: HasCallStack => Actor -> FilePath -> ContestationPeriod -> IO OfflineConfig --- offlineConfigFor me targetDir contestationPeriod = do --- undefined - --- NOTE(Elaine): is this ther ight place for this?? -spec :: Spec -spec = pure () \ No newline at end of file diff --git a/hydra-cluster/test/Test/DirectChainSpec.hs b/hydra-cluster/test/Test/DirectChainSpec.hs index 2afb83fc7b8..df7b301faa8 100644 --- a/hydra-cluster/test/Test/DirectChainSpec.hs +++ b/hydra-cluster/test/Test/DirectChainSpec.hs @@ -5,7 +5,6 @@ module Test.DirectChainSpec where import Hydra.Prelude import Test.Hydra.Prelude - import Cardano.Api.UTxO (UTxO' (UTxO, toMap)) import CardanoClient ( QueryPoint (QueryTip), @@ -81,8 +80,6 @@ import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..)) import System.Process (proc, readCreateProcess) import Test.QuickCheck (generate) -import Test.ChainSpec - spec :: Spec spec = around (showLogsOnFailure "DirectChainSpec") $ do it "can init and abort a head given nothing has been committed" $ \tracer -> do @@ -469,7 +466,6 @@ withDirectChainTest tracer config ctx action = do Right tx -> pure tx } - delayUntil :: (MonadDelay m, MonadTime m) => UTCTime -> m () delayUntil target = do now <- getCurrentTime @@ -492,18 +488,19 @@ externalCommit node hydraClient externalSk utxoToCommit' = do where DirectChainTest{draftCommitTx} = hydraClient -hasInitTxWith :: (HasCallStack, IsTx tx) => ContestationPeriod -> [Party] -> OnChainTx tx -> Expectation +hasInitTxWith :: (HasCallStack, IsTx tx) => ContestationPeriod -> [Party] -> OnChainTx tx -> IO HeadId hasInitTxWith expectedContestationPeriod expectedParties = \case - OnInitTx{contestationPeriod, parties} -> do + OnInitTx{headId, contestationPeriod, parties} -> do expectedContestationPeriod `shouldBe` contestationPeriod expectedParties `shouldBe` parties + pure headId tx -> failure ("Unexpected observation: " <> show tx) observesInTime :: IsTx tx => DirectChainTest tx IO -> OnChainTx tx -> IO () observesInTime chain expected = observesInTimeSatisfying chain (`shouldBe` expected) -observesInTimeSatisfying :: IsTx tx => DirectChainTest tx IO -> (OnChainTx tx -> Expectation) -> IO () +observesInTimeSatisfying :: IsTx tx => DirectChainTest tx IO -> (OnChainTx tx -> IO a) -> IO a observesInTimeSatisfying c check = failAfter 10 go where @@ -520,4 +517,4 @@ waitMatch c match = go where go = do a <- waitCallback c - maybe go pure (match a) \ No newline at end of file + maybe go pure (match a) diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 6892311768f..950ca62c8b6 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -8,6 +8,7 @@ import Hydra.Prelude import Test.Hydra.Prelude import Cardano.Api.UTxO qualified as UTxO + import CardanoClient (QueryPoint (..), queryGenesisParameters, queryTip, queryTipSlotNo, submitTx, waitForUTxO) import CardanoNode (RunningNode (..), withCardanoNodeDevnet) import Control.Concurrent.STM (newTVarIO, readTVarIO) @@ -34,6 +35,7 @@ import Hydra.Cardano.Api ( mkVkAddress, serialiseAddress, signTx, + pattern TxOut, pattern TxValidityLowerBound, ) import Hydra.Chain.Direct.State () @@ -70,7 +72,7 @@ import Hydra.Cluster.Scenarios ( testPreventResumeReconfiguredPeer, threeNodesNoErrorsOnOpen, ) -import Hydra.Cluster.Util (chainConfigFor, keysFor) +import Hydra.Cluster.Util (chainConfigFor, keysFor, offlineConfigFor) import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod)) import Hydra.Crypto (generateSigningKey) import Hydra.Ledger (txId) @@ -90,9 +92,9 @@ import HydraNode ( waitForNodesConnected, waitMatch, withHydraCluster, - withOfflineHydraNode, withHydraNode, withHydraNode', + withOfflineHydraNode, ) import System.Directory (removeDirectoryRecursive) import System.FilePath (()) @@ -113,10 +115,33 @@ withClusterTempDir name = withTempDir ("hydra-cluster-e2e-" <> name) spec :: Spec -spec = around showLogsOnFailure $ do +spec = around (showLogsOnFailure "EndToEndSpec") $ do it "End-to-end offline mode" $ \tracer -> do withTempDir ("offline-mode-e2e") $ \tmpDir -> do - withOfflineHydraNode (tracer :: Tracer IO EndToEndLog) defaultOfflineConfig tmpDir 0 aliceSk $ \n1 -> do + let networkId = Testnet (NetworkMagic 42) -- from defaultChainConfig + let startingState = + [ (Alice, lovelaceToValue 100_000_000) + , (Bob, lovelaceToValue 100_000_000) + ] + (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice + (bobCardanoVk, _) <- keysFor Bob + offlineConfig <- offlineConfigFor startingState tmpDir networkId + + initialUtxo <- Aeson.throwDecodeStrict @UTxO.UTxO =<< readFileBS (initialUTxOFile offlineConfig) + let Just (aliceSeedTxIn, aliceSeedTxOut) = UTxO.find (\(TxOut addr _ _ _) -> addr == mkVkAddress networkId aliceCardanoVk) initialUtxo + + withOfflineHydraNode (contramap FromHydraNode tracer) offlineConfig tmpDir 0 aliceSk $ \node -> do + let Right tx = + mkSimpleTx + (aliceSeedTxIn, aliceSeedTxOut) + (mkVkAddress networkId bobCardanoVk, lovelaceToValue paymentFromAliceToBob) + aliceCardanoSk + + send node $ input "NewTx" ["transaction" .= tx] + + waitMatch 10 node $ \v -> do + guard $ v ^? key "tag" == Just "SnapshotConfirmed" + pure () describe "End-to-end on Cardano devnet" $ do @@ -562,16 +587,6 @@ timedTx tmpDir tracer node@RunningNode{networkId, nodeSocket} hydraScriptsTxId = v ^? key "snapshot" . key "confirmedTransactions" confirmedTransactions ^.. values `shouldBe` [toJSON $ txId tx] --- initAndCloseOffline :: FilePath -> Tracer IO EndToEndLog -> IO () --- initAndCloseOffline tmpDir tracer = do --- aliceKeys@(aliceCardanoVk, _ ) --- let cardanoKey = [aliceKeys] --- hydraKeys = [aliceSk] - --- let contestationPeriod = UnsafeContestationPeriod 2 - --- pure () - initAndClose :: FilePath -> Tracer IO EndToEndLog -> Int -> TxId -> RunningNode -> IO () initAndClose tmpDir tracer clusterIx hydraScriptsTxId node@RunningNode{nodeSocket, networkId} = do aliceKeys@(aliceCardanoVk, _) <- generate genKeyPair diff --git a/hydra-cluster/test/Test/OfflineChainSpec.hs b/hydra-cluster/test/Test/OfflineChainSpec.hs deleted file mode 100644 index 6ce304b0e63..00000000000 --- a/hydra-cluster/test/Test/OfflineChainSpec.hs +++ /dev/null @@ -1,64 +0,0 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} - -module Test.OfflineChainSpec where -import Hydra.Prelude -import Test.Hydra.Prelude -import Hydra.Chain (PostChainTx, ChainEvent) -import Hydra.Logging (showLogsOnFailure, Tracer) -import Hydra.Chain.Offline (withOfflineChain) -import Hydra.Options (defaultContestationPeriod, OfflineConfig, initialUTxOFile) -import Hydra.Party (deriveParty) -import Hydra.Chain (PostChainTx(InitTx, headParameters)) -import Hydra.Options (OfflineConfig(OfflineConfig, initialUTxOFile, ledgerGenesisFile), OfflineUTxOWriteBackConfig(), defaultOfflineConfig) -import Hydra.Chain (HeadParameters(HeadParameters, contestationPeriod, parties)) -import Hydra.Cluster.Util (keysFor, seedInitialUTxOFromOffline) -import Hydra.Cluster.Fixture (Actor(Alice), aliceSk) -import Hydra.Chain (initHistory) -import Hydra.Chain.Direct.State (initialChainState) -import Control.Concurrent.STM (newEmptyTMVarIO, putTMVar, takeTMVar) -import Hydra.Chain (Chain(Chain, postTx)) - ---TODO(Elaine): replace with some offlinechainlog? -import Hydra.Chain.Direct.Handlers (DirectChainLog) -import Hydra.Party (Party) -import Hydra.Ledger.Cardano (Tx) -import Hydra.Chain (OnChainTx(OnCommitTx, party, committed)) - -import Test.DirectChainSpec (hasInitTxWith, observesInTime) -import Hydra.Ledger (IsTx(UTxOType)) -import Hydra.Chain (ChainEvent(observedTx)) -import Hydra.Chain (PostChainTx(AbortTx)) -import Hydra.Chain (OnChainTx(OnAbortTx)) -import Hydra.HeadId(HeadId(HeadId)) -import Hydra.Ledger.Cardano.Configuration (readJsonFileThrow) - - -data OfflineChainTest tx m = OfflineChainTest - { postTx :: PostChainTx tx -> m () - , waitCallback :: m (ChainEvent tx) - } - -withOfflineChainTest :: Tracer IO DirectChainLog -> OfflineConfig - -> Party - -> (OfflineChainTest Tx IO -> IO b) - -> IO b -withOfflineChainTest tracer offlineConfig party action = do - eventMVar <- newEmptyTMVarIO - - let callback event = atomically $ putTMVar eventMVar event - globals = undefined - contestationPeriod = defaultContestationPeriod - withOfflineChain tracer offlineConfig globals (HeadId "HeadId") party contestationPeriod (initHistory initialChainState) callback $ \Chain{postTx} -> do - action - OfflineChainTest - { postTx - , waitCallback = atomically $ takeTMVar eventMVar - } - -spec :: Spec -spec = pure () \ No newline at end of file diff --git a/hydra-node/src/Hydra/Chain/Direct.hs b/hydra-node/src/Hydra/Chain/Direct.hs index 211a023c1b9..43fb9890d00 100644 --- a/hydra-node/src/Hydra/Chain/Direct.hs +++ b/hydra-node/src/Hydra/Chain/Direct.hs @@ -107,7 +107,6 @@ import Ouroboros.Network.Protocol.LocalTxSubmission.Client ( SubmitResult (..), ) - -- | Build the 'ChainContext' from a 'ChainConfig' and additional information. loadChainContext :: ChainConfig -> diff --git a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs index 231798883b7..1a3834ed1b4 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Handlers.hs @@ -5,15 +5,15 @@ module Hydra.Chain.Offline.Handlers ( mkFakeL1Chain, ) where -import Hydra.Prelude -import Hydra.Chain.Direct.State (ChainStateAt(ChainStateAt), chainState) -import Hydra.Chain.Direct.Handlers (DirectChainLog(ToPost, toPost), LocalChainState, getLatest) -import Hydra.Chain (PostChainTx(headParameters, InitTx, AbortTx, CollectComTx, CloseTx, ContestTx, confirmedSnapshot, FanoutTx), ChainEvent (Observation, newChainState, observedTx), snapshotNumber, confirmedSnapshot, HeadParameters (HeadParameters), Chain (postTx, draftCommitTx, submitTx, Chain), contestationDeadline, OnChainTx (OnInitTx, headId, OnAbortTx, OnCollectComTx, OnCloseTx, parties, contestationPeriod, OnContestTx, OnFanoutTx), HeadParameters (HeadParameters), snapshotNumber, PostTxError (FailedToDraftTxNotInitializing)) -import Hydra.Snapshot (getSnapshot, Snapshot (number)) +import Hydra.Chain (Chain (Chain, draftCommitTx, postTx, submitTx), ChainEvent (Observation, newChainState, observedTx), HeadParameters (HeadParameters), OnChainTx (OnAbortTx, OnCloseTx, OnCollectComTx, OnContestTx, OnFanoutTx, OnInitTx, contestationPeriod, headId, parties), PostChainTx (AbortTx, CloseTx, CollectComTx, ContestTx, FanoutTx, InitTx, confirmedSnapshot, headParameters), PostTxError (FailedToDraftTxNotInitializing), confirmedSnapshot, contestationDeadline, snapshotNumber) +import Hydra.Chain.Direct.Handlers (DirectChainLog (ToPost, toPost), LocalChainState, getLatest) +import Hydra.Chain.Direct.State (ChainStateAt (ChainStateAt), chainState) +import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime) +import Hydra.HeadId (HeadId) import Hydra.Ledger.Cardano (Tx) import Hydra.Logging (Tracer, traceWith) -import Hydra.HeadId(HeadId) -import Hydra.ContestationPeriod (ContestationPeriod, toNominalDiffTime) +import Hydra.Prelude +import Hydra.Snapshot (Snapshot (number), getSnapshot) mkFakeL1Chain :: ContestationPeriod -> diff --git a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs index 69d7186bb7e..38378229203 100644 --- a/hydra-node/src/Hydra/Chain/Offline/Persistence.hs +++ b/hydra-node/src/Hydra/Chain/Offline/Persistence.hs @@ -7,7 +7,6 @@ module Hydra.Chain.Offline.Persistence ( import Hydra.Prelude -import Hydra.Ledger (IsTx(UTxOType)) import Data.Aeson qualified as Aeson import Hydra.Cardano.Api (Tx) import Hydra.Chain ( @@ -20,14 +19,8 @@ import Hydra.Chain ( party, ) import Hydra.Chain.Direct.State (initialChainState) -import Hydra.HeadId (HeadId) -import Hydra.Party (Party) -import Hydra.Persistence (PersistenceIncremental(PersistenceIncremental, append, loadAll), createPersistenceIncremental) -import Hydra.HeadLogic (StateChanged(SnapshotConfirmed, snapshot)) -import Hydra.Snapshot (Snapshot(Snapshot, utxo)) -import UnliftIO.IO.File (writeBinaryFileDurableAtomic) -import qualified Data.Aeson as Aeson import Hydra.ContestationPeriod (ContestationPeriod) +import Hydra.HeadId (HeadId) import Hydra.HeadLogic (StateChanged (SnapshotConfirmed, snapshot)) import Hydra.Ledger (IsTx (UTxOType)) import Hydra.Party (Party) @@ -47,7 +40,7 @@ initializeStateIfOffline chainStateHistory initialUTxO ownHeadId ownParty contes let emptyChainStateHistory = initHistory initialChainState -- if we don't have a chainStateHistory to restore from disk from, start a new one - when (chainStateHistory /= emptyChainStateHistory) $ do + when (chainStateHistory == emptyChainStateHistory) $ do callback $ Observation { newChainState = initialChainState @@ -89,4 +82,4 @@ createPersistenceWithUTxOWriteBack persistenceFilePath utxoFilePath = do SnapshotConfirmed{snapshot = Snapshot{utxo}} -> writeBinaryFileDurableAtomic utxoFilePath . toStrict $ Aeson.encode utxo _ -> pure () - } \ No newline at end of file + } diff --git a/hydra-node/src/Hydra/Node/Run.hs b/hydra-node/src/Hydra/Node/Run.hs index bccca8af12f..d1248b63f2e 100644 --- a/hydra-node/src/Hydra/Node/Run.hs +++ b/hydra-node/src/Hydra/Node/Run.hs @@ -1,17 +1,22 @@ -{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE DuplicateRecordFields #-} module Hydra.Node.Run where import Hydra.Prelude hiding (fromList) +import Cardano.Ledger.BaseTypes qualified as Ledger +import Cardano.Ledger.Crypto qualified as Ledger +import Cardano.Ledger.Shelley.API qualified as Shelley import Hydra.API.Server (Server (..), withAPIServer) import Hydra.API.ServerOutput (ServerOutput (..)) import Hydra.Cardano.Api ( + GenesisParameters (..), ProtocolParametersConversionError, ShelleyBasedEra (..), - toLedgerPParams, GenesisParameters (..) + toLedgerPParams, ) +import Hydra.Cardano.Api qualified as Shelley import Hydra.Chain (maximumNumberOfParties) import Hydra.Chain.CardanoClient (QueryPoint (..), queryGenesisParameters) import Hydra.Chain.Direct (loadChainContext, mkTinyWallet, withDirectChain) @@ -23,10 +28,6 @@ import Hydra.HeadLogic ( defaultTTL, ) import Hydra.Ledger.Cardano qualified as Ledger -import qualified Hydra.Cardano.Api as Shelley -import qualified Cardano.Ledger.Shelley.API as Shelley -import qualified Cardano.Ledger.Crypto as Ledger -import qualified Cardano.Ledger.BaseTypes as Ledger import Hydra.Ledger.Cardano.Configuration ( newGlobals, newLedgerEnv, @@ -43,8 +44,9 @@ import Hydra.Node ( checkHeadState, createNodeState, initEnvironment, + loadGlobalsFromGenesis, loadState, - runHydraNode, loadGlobalsFromGenesis, + runHydraNode, ) import Hydra.Node.EventQueue (EventQueue (..), createEventQueue) import Hydra.Node.Network (NetworkConfiguration (..), withNetwork) @@ -52,22 +54,12 @@ import Hydra.Options ( ChainConfig (..), InvalidOptions (..), LedgerConfig (..), + OfflineConfig (OfflineConfig, ledgerGenesisFile), RunOptions (..), - OfflineConfig (OfflineConfig, initialUTxOFile, ledgerGenesisFile), - OfflineUTxOWriteBackConfig(..) ) import Hydra.Persistence (createPersistenceIncremental) -import Hydra.HeadId (HeadId(..)) - -import Hydra.Persistence (PersistenceIncremental (PersistenceIncremental, append, loadAll)) -import qualified Data.Aeson as Aeson -import UnliftIO.IO.File (writeBinaryFileDurableAtomic) -import Hydra.Snapshot (Snapshot(Snapshot), utxo) -import Hydra.Ledger (IsTx(UTxOType)) -import Hydra.ContestationPeriod (fromChain) -import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime) -import Hydra.Chain.Direct.Fixture (defaultGlobals) +import Hydra.HeadId (HeadId (..)) data ConfigurationException = ConfigurationException ProtocolParametersConversionError @@ -104,12 +96,14 @@ run opts = do let DirectChainConfig{networkId, nodeSocket} = chainConfig globals <- case offlineConfig of - Nothing -> do --online - globals' <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip - pure globals' - Just OfflineConfig{ledgerGenesisFile} -> do --offline - loadGlobalsFromGenesis ledgerGenesisFile - + Nothing -> do + -- online + globals' <- newGlobals =<< queryGenesisParameters networkId nodeSocket QueryTip + pure globals' + Just OfflineConfig{ledgerGenesisFile} -> do + -- offline + loadGlobalsFromGenesis ledgerGenesisFile + withCardanoLedger pparams globals $ \ledger -> do persistence <- createPersistenceIncremental $ persistenceDir <> "/state" (hs, chainStateHistory) <- loadState (contramap Node tracer) persistence initialChainState @@ -120,7 +114,7 @@ run opts = do let withChain cont = case onlineOrOfflineConfig of Left offlineConfig' -> let headId = HeadId "HeadId" - in withOfflineChain (contramap DirectChain tracer) offlineConfig' globals headId party contestationPeriod chainStateHistory (putEvent . OnChainEvent) cont + in withOfflineChain (contramap DirectChain tracer) offlineConfig' globals headId party contestationPeriod chainStateHistory (putEvent . OnChainEvent) cont Right onlineConfig -> do ctx <- loadChainContext chainConfig party otherParties hydraScriptsTxId wallet <- mkTinyWallet (contramap DirectChain tracer) onlineConfig @@ -154,19 +148,19 @@ run opts = do withCardanoLedger protocolParams globals action = let ledgerEnv = newLedgerEnv protocolParams - in action (Ledger.cardanoLedger globals ledgerEnv) + in action (Ledger.cardanoLedger globals ledgerEnv) identifyNode :: RunOptions -> RunOptions identifyNode opt@RunOptions{verbosity = Verbose "HydraNode", nodeId} = opt{verbosity = Verbose $ "HydraNode-" <> show nodeId} identifyNode opt = opt ---TODO(ELAINE): figure out a less strange way to do this --- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api +-- TODO(ELAINE): figure out a less strange way to do this +-- | Taken from Cardano.Api.GenesisParameters, a private module in cardano-api fromShelleyGenesis :: Shelley.ShelleyGenesis Ledger.StandardCrypto -> GenesisParameters Shelley.ShelleyEra fromShelleyGenesis - sg@Shelley.ShelleyGenesis { - Shelley.sgSystemStart + sg@Shelley.ShelleyGenesis + { Shelley.sgSystemStart , Shelley.sgNetworkMagic , Shelley.sgActiveSlotsCoeff , Shelley.sgSecurityParam @@ -176,22 +170,24 @@ fromShelleyGenesis , Shelley.sgSlotLength , Shelley.sgUpdateQuorum , Shelley.sgMaxLovelaceSupply - , Shelley.sgGenDelegs = _ -- unused, might be of interest - , Shelley.sgInitialFunds = _ -- unused, not retained by the node - , Shelley.sgStaking = _ -- unused, not retained by the node + , Shelley.sgGenDelegs = _ -- unused, might be of interest + , Shelley.sgInitialFunds = _ -- unused, not retained by the node + , Shelley.sgStaking = _ -- unused, not retained by the node } = - GenesisParameters { - protocolParamSystemStart = sgSystemStart - , protocolParamNetworkId = Shelley.fromNetworkMagic $ Shelley.NetworkMagic sgNetworkMagic - , protocolParamActiveSlotsCoefficient = Ledger.unboundRational - sgActiveSlotsCoeff - , protocolParamSecurity = fromIntegral sgSecurityParam - , protocolParamEpochLength = sgEpochLength - , protocolParamSlotLength = Shelley.fromNominalDiffTimeMicro sgSlotLength - , protocolParamSlotsPerKESPeriod = fromIntegral sgSlotsPerKESPeriod - , protocolParamMaxKESEvolutions = fromIntegral sgMaxKESEvolutions - , protocolParamUpdateQuorum = fromIntegral sgUpdateQuorum - , protocolParamMaxLovelaceSupply = Shelley.Lovelace - (fromIntegral sgMaxLovelaceSupply) - , protocolInitialUpdateableProtocolParameters = Shelley.sgProtocolParams sg - } \ No newline at end of file + GenesisParameters + { protocolParamSystemStart = sgSystemStart + , protocolParamNetworkId = Shelley.fromNetworkMagic $ Shelley.NetworkMagic sgNetworkMagic + , protocolParamActiveSlotsCoefficient = + Ledger.unboundRational + sgActiveSlotsCoeff + , protocolParamSecurity = fromIntegral sgSecurityParam + , protocolParamEpochLength = sgEpochLength + , protocolParamSlotLength = Shelley.fromNominalDiffTimeMicro sgSlotLength + , protocolParamSlotsPerKESPeriod = fromIntegral sgSlotsPerKESPeriod + , protocolParamMaxKESEvolutions = fromIntegral sgMaxKESEvolutions + , protocolParamUpdateQuorum = fromIntegral sgUpdateQuorum + , protocolParamMaxLovelaceSupply = + Shelley.Lovelace + (fromIntegral sgMaxLovelaceSupply) + , protocolInitialUpdateableProtocolParameters = Shelley.sgProtocolParams sg + } diff --git a/hydra-node/src/Hydra/Options.hs b/hydra-node/src/Hydra/Options.hs index d39d5a74f80..6fca2559ab0 100644 --- a/hydra-node/src/Hydra/Options.hs +++ b/hydra-node/src/Hydra/Options.hs @@ -266,18 +266,17 @@ instance Arbitrary RunOptions where shrink = genericShrink ---FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing +-- FIXME(Elaine): this instance doesn't do stuff correctly but was necessary during rebasing instance Arbitrary OfflineConfig where arbitrary = do ledgerGenesisFile <- oneof [pure Nothing, Just <$> genFilePath "ledgerGenesis"] initialUTxOFile <- genFilePath "utxo.json" - -- writeFileBS initialUTxOFile "{}" pure $ - OfflineConfig { - initialUTxOFile - , ledgerGenesisFile - } + OfflineConfig + { initialUTxOFile + , ledgerGenesisFile + } shrink = genericShrink diff --git a/nix/hydra/shell.nix b/nix/hydra/shell.nix index ebfeb21c58c..9339dbb022b 100644 --- a/nix/hydra/shell.nix +++ b/nix/hydra/shell.nix @@ -12,6 +12,8 @@ let inherit (hydraProject) compiler pkgs hsPkgs; + cardano-node-pkgs = cardano-node.packages.${system}; + cabal = pkgs.haskell-nix.cabal-install.${compiler}; haskell-language-server = pkgs.haskell-nix.tool compiler "haskell-language-server" rec { @@ -33,27 +35,22 @@ let buildInputs = [ # Build essentials pkgs.git - pkgs.pkg-config + pkgs.pkgconfig cabal - (pkgs.haskell-nix.tool compiler "cabal-plan" "latest") pkgs.haskellPackages.hspec-discover - # Formatting - pkgs.treefmt - (pkgs.haskell-nix.tool compiler "fourmolu" "0.14.0.0") - (pkgs.haskell-nix.tool compiler "cabal-fmt" "0.1.9") - pkgs.nixpkgs-fmt + pkgs.haskellPackages.cabal-plan # For validating JSON instances against a pre-defined schema - pkgs.check-jsonschema - # For generating plantuml drawings - pkgs.plantuml + pkgs.python3Packages.jsonschema # For plotting results of hydra-cluster benchmarks pkgs.gnuplot - ] ++ pkgs.lib.optionals (!pkgs.stdenv.isDarwin) [ # For integration tests - cardano-node.packages.${system}.cardano-node + cardano-node-pkgs.cardano-node ]; devInputs = if withoutDevTools then [ ] else [ + # Automagically format .hs and .cabal files + pkgs.haskellPackages.fourmolu + pkgs.haskellPackages.cabal-fmt # Essenetial for a good IDE haskell-language-server # The interactive Glasgow Haskell Compiler as a Daemon @@ -67,12 +64,26 @@ let # For docs/ (i.e. Docusaurus, Node.js & React) pkgs.yarn pkgs.nodejs - ] ++ pkgs.lib.optionals (!pkgs.stdenv.isDarwin) [ # To interact with cardano-node and testing out things - cardano-node.packages.${system}.cardano-cli + cardano-node-pkgs.cardano-cli ]; haskellNixShell = hsPkgs.shellFor { + # NOTE: Explicit list of local packages as hoogle would not work otherwise. + # Make sure these are consistent with the packages in cabal.project. + packages = ps: with ps; [ + hydra-prelude + hydra-cardano-api + hydra-test-utils + plutus-cbor + plutus-merkle-tree + # hydra-plutus + # hydra-node + # hydra-cluster + # hydra-tui + # hydraw + ]; + buildInputs = libs ++ buildInputs ++ devInputs; withHoogle = !withoutDevTools; @@ -85,15 +96,6 @@ let LANG = "en_US.UTF-8"; GIT_SSL_CAINFO = "${pkgs.cacert}/etc/ssl/certs/ca-bundle.crt"; - - shellHook = '' - if ! which cardano-node > /dev/null 2>&1; then - echo "WARNING: 'cardano-node' not found" - fi - if ! which cardano-cli > /dev/null 2>&1; then - echo "WARNING: 'cardano-cli' not found" - fi - ''; }; # A "cabal-only" shell which does not use haskell.nix @@ -101,9 +103,9 @@ let name = "hydra-node-cabal-shell"; buildInputs = libs ++ [ - pkgs.haskell-nix.compiler.${compiler} + pkgs.haskell.compiler.${compiler} pkgs.cabal-install - pkgs.pkg-config + pkgs.pkgconfig ] ++ buildInputs ++ devInputs; # Ensure that libz.so and other libraries are available to TH splices. @@ -124,11 +126,10 @@ let name = "hydra-node-exe-shell"; buildInputs = [ + cardano-node-pkgs.cardano-node + cardano-node-pkgs.cardano-cli hsPkgs.hydra-node.components.exes.hydra-node hsPkgs.hydra-cluster.components.exes.hydra-cluster - ] ++ pkgs.lib.optionals (!pkgs.stdenv.isDarwin) [ - cardano-node.packages.${system}.cardano-node - cardano-node.packages.${system}.cardano-cli ]; }; @@ -136,12 +137,11 @@ let demoShell = pkgs.mkShell { name = "hydra-demo-shell"; buildInputs = [ + cardano-node-pkgs.cardano-node + cardano-node-pkgs.cardano-cli hsPkgs.hydra-node.components.exes.hydra-node hsPkgs.hydra-tui.components.exes.hydra-tui run-tmux - ] ++ pkgs.lib.optionals (!pkgs.stdenv.isDarwin) [ - cardano-node.packages.${system}.cardano-node - cardano-node.packages.${system}.cardano-cli ]; };