Skip to content

Refactor behavior spec #14

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
ch1bo merged 9 commits into from
Jun 10, 2021
Merged

Refactor behavior spec #14

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
9 commits
Select commit Hold shift + click to select a range
3d4e17f
Factor out failAfter and re-use it between tests
ch1bo Jun 4, 2021
07ff2e4
Rename / move some test cases
ch1bo Jun 7, 2021
6abe356
Add a test about head finalization and pick a long contestation period
ch1bo Jun 7, 2021
74df97b
Use io-sim-classes to replace IO with IOSim later
ch1bo Jun 7, 2021
2df2eba
Add and use a 'failure' helper instead of 'error'
ch1bo Jun 7, 2021
6965395
Create lifted variants for `shouldBe` and `shouldRetur
ch1bo Jun 9, 2021
d965e51
Create and use 'shouldRunInSim'
ch1bo Jun 9, 2021
9113699
Use lifted should's in more places
ch1bo Jun 9, 2021
0f8225a
BehaviorSpec uses a withHydraNode now and rename HydraProcess
ch1bo Jun 9, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion hydra-node/hydra-node.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -118,7 +118,6 @@ library
, optparse-applicative
, ouroboros-network-framework
, prometheus
, safe-exceptions
, serialise
, shelley-spec-ledger
, shelley-spec-ledger-test
Expand Down Expand Up @@ -170,6 +169,7 @@ test-suite tests
Hydra.NetworkSpec
Hydra.NodeSpec
Hydra.OptionSpec
Test.Util
main-is: Main.hs
type: exitcode-stdio-1.0
build-depends:
Expand All @@ -187,6 +187,7 @@ test-suite tests
, QuickCheck
, serialise
, typed-protocols-examples
, HUnit
build-tool-depends:
hspec-discover:hspec-discover
ghc-options:
Expand Down
10 changes: 7 additions & 3 deletions hydra-node/src/Hydra/Logging.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ module Hydra.Logging (
nullTracer,
contramap,
traceWith,
traceInTVarIO,
traceInTVar,
LoggerName,

-- * Using it
Expand Down Expand Up @@ -38,8 +38,7 @@ import Cardano.BM.Setup (
setupTrace_,
shutdown,
)
import Cardano.BM.Trace (traceInTVarIO)
import Cardano.Prelude
import Cardano.Prelude hiding (atomically)
import Control.Tracer (
Tracer (..),
contramap,
Expand All @@ -50,6 +49,7 @@ import Control.Tracer (

import qualified Cardano.BM.Configuration.Model as CM
import qualified Cardano.BM.Data.BackendKind as CM
import Control.Monad.Class.MonadSTM (MonadSTM (atomically), TVar, modifyTVar)

data Verbosity = Quiet | Verbose LoggerName
deriving (Eq, Show)
Expand Down Expand Up @@ -89,3 +89,7 @@ transformLogObject transform tr = Tracer $ \a -> do
traceWith tr . (mempty,) =<< LogObject mempty
<$> mkLOMeta Debug Public
<*> pure (LogMessage (transform a))

traceInTVar :: MonadSTM m => TVar m [a] -> Tracer m a
traceInTVar tvar = Tracer $ \a ->
atomically $ modifyTVar tvar (a :)
15 changes: 5 additions & 10 deletions hydra-node/src/Hydra/Node.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -6,14 +6,9 @@
module Hydra.Node where

import Cardano.Prelude hiding (STM, async, atomically, cancel, check, poll, threadDelay)
import Control.Concurrent.STM (
newTQueueIO,
readTQueue,
writeTQueue,
)
import Control.Exception.Safe (MonadThrow)
import Control.Monad.Class.MonadAsync (MonadAsync, async)
import Control.Monad.Class.MonadSTM (MonadSTM (STM), atomically, newTVar, stateTVar)
import Control.Monad.Class.MonadSTM (MonadSTM (STM), atomically, newTQueue, newTVar, readTQueue, stateTVar, writeTQueue)
import Control.Monad.Class.MonadThrow (MonadThrow)
import Control.Monad.Class.MonadTimer (MonadTimer, threadDelay)
import Hydra.HeadLogic (
ClientRequest (..),
Expand Down Expand Up @@ -126,9 +121,9 @@ data EventQueue m e = EventQueue
, nextEvent :: m e
}

createEventQueue :: IO (EventQueue IO e)
createEventQueue :: MonadSTM m => m (EventQueue m e)
createEventQueue = do
q <- newTQueueIO
q <- atomically newTQueue
pure
EventQueue
{ putEvent = atomically . writeTQueue q
Expand Down Expand Up @@ -156,7 +151,7 @@ putState :: HydraHead tx m -> HeadState tx -> STM m ()
putState HydraHead{modifyHeadState} new =
modifyHeadState $ const ((), new)

createHydraHead :: (MonadSTM m) => HeadState tx -> Ledger tx -> m (HydraHead tx m)
createHydraHead :: MonadSTM m => HeadState tx -> Ledger tx -> m (HydraHead tx m)
createHydraHead initialState ledger = do
tv <- atomically $ newTVar initialState
pure HydraHead{modifyHeadState = stateTVar tv, ledger}
Expand Down
Loading
⚡