Skip to content
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

Jump to bottom

Restore testing with stack / nix-shell #195

Closed
wants to merge 1 commit into from
Closed

Restore testing with stack / nix-shell #195

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
2 changes: 1 addition & 1 deletion pact.cabal
View file
Open in desktop
Expand Up @@ -199,7 +199,7 @@ test-suite hspec
main-is: hspec.hs
hs-source-dirs: tests
default-language: Haskell2010
ghc-options: -Wall -threaded -rtsopts -O2 -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints
ghc-options: -Wall -threaded -with-rtsopts=-N -O2 -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints
build-depends:
base
, hspec
Expand Down
29 changes: 9 additions & 20 deletions tests/Utils/TestRunner.hs
View file
Open in desktop
Expand Up @@ -72,19 +72,8 @@ startServer configFile = do
return (asyncServer, asyncCmd, asyncHist)

stopServer :: (Async (), Async (), Async ()) -> IO ()
stopServer (asyncServer, asyncCmd, asyncHist) = do
uninterruptibleCancel asyncCmd
uninterruptibleCancel asyncHist
uninterruptibleCancel asyncServer
mapM_ checkFinished [asyncServer, asyncCmd, asyncHist]
where checkFinished asy = do
asyPoll <- poll asy
case asyPoll of
Nothing -> Exception.evaluate $ error $ ("Thread " ++
(show (asyncThreadId asy)) ++
" could not be cancelled.")
_ -> return ()

stopServer (asyncServer, _, _) = cancel asyncServer
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If @slpopejoy signs off on this, looks like it's good to go.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@LindaOrtega made this suggestion originally. This change prevents a few sporadic connection failures in the tests.


run :: [Command T.Text] -> IO (HM.HashMap RequestKey ApiResult)
run cmds = do
sendResp <- doSend $ SubmitBatch cmds
Expand All @@ -95,7 +84,7 @@ run cmds = do
case results of
Nothing -> Exception.evaluate (error "Received empty poll. Timeout in retrying.")
Just res -> return res

where helper reqKeys = do
pollResp <- doPoll $ Poll reqKeys
case pollResp of
Expand All @@ -107,7 +96,7 @@ run cmds = do
doSend :: (ToJSON req) => req -> IO (ApiResponse RequestKeys)
doSend req = do
view responseBody <$> doSend' req

doSend' :: (ToJSON req) => req -> IO (Response (ApiResponse RequestKeys))
doSend' req = do
sendResp <- post (_serverPath ++ "send") (toJSON req)
Expand All @@ -124,7 +113,7 @@ doPoll' req = do


flushDb :: IO ()
flushDb = mapM_ deleteIfExists _logFiles
flushDb = mapM_ deleteIfExists _logFiles
where deleteIfExists filename = do
let fp = _testLogDir ++ filename
isFile <- doesFileExist fp
Expand All @@ -135,7 +124,7 @@ genKeys = do
g :: SystemRandom <- newGenIO
case generateKeyPair g of
Left _ -> error "Something went wrong in genKeys"
Right (s,p,_) -> return $ KeyPair s p
Right (s,p,_) -> return $ KeyPair s p



Expand All @@ -154,7 +143,7 @@ checkResult isFailure expect result =

checkIfSuccess :: Object -> Maybe Value -> Expectation
checkIfSuccess h Nothing = HM.lookup (T.pack "status") h `shouldBe` (Just . String . T.pack) "success"
checkIfSuccess h (Just expect) = do
checkIfSuccess h (Just expect) = do
HM.lookup (T.pack "status") h `shouldBe` (Just . String . T.pack) "success"
HM.lookup (T.pack "data") h `shouldBe` Just (toJSON expect)

Expand All @@ -177,7 +166,7 @@ threeStepPactCode moduleName = T.concat [begCode, T.pack moduleName, endCode]
(step "step 0")
(step "step 1")
(step "step 2")))
|]
|]

errorStepPactCode :: String -> T.Text
errorStepPactCode moduleName = T.concat [begCode, T.pack moduleName, endCode]
Expand All @@ -188,7 +177,7 @@ errorStepPactCode moduleName = T.concat [begCode, T.pack moduleName, endCode]
(step "step 0")
(step (+ "will throw error in step 1"))
(step "step 2")))
|]
|]

pactWithRollbackCode :: String -> T.Text
pactWithRollbackCode moduleName = T.concat [begCode, T.pack moduleName, endCode]
Expand Down