Skip to content

Commit

Permalink
Add withTestAPIServer
Browse files Browse the repository at this point in the history
  • Loading branch information
@v0d1ch
v0d1ch committed Jun 6, 2023
1 parent 454763c commit f999ecb
Show file tree
Hide file tree
Showing 2 changed files with 38 additions and 19 deletions.
51 changes: 33 additions & 18 deletions hydra-node/test/Hydra/API/ServerSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ import qualified Data.ByteString.Base16 as Base16
import qualified Data.List as List
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import Hydra.API.Server (RunServerException (..), Server (Server, sendOutput), withAPIServer)
import Hydra.API.Server (APIServerLog, RunServerException (..), Server (Server, sendOutput), ServerComponent, withAPIServer)
import Hydra.API.ServerOutput (ServerOutput (..), TimedServerOutput (..), input)
import Hydra.Chain (
Chain (Chain),
Expand All @@ -36,9 +36,10 @@ import Hydra.Chain (
postTx,
)
import Hydra.Ledger.Simple (SimpleTx)
import Hydra.Logging (showLogsOnFailure)
import Hydra.Logging (Tracer, showLogsOnFailure)
import Hydra.Network (PortNumber)
import Hydra.Persistence (PersistenceIncremental (..), createPersistenceIncremental)
import Hydra.Party (Party)
import Hydra.Persistence (Persistence, PersistenceIncremental (..), createPersistenceIncremental)
import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (Snapshot, utxo), confirmed)
import Network.WebSockets (Connection, receiveData, runClient, sendBinaryData)
import System.IO.Error (isAlreadyInUseError)
Expand All @@ -53,7 +54,7 @@ spec = describe "ServerSpec" $
parallel $ do
it "should fail on port in use" $ do
showLogsOnFailure $ \tracer -> failAfter 5 $ do
let withServerOnPort p = withAPIServer @SimpleTx "127.0.0.1" p alice mockPersistence tracer dummyChainHandle noop
let withServerOnPort p = withTestAPIServer p alice mockPersistence tracer
withFreePort $ \port -> do
-- We should not be able to start the server on the same port twice
withServerOnPort port $ \_ ->
Expand All @@ -66,15 +67,15 @@ spec = describe "ServerSpec" $
failAfter 5 $
showLogsOnFailure $ \tracer ->
withFreePort $ \port ->
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \_ -> do
withTestAPIServer port alice mockPersistence tracer $ \_ -> do
withClient port "/" $ \conn -> do
waitMatch 5 conn $ guard . matchGreetings

