Get rid of unsafePerformIO

hydra-cluster/src/CardanoCluster.hs

@@ -42,8 +42,6 @@ import System.Posix.Files (
  )
 import Test.Network.Ports (randomUnusedTCPPort, randomUnusedTCPPorts)
 
-data RunningCluster = RunningCluster ClusterConfig [RunningNode]
-
 -- | TODO: This is hard-coded and must match what's in the genesis file, so
 -- ideally, we want to either:
 --
@@ -57,29 +55,6 @@ defaultNetworkId = Testnet (NetworkMagic 42)
 availableInitialFunds :: Num a => a
 availableInitialFunds = 900_000_000_000
 
--- | Configuration parameters for the cluster.
-data ClusterConfig = ClusterConfig
-  { parentStateDirectory :: FilePath
-  , networkId :: NetworkId
-  }
-
-asSigningKey :: AsType (SigningKey PaymentKey)
-asSigningKey = AsSigningKey AsPaymentKey
-
-withCluster ::
-  Tracer IO ClusterLog -> ClusterConfig -> (RunningCluster -> IO ()) -> IO ()
-withCluster tr cfg@ClusterConfig{parentStateDirectory} action = do
-  systemStart <- initSystemStart
-  (cfgA, cfgB, cfgC) <-
-    makeNodesConfig parentStateDirectory systemStart
-      <$> randomUnusedTCPPorts 3
-
-  withBFTNode tr cfgA $ \nodeA -> do
-    withBFTNode tr cfgB $ \nodeB -> do
-      withBFTNode tr cfgC $ \nodeC -> do
-        let nodes = [nodeA, nodeB, nodeC]
-        action (RunningCluster cfg nodes)
-
 -- | Enumeration of known actors for which we can get the 'keysFor' and 'writeKeysFor'.
 data Actor
   = Alice
@@ -129,6 +104,33 @@ writeKeysFor targetDir actor = do
 
   vkName = actorName actor <.> ".vk"
 
+-- * Starting a cluster or single nodes
+
+data RunningCluster = RunningCluster ClusterConfig [RunningNode]
+
+-- | Configuration parameters for the cluster.
+data ClusterConfig = ClusterConfig
+  { parentStateDirectory :: FilePath
+  , networkId :: NetworkId
+  }
+
+asSigningKey :: AsType (SigningKey PaymentKey)
+asSigningKey = AsSigningKey AsPaymentKey
+
+withCluster ::
+  Tracer IO ClusterLog -> ClusterConfig -> (RunningCluster -> IO ()) -> IO ()
+withCluster tr cfg@ClusterConfig{parentStateDirectory} action = do
+  systemStart <- initSystemStart
+  (cfgA, cfgB, cfgC) <-
+    makeNodesConfig parentStateDirectory systemStart
+      <$> randomUnusedTCPPorts 3
+
+  withBFTNode tr cfgA $ \nodeA -> do
+    withBFTNode tr cfgB $ \nodeB -> do
+      withBFTNode tr cfgC $ \nodeC -> do
+        let nodes = [nodeA, nodeB, nodeC]
+        action (RunningCluster cfg nodes)
+
 -- | Start a cardano-node in BFT mode using the config from config/ and
 -- credentials from config/credentials/ using given 'nodeId'. NOTE: This means
 -- that nodeId should only be 1,2 or 3 and that only the faucet receives

hydra-cluster/src/Hydra/Generator.hs

@@ -12,9 +12,8 @@ import CardanoCluster (Actor (Faucet), availableInitialFunds, keysFor)
 import Control.Monad (foldM)
 import Data.Aeson (object, withObject, (.:), (.=))
 import Data.Default (def)
-import GHC.IO (unsafePerformIO)
 import Hydra.Ledger (IsTx (..))
-import Hydra.Ledger.Cardano (genKeyPair, mkSimpleTx)
+import Hydra.Ledger.Cardano (genKeyPair, genSigningKey, mkSimpleTx)
 import Test.QuickCheck (choose, generate, sized)
 
 networkId :: NetworkId
@@ -30,8 +29,9 @@ data Dataset = Dataset
   deriving (Show, Generic, ToJSON, FromJSON)
 
 instance Arbitrary Dataset where
