Fix issues after rebasing and module factoring

input-output-hk · Dec 1, 2022 · 1fa4918 · 1fa4918
1 parent d7c97eb
commit 1fa4918
Show file tree

Hide file tree

Showing 5 changed files with 28 additions and 177 deletions.
diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs
@@ -6,12 +6,11 @@ import Hydra.Prelude
 
 import Hydra.API.Server (withAPIServer)
 import Hydra.Cardano.Api (serialiseToRawBytesHex)
-import Hydra.Chain (ChainCallback, ChainEvent (..))
 import Hydra.Chain.Direct (initialChainState, loadChainContext, withDirectChain)
 import Hydra.Chain.Direct.ScriptRegistry (publishHydraScripts)
 import Hydra.Chain.Direct.State (ChainStateAt (..))
 import Hydra.Chain.Direct.Util (readKeyPair)
-import Hydra.HeadLogic (Environment (..), Event (..), HeadState (..), defaultTTL)
+import Hydra.HeadLogic (Environment (..), Event (..), HeadState (..), defaultTTL, getChainState)
 import qualified Hydra.Ledger.Cardano as Ledger
 import Hydra.Ledger.Cardano.Configuration (
   newGlobals,
@@ -29,8 +28,6 @@ import Hydra.Network.Ouroboros (withOuroborosNetwork)
 import Hydra.Node (
   EventQueue (..),
   HydraNode (..),
-  NodeState (..),
-  Persistence (load),
   chainCallback,
   createEventQueue,
   createNodeState,

diff --git a/hydra-node/test/Hydra/Model.hs b/hydra-node/test/Hydra/Model.hs
@@ -28,38 +28,26 @@ import Hydra.Prelude hiding (Any, label)
 
 import Cardano.Api.UTxO (pairs)
 import qualified Cardano.Api.UTxO as UTxO
-import Cardano.Binary (serialize', unsafeDeserialize')
-import Cardano.Ledger.Alonzo.TxSeq (TxSeq (TxSeq))
-import qualified Cardano.Ledger.Babbage.Tx as Ledger
-import qualified Cardano.Ledger.Shelley.API as Ledger
 import Control.Monad.Class.MonadAsync (Async, async, cancel)
 import Control.Monad.Class.MonadFork (labelThisThread)
 import Control.Monad.Class.MonadSTM (
   MonadLabelledSTM,
-  labelTQueueIO,
   labelTVarIO,
-  modifyTVar,
   newTQueue,
-  newTQueueIO,
   newTVarIO,
-  readTVarIO,
-  tryReadTQueue,
-  writeTQueue,
  )
 import Control.Monad.Class.MonadTimer (timeout)
 import Data.List (nub)
 import qualified Data.List as List
 import Data.Map ((!))
 import qualified Data.Map as Map
 import Data.Maybe (fromJust)
-import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
 import Hydra.API.ClientInput (ClientInput)
 import qualified Hydra.API.ClientInput as Input
 import Hydra.API.ServerOutput (ServerOutput (Committed, GetUTxOResponse, SnapshotConfirmed))
 import qualified Hydra.API.ServerOutput as Output
 import Hydra.BehaviorSpec (
-  ConnectToChain (..),
   TestHydraNode (..),
   createHydraNode,
   createTestHydraNode,
@@ -68,49 +56,30 @@ import Hydra.BehaviorSpec (
   waitUntilMatch,
  )
 import Hydra.Cardano.Api.Prelude (fromShelleyPaymentCredential)
-import Hydra.Chain (Chain (..), HeadParameters (..))
+import Hydra.Chain (HeadParameters (..))
 import Hydra.Chain.Direct.Fixture (defaultGlobals, defaultLedgerEnv, testNetworkId)
-import Hydra.Chain.Direct.Handlers (ChainSyncHandler, DirectChainLog, SubmitTx, chainSyncHandler, mkChain, onRollForward)
-import Hydra.Chain.Direct.ScriptRegistry (ScriptRegistry (..))
-import Hydra.Chain.Direct.State (ChainContext, ChainStateAt (..))
-import qualified Hydra.Chain.Direct.State as S
-import Hydra.Chain.Direct.TimeHandle (TimeHandle)
-import qualified Hydra.Chain.Direct.Util as Util
-import Hydra.Chain.Direct.Wallet (TinyWallet (..))
 import Hydra.ContestationPeriod (ContestationPeriod)
 import Hydra.Crypto (HydraKey)
 import Hydra.HeadLogic (
   Committed (),
-  Environment (party),
-  Event (NetworkEvent),
-  HeadState (..),
   PendingCommits,
-  defaultTTL,
  )
 import Hydra.Ledger (IsTx (..))
-import Hydra.Ledger.Cardano (cardanoLedger, genKeyPair, genSigningKey, genTxIn, mkSimpleTx)
+import Hydra.Ledger.Cardano (cardanoLedger, genSigningKey, mkSimpleTx)
 import Hydra.Logging (Tracer)
 import Hydra.Logging.Messages (HydraLog (DirectChain, Node))
-import Hydra.Model.MockChain (mockChainAndNetwork)
-import Hydra.Network (Network (..))
-import Hydra.Network.Message (Message)
+import Hydra.Model.MockChain (mkMockTxIn, mockChainAndNetwork)
+import Hydra.Model.Payment (CardanoSigningKey (..), Payment (..), applyTx, genAdaValue)
 import Hydra.Node (
-  HydraNode (..),
   NodeState (NodeState),
-  chainCallback,
-  createNodeState,
   modifyHeadState,
-  putEvent,
   queryHeadState,
   runHydraNode,
  )
 import Hydra.Party (Party (..), deriveParty)
 import qualified Hydra.Snapshot as Snapshot
-import Ouroboros.Consensus.Cardano.Block (HardForkBlock (..))
-import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos
-import Ouroboros.Consensus.Shelley.Ledger (mkShelleyBlock)
 import Test.Consensus.Cardano.Generators ()
-import Test.QuickCheck (choose, counterexample, elements, frequency, resize, sized, tabulate, vectorOf)
+import Test.QuickCheck (counterexample, elements, frequency, resize, sized, tabulate, vectorOf)
 import Test.QuickCheck.DynamicLogic (DynLogicModel)
 import Test.QuickCheck.StateModel (Any (..), LookUp, RunModel (..), StateModel (..), Var)
 import qualified Prelude
@@ -187,7 +156,6 @@ data Nodes m = Nodes
   , threads :: [Async m ()]
   }
 
-
 instance DynLogicModel WorldState
 
 type ActualCommitted = UTxOType Payment
@@ -613,7 +581,6 @@ genPayment WorldState{hydraParties, hydraState} =
       pure (party, Payment{from, to, value})
     _ -> error $ "genPayment impossible in state: " <> show hydraState
 
-
 unsafeConstructorName :: (Show a) => a -> String
 unsafeConstructorName = Prelude.head . Prelude.words . show
 
@@ -633,12 +600,6 @@ isOwned (CardanoSigningKey sk) (_, TxOut{txOutAddress = ShelleyAddressInEra (She
     _ -> False
 isOwned _ _ = False
 
-mkMockTxIn :: VerificationKey PaymentKey -> Word -> TxIn
-mkMockTxIn vk ix = TxIn (TxId tid) (TxIx ix)
- where
-  -- NOTE: Ugly, works because both binary representations are 32-byte long.
-  tid = unsafeDeserialize' (serialize' vk)
-
 -- Failing Scenario
 
 -- hangingScenario =

diff --git a/hydra-node/test/Hydra/Model/MockChain.hs b/hydra-node/test/Hydra/Model/MockChain.hs
@@ -1,96 +1,61 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module Hydra.Model.MockChain where
 
 import Hydra.Cardano.Api
 import Hydra.Prelude hiding (Any, label)
 
-import Cardano.Api.UTxO (pairs)
-import qualified Cardano.Api.UTxO as UTxO
 import Cardano.Binary (serialize', unsafeDeserialize')
 import Cardano.Ledger.Alonzo.TxSeq (TxSeq (TxSeq))
 import qualified Cardano.Ledger.Babbage.Tx as Ledger
 import qualified Cardano.Ledger.Shelley.API as Ledger
-import Control.Monad.Class.MonadAsync (Async, async, cancel)
+import Control.Monad.Class.MonadAsync (Async, async)
 import Control.Monad.Class.MonadFork (labelThisThread)
 import Control.Monad.Class.MonadSTM (
   MonadLabelledSTM,
   labelTQueueIO,
-  labelTVarIO,
   modifyTVar,
-  newTQueue,
   newTQueueIO,
-  newTVarIO,
   readTVarIO,
   tryReadTQueue,
   writeTQueue,
  )
-import Control.Monad.Class.MonadTimer (timeout)
-import Data.List (nub)
-import qualified Data.List as List
-import Data.Map ((!))
-import qualified Data.Map as Map
-import Data.Maybe (fromJust)
 import qualified Data.Sequence.Strict as StrictSeq
-import qualified Data.Set as Set
-import Hydra.API.ClientInput (ClientInput)
-import qualified Hydra.API.ClientInput as Input
-import Hydra.API.ServerOutput (ServerOutput (Committed, GetUTxOResponse, SnapshotConfirmed))
-import qualified Hydra.API.ServerOutput as Output
 import Hydra.BehaviorSpec (
   ConnectToChain (..),
-  TestHydraNode (..),
-  createHydraNode,
-  createTestHydraNode,
-  shortLabel,
-  waitMatch,
-  waitUntilMatch,
  )
-import Hydra.Cardano.Api.Prelude (fromShelleyPaymentCredential)
-import Hydra.Chain (Chain (..), HeadParameters (..))
-import Hydra.Chain.Direct.Fixture (defaultGlobals, defaultLedgerEnv, testNetworkId)
+import Hydra.Chain (Chain (..))
+import Hydra.Chain.Direct.Fixture (testNetworkId)
 import Hydra.Chain.Direct.Handlers (ChainSyncHandler, DirectChainLog, SubmitTx, chainSyncHandler, mkChain, onRollForward)
 import Hydra.Chain.Direct.ScriptRegistry (ScriptRegistry (..))
-import Hydra.Chain.Direct.State (ChainContext, ChainStateAt (..))
+import Hydra.Chain.Direct.State (ChainContext (..), ChainStateAt (..))
 import qualified Hydra.Chain.Direct.State as S
 import Hydra.Chain.Direct.TimeHandle (TimeHandle)
 import qualified Hydra.Chain.Direct.Util as Util
 import Hydra.Chain.Direct.Wallet (TinyWallet (..))
-import Hydra.ContestationPeriod (ContestationPeriod)
 import Hydra.Crypto (HydraKey)
 import Hydra.HeadLogic (
-  Committed (),
   Environment (party),
   Event (NetworkEvent),
   HeadState (..),
-  PendingCommits,
   defaultTTL,
  )
-import Hydra.Ledger (IsTx (..))
-import Hydra.Ledger.Cardano (cardanoLedger, genKeyPair, genSigningKey, genTxIn, mkSimpleTx)
+import Hydra.Ledger.Cardano (genTxIn)
 import Hydra.Logging (Tracer)
-import Hydra.Logging.Messages (HydraLog (DirectChain, Node))
-import Hydra.Model.Payment ()
+import Hydra.Model.Payment (CardanoSigningKey (..))
 import Hydra.Network (Network (..))
 import Hydra.Network.Message (Message)
 import Hydra.Node (
   HydraNode (..),
-  NodeState (NodeState),
   chainCallback,
   createNodeState,
-  modifyHeadState,
   putEvent,
-  queryHeadState,
-  runHydraNode,
  )
 import Hydra.Party (Party (..), deriveParty)
-import qualified Hydra.Snapshot as Snapshot
 import Ouroboros.Consensus.Cardano.Block (HardForkBlock (..))
 import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos
 import Ouroboros.Consensus.Shelley.Ledger (mkShelleyBlock)
 import Test.Consensus.Cardano.Generators ()
-import Test.QuickCheck (choose, counterexample, elements, frequency, resize, sized, tabulate, vectorOf)
-import Test.QuickCheck.DynamicLogic (DynLogicModel)
-import Test.QuickCheck.StateModel (Any (..), LookUp, RunModel (..), StateModel (..), Var)
-import qualified Prelude
 
 -- | Provide the logic to connect a list of `MockHydraNode` through a dummy chain.
 mockChainAndNetwork ::
@@ -227,3 +192,9 @@ createMockChain tracer ctx submitTx timeHandle seedInput =
           , update = const $ pure ()
           }
    in mkChain tracer timeHandle wallet ctx submitTx
+
+mkMockTxIn :: VerificationKey PaymentKey -> Word -> TxIn
+mkMockTxIn vk ix = TxIn (TxId tid) (TxIx ix)
+ where
+  -- NOTE: Ugly, works because both binary representations are 32-byte long.
+  tid = unsafeDeserialize' (serialize' vk)
diff --git a/hydra-node/test/Hydra/Model/Payment.hs b/hydra-node/test/Hydra/Model/Payment.hs
@@ -1,99 +1,20 @@
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
 -- | A simplistic type of transactions useful for modelling purpose.
 -- a `Payment` is a simple transaction type that moves some amount of ADAs between
 -- to `CardanoSigningKey`.
 module Hydra.Model.Payment where
 
-
 import Hydra.Cardano.Api
 import Hydra.Prelude hiding (Any, label)
 
-import Cardano.Api.UTxO (pairs)
-import qualified Cardano.Api.UTxO as UTxO
-import Cardano.Binary (serialize', unsafeDeserialize')
-import Cardano.Ledger.Alonzo.TxSeq (TxSeq (TxSeq))
-import qualified Cardano.Ledger.Babbage.Tx as Ledger
-import qualified Cardano.Ledger.Shelley.API as Ledger
-import Control.Monad.Class.MonadAsync (Async, async, cancel)
-import Control.Monad.Class.MonadFork (labelThisThread)
-import Control.Monad.Class.MonadSTM (
-  MonadLabelledSTM,
-  labelTQueueIO,
-  labelTVarIO,
-  modifyTVar,
-  newTQueue,
-  newTQueueIO,
-  newTVarIO,
-  readTVarIO,
-  tryReadTQueue,
-  writeTQueue,
- )
-import Control.Monad.Class.MonadTimer (timeout)
-import Data.List (nub)
 import qualified Data.List as List
-import Data.Map ((!))
-import qualified Data.Map as Map
-import Data.Maybe (fromJust)
-import qualified Data.Sequence.Strict as StrictSeq
-import qualified Data.Set as Set
-import Hydra.API.ClientInput (ClientInput)
-import qualified Hydra.API.ClientInput as Input
-import Hydra.API.ServerOutput (ServerOutput (Committed, GetUTxOResponse, SnapshotConfirmed))
-import qualified Hydra.API.ServerOutput as Output
-import Hydra.BehaviorSpec (
-  ConnectToChain (..),
-  TestHydraNode (..),
-  createHydraNode,
-  createTestHydraNode,
-  shortLabel,
-  waitMatch,
-  waitUntilMatch,
- )
-import Hydra.Cardano.Api.Prelude (fromShelleyPaymentCredential)
-import Hydra.Chain (Chain (..), HeadParameters (..))
-import Hydra.Chain.Direct.Fixture (defaultGlobals, defaultLedgerEnv, testNetworkId)
-import Hydra.Chain.Direct.Handlers (ChainSyncHandler, DirectChainLog, SubmitTx, chainSyncHandler, mkChain, onRollForward)
-import Hydra.Chain.Direct.ScriptRegistry (ScriptRegistry (..))
-import Hydra.Chain.Direct.State (ChainContext, ChainStateAt (..))
-import qualified Hydra.Chain.Direct.State as S
-import Hydra.Chain.Direct.TimeHandle (TimeHandle)
-import qualified Hydra.Chain.Direct.Util as Util
-import Hydra.Chain.Direct.Wallet (TinyWallet (..))
-import Hydra.ContestationPeriod (ContestationPeriod)
-import Hydra.Crypto (HydraKey)
-import Hydra.HeadLogic (
-  Committed (),
-  Environment (party),
-  Event (NetworkEvent),
-  HeadState (..),
-  PendingCommits,
-  defaultTTL,
- )
+import Hydra.Chain.Direct.Fixture (testNetworkId)
 import Hydra.Ledger (IsTx (..))
-import Hydra.Ledger.Cardano (cardanoLedger, genKeyPair, genSigningKey, genTxIn, mkSimpleTx)
-import Hydra.Logging (Tracer)
-import Hydra.Logging.Messages (HydraLog (DirectChain, Node))
-import Hydra.Network (Network (..))
-import Hydra.Network.Message (Message)
-import Hydra.Node (
-  HydraNode (..),
-  NodeState (NodeState),
-  chainCallback,
-  createNodeState,
-  modifyHeadState,
-  putEvent,
-  queryHeadState,
-  runHydraNode,
- )
-import Hydra.Party (Party (..), deriveParty)
-import qualified Hydra.Snapshot as Snapshot
-import Ouroboros.Consensus.Cardano.Block (HardForkBlock (..))
-import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos
-import Ouroboros.Consensus.Shelley.Ledger (mkShelleyBlock)
+import Hydra.Ledger.Cardano (genKeyPair)
 import Test.Consensus.Cardano.Generators ()
-import Test.QuickCheck (choose, counterexample, elements, frequency, resize, sized, tabulate, vectorOf)
-import Test.QuickCheck.DynamicLogic (DynLogicModel)
-import Test.QuickCheck.StateModel (Any (..), LookUp, RunModel (..), StateModel (..), Var)
+import Test.QuickCheck (choose)
 import qualified Prelude
 
 newtype CardanoSigningKey = CardanoSigningKey {signingKey :: SigningKey PaymentKey}

diff --git a/hydra-node/test/Hydra/ModelSpec.hs b/hydra-node/test/Hydra/ModelSpec.hs
@@ -84,6 +84,7 @@ import Hydra.Model (
   runModel,
  )
 import qualified Hydra.Model as Model
+import qualified Hydra.Model.Payment as Payment
 import Hydra.Party (Party (..), deriveParty)
 import Test.QuickCheck (Property, Testable, counterexample, forAll, noShrinking, property, withMaxSuccess, within)
 import Test.QuickCheck.DynamicLogic (
@@ -161,7 +162,7 @@ prop_doesNotGenerate0AdaUTxO (Actions actions) =
   contains0AdaUTxO :: Step WorldState -> Bool
   contains0AdaUTxO = \case
     _anyVar := Model.Commit _anyParty utxos -> any contains0Ada utxos
-    _anyVar := Model.NewTx _anyParty Model.Payment{value} -> value == lovelaceToValue 0
+    _anyVar := Model.NewTx _anyParty Payment.Payment{value} -> value == lovelaceToValue 0
     _anyOtherStep -> False
   contains0Ada = (== lovelaceToValue 0) . snd
 
@@ -200,7 +201,7 @@ assertBalancesInOpenHeadAreConsistent world nodes p = do
             Map.fromListWith
               (<>)
               [ (unwrapAddress addr, value)
-              | (Model.CardanoSigningKey sk, value) <- confirmedUTxO
+              | (Payment.CardanoSigningKey sk, value) <- confirmedUTxO
               , let addr = mkVkAddress testNetworkId (getVerificationKey sk)
               , valueToLovelace value /= Just 0
               ]