it "sends sendOutput to all connected clients" $ do
queue <- atomically newTQueue
showLogsOnFailure $ \tracer -> failAfter 5 $
withFreePort $ \port -> do
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
semaphore <- newTVarIO 0
withAsync
( concurrently_
Expand All @@ -100,14 +101,14 @@ spec = describe "ServerSpec" $

persistence <- createPersistenceIncremental persistentFile
withFreePort $ \port -> do
withAPIServer @SimpleTx "127.0.0.1" port alice persistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice persistence tracer $ \Server{sendOutput} -> do
sendOutput arbitraryMsg

queue1 <- atomically newTQueue
queue2 <- atomically newTQueue
persistence' <- createPersistenceIncremental persistentFile
withFreePort $ \port -> do
withAPIServer @SimpleTx "127.0.0.1" port alice persistence' tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice persistence' tracer $ \Server{sendOutput} -> do
semaphore <- newTVarIO 0
withAsync
( concurrently_
Expand Down Expand Up @@ -143,7 +144,7 @@ spec = describe "ServerSpec" $
run $
showLogsOnFailure $ \tracer ->
withFreePort $ \port ->
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
mapM_ sendOutput outputs
withClient port "/" $ \conn -> do
received <- failAfter 5 $ replicateM (length outputs + 1) (receiveData conn)
Expand All @@ -163,7 +164,7 @@ spec = describe "ServerSpec" $
run $
showLogsOnFailure $ \tracer ->
withFreePort $ \port ->
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
let sendFromApiServer = sendOutput
mapM_ sendFromApiServer history
-- start client that doesn't want to see the history
Expand All @@ -187,7 +188,7 @@ spec = describe "ServerSpec" $
it "outputs tx as cbor or json depending on the client" $
showLogsOnFailure $ \tracer ->
withFreePort $ \port ->
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
tx :: SimpleTx <- generate arbitrary
generatedSnapshot :: Snapshot SimpleTx <- generate arbitrary

Expand Down Expand Up @@ -250,7 +251,7 @@ spec = describe "ServerSpec" $
it "removes UTXO from snapshot when clients request it" $
showLogsOnFailure $ \tracer -> failAfter 5 $
withFreePort $ \port ->
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
snapshot <- generate arbitrary
let snapshotConfirmedMessage =
SnapshotConfirmed
Expand All @@ -271,7 +272,7 @@ spec = describe "ServerSpec" $
run $
showLogsOnFailure $ \tracer -> failAfter 5 $
withFreePort $ \port ->
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
mapM_ sendOutput outputs
withClient port "/" $ \conn -> do
received <- replicateM (length outputs + 1) (receiveData conn)
Expand All @@ -284,7 +285,7 @@ spec = describe "ServerSpec" $
it "displays correctly headStatus and snapshotUtxo in a Greeting message" $
showLogsOnFailure $ \tracer ->
withFreePort $ \port -> do
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice mockPersistence tracer $ \Server{sendOutput} -> do
let generateSnapshot =
generate $
SnapshotConfirmed <$> arbitrary <*> arbitrary <*> arbitrary
Expand Down Expand Up @@ -324,7 +325,7 @@ spec = describe "ServerSpec" $
generateSnapshot
let expectedUtxos = toJSON utxo

withAPIServer @SimpleTx "127.0.0.1" port alice apiPersistence tracer dummyChainHandle noop $ \Server{sendOutput} -> do
withTestAPIServer port alice apiPersistence tracer $ \Server{sendOutput} -> do
headIsInitializing <- generate $ HeadIsInitializing <$> arbitrary <*> arbitrary

mapM_ sendOutput [headIsInitializing, snapShotConfirmedMsg]
Expand All @@ -333,7 +334,7 @@ spec = describe "ServerSpec" $
guard $ v ^? key "snapshotUtxo" == Just expectedUtxos

-- expect the api server to load events from apiPersistence and project headStatus correctly
withAPIServer @SimpleTx "127.0.0.1" port alice apiPersistence tracer dummyChainHandle noop $ \_ -> do
withTestAPIServer port alice apiPersistence tracer $ \_ -> do
waitForValue port $ \v -> do
guard $ v ^? key "headStatus" == Just (Aeson.String "Initializing")
guard $ v ^? key "snapshotUtxo" == Just expectedUtxos
Expand All @@ -352,7 +353,7 @@ strictlyMonotonic = \case
sendsAnErrorWhenInputCannotBeDecoded :: PortNumber -> Expectation
sendsAnErrorWhenInputCannotBeDecoded port = do
showLogsOnFailure $ \tracer ->
withAPIServer @SimpleTx "127.0.0.1" port alice mockPersistence tracer dummyChainHandle noop $ \_server -> do
withTestAPIServer port alice mockPersistence tracer $ \_server -> do
withClient port "/" $ \con -> do
_greeting :: ByteString <- receiveData con
sendBinaryData con invalidInput
Expand Down Expand Up @@ -391,11 +392,25 @@ testClient queue semaphore cnx = do
testClient queue semaphore cnx

dummyChainHandle :: Chain tx IO
dummyChainHandle = Chain{postTx = \_ -> pure (), draftTx = \_ -> error "draftTx not implemented"}
dummyChainHandle =
Chain
{ postTx = \_ -> error "unexpected call to postTx"
, draftTx = \_ -> error "unexpected call to draftTx"
}

noop :: Applicative m => a -> m ()
noop = const $ pure ()

withTestAPIServer ::
PortNumber ->
Party ->
PersistenceIncremental (TimedServerOutput SimpleTx) IO ->
Tracer IO APIServerLog ->
(Server SimpleTx IO -> IO ()) ->
IO ()
withTestAPIServer port actor persistence tracer =
withAPIServer @SimpleTx "127.0.0.1" port actor persistence tracer dummyChainHandle noop

withClient :: PortNumber -> String -> (Connection -> IO ()) -> IO ()
withClient port path action = do
runClient "127.0.0.1" (fromIntegral port) path action
Expand Down
6 changes: 5 additions & 1 deletion hydra-node/test/Hydra/BehaviorSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -594,7 +594,11 @@ simulatedChainAndNetwork initialChainState = do
atomically $ modifyTVar nodes (node :)
pure $
node
{ oc = Chain{postTx = postTx nodes history chainStateVar, draftTx = \_ -> error "draftTx not implemented"}
{ oc =
Chain
{ postTx = postTx nodes history chainStateVar
, draftTx = \_ -> error "unexpected call to draftTx"
}
, hn = createMockNetwork node nodes
}
, tickThread
Expand Down

0 comments on commit f999ecb

Please sign in to comment.