-  arbitrary = sized $ \n ->
-    genConstantUTxODataset defaultProtocolParameters (n `div` 10) n
+  arbitrary = sized $ \n -> do
+    sk <- genSigningKey
+    genDatasetConstantUTxO sk defaultProtocolParameters (n `div` 10) n
 
 data ClientDataset = ClientDataset
   { signingKey :: SigningKey PaymentKey
@@ -72,23 +72,25 @@ generateConstantUTxODataset ::
   -- | Number of transactions
   Int ->
   IO Dataset
-generateConstantUTxODataset pparams nClients =
-  generate . genConstantUTxODataset pparams nClients
+generateConstantUTxODataset pparams nClients nTxs = do
+  (_, faucetSk) <- keysFor Faucet
+  generate $ genDatasetConstantUTxO faucetSk pparams nClients nTxs
 
-genConstantUTxODataset ::
+genDatasetConstantUTxO ::
+  -- | The faucet signing key
+  SigningKey PaymentKey ->
   ProtocolParameters ->
   -- | Number of clients
   Int ->
   -- | Number of transactions
   Int ->
   Gen Dataset
-genConstantUTxODataset pparams nClients nTxs = do
+genDatasetConstantUTxO faucetSk pparams nClients nTxs = do
   clientFunds <- replicateM nClients $ do
     (_vk, sk) <- genKeyPair
     amount <- Lovelace . fromIntegral <$> choose (1, availableInitialFunds `div` nClients)
     pure (sk, amount)
   -- Prepare funding transaction as it will be posted
-  let (_, faucetSk) = unsafePerformIO $ keysFor Faucet -- HACK
   let fundingTransaction =
         mkGenesisTx
           networkId

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -106,7 +106,7 @@ spec = around showLogsOnFailure $
           withTempDir "end-to-end-two-heads" $ \tmpDir -> do
             config <- newNodeConfig tmpDir
             withBFTNode (contramap FromCluster tracer) config $ \node@(RunningNode _ nodeSocket) -> do
-              (aliceCardanoVk, aliceCardanoSk) <- keysFor Alice
+              (aliceCardanoVk, _aliceCardanoSk) <- keysFor Alice
               (bobCardanoVk, _bobCardanoSk) <- keysFor Bob
               (aliceVkPath, aliceSkPath) <- writeKeysFor tmpDir Alice
               (_, bobSkPath) <- writeKeysFor tmpDir Bob

hydra-cluster/test/Test/GeneratorSpec.hs

@@ -6,18 +6,19 @@ module Test.GeneratorSpec where
 import Hydra.Prelude
 import Test.Hydra.Prelude
 
+import CardanoCluster (Actor (Faucet), keysFor)
 import Data.Text (unpack)
 import Hydra.Cardano.Api (UTxO, prettyPrintJSON, utxoFromTx)
 import Hydra.Generator (
   ClientDataset (..),
   Dataset (..),
   defaultProtocolParameters,
-  genConstantUTxODataset,
+  genDatasetConstantUTxO,
  )
 import Hydra.Ledger (applyTransactions, balance)
 import Hydra.Ledger.Cardano (Tx, cardanoLedger, genUTxO)
 import Test.Aeson.GenericSpecs (roundtripSpecs)
-import Test.QuickCheck (Positive (Positive), Property, counterexample, forAll)
+import Test.QuickCheck (Positive (Positive), Property, counterexample, forAll, idempotentIOProperty)
 
 spec :: Spec
 spec = parallel $ do
@@ -32,16 +33,19 @@ prop_computeValueFromUTxO =
 
 prop_keepsUTxOConstant :: Property
 prop_keepsUTxOConstant =
-  forAll arbitrary $ \(Positive n) ->
-    -- XXX: non-exhaustive pattern match
-    forAll (genConstantUTxODataset defaultProtocolParameters 1 n) $
-      \Dataset{fundingTransaction, clientDatasets = [ClientDataset{txSequence}]} ->
-        let initialUTxO = utxoFromTx fundingTransaction
-            finalUTxO = foldl' apply initialUTxO txSequence
-         in length finalUTxO == length initialUTxO
-              & counterexample ("transactions: " <> prettyJSONString txSequence)
-              & counterexample ("utxo: " <> prettyJSONString initialUTxO)
-              & counterexample ("funding tx: " <> prettyJSONString fundingTransaction)
+  forAll arbitrary $ \(Positive n) -> do
+    idempotentIOProperty $ do
+      faucetSk <- snd <$> keysFor Faucet
+      -- XXX: non-exhaustive pattern match
+      pure $
+        forAll (genDatasetConstantUTxO faucetSk defaultProtocolParameters 1 n) $
+          \Dataset{fundingTransaction, clientDatasets = [ClientDataset{txSequence}]} ->
+            let initialUTxO = utxoFromTx fundingTransaction
+                finalUTxO = foldl' apply initialUTxO txSequence
+             in length finalUTxO == length initialUTxO
+                  & counterexample ("transactions: " <> prettyJSONString txSequence)
+                  & counterexample ("utxo: " <> prettyJSONString initialUTxO)
+                  & counterexample ("funding tx: " <> prettyJSONString fundingTransaction)
 
 apply :: UTxO -> Tx -> UTxO
 apply utxo tx =

hydra-node/src/Hydra/Ledger/Cardano.hs

@@ -28,7 +28,6 @@ import qualified Cardano.Ledger.BaseTypes as Ledger
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Credential as Ledger
 import qualified Cardano.Ledger.Crypto as Ledger (StandardCrypto)
-import qualified Cardano.Ledger.Keys as Ledger
 import qualified Cardano.Ledger.Mary as Ledger.Mary hiding (Value)
 import qualified Cardano.Ledger.Shelley.API.Mempool as Ledger
 import qualified Cardano.Ledger.Shelley.Genesis as Ledger
@@ -210,16 +209,20 @@ instance Arbitrary UTxO where
 
 -- * Generators
 
+genSigningKey :: Gen (SigningKey PaymentKey)
+genSigningKey = do
+  -- NOTE: not using 'genKeyDSIGN' purposely here, it is not pure and does not
+  -- play well with pure generation from seed.
+  sk <- fromJust . CC.rawDeserialiseSignKeyDSIGN . fromList <$> vectorOf 64 arbitrary
+  pure (PaymentSigningKey sk)
+
 genVerificationKey :: Gen (VerificationKey PaymentKey)
-genVerificationKey = fst <$> genKeyPair
+genVerificationKey = getVerificationKey <$> genSigningKey
 
 genKeyPair :: Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
 genKeyPair = do
-  -- NOTE: not using 'genKeyDSIGN' purposely here, it is not pure and does not
-  -- play well with pure generation from seed.
-  sk <- fromJust . CC.rawDeserialiseSignKeyDSIGN . fromList <$> vectorOf 64 arbitrary
-  let vk = CC.deriveVerKeyDSIGN sk
-  pure (PaymentVerificationKey (Ledger.VKey vk), PaymentSigningKey sk)
+  sk <- genSigningKey
+  pure (getVerificationKey sk, sk)
 
 -- TODO: Generate non-genesis transactions for better coverage.
 -- TODO: Enable Alonzo-specific features. We started off in the Mary era, and