feat: reset deployment between tests

spex.cabal

@@ -52,6 +52,7 @@ library
     Spex.Verifier.Generator.Env
     Spex.Verifier.HealthChecker
     Spex.Verifier.HttpClient
+    Spex.Verifier.Reseter
 
   autogen-modules:    Paths_spex
   other-modules:      Paths_spex

src/Spex/Monad.hs

@@ -145,6 +145,7 @@ data AppError
   | HttpClientDecodeError Op ByteString String
   | HttpClientUnexpectedStatusCode Int ByteString
   | HealthCheckFailed
+  | ResetFailed
   | TestFailure String Int
 
 throwA :: AppError -> App e
@@ -173,6 +174,7 @@ displayAppError spec = \case
   HttpClientDecodeError op body e -> "Couldn't decode the response of:\n\n    " <> displayOp displayValue op <> "\n\nfrom the body of the request: '" <> BS8.unpack body <> "'\n\nThe error being: " <> e
   HttpClientUnexpectedStatusCode _ _ -> "HTTP client returned 1xx or 3xx"
   HealthCheckFailed          -> "Health check failed, make sure that the deployment is running."
+  ResetFailed                -> "Reset of the deploymnet failed, make sure that reset returns 2xx or exits with 0."
   TestFailure e seed         -> "Test failure: " <> e <>
                                 "\nUse --seed " <> show seed <> " to reproduce"
 

src/Spex/Syntax.hs

@@ -2,7 +2,6 @@
 
 module Spex.Syntax where
 
-import Data.ByteString (ByteString)
 import Data.ByteString.Char8 as BS8
 import Data.String (IsString)
 

src/Spex/Syntax/Type.hs

@@ -31,12 +31,14 @@ type Record a = Map Field a
 newtype Field = Field ByteString
   deriving (Eq, Ord, Show, IsString)
 
-data Method = Get | Post
+data Method = Get | Post | Put | Delete
   deriving Show
 
 displayMethod :: Method -> String
-displayMethod Get  = "GET"
-displayMethod Post = "POST"
+displayMethod Get    = "GET"
+displayMethod Post   = "POST"
+displayMethod Put    = "PUT"
+displayMethod Delete = "DELETE"
 
 displayType :: Type -> String
 displayType UnitT          = "Unit"

src/Spex/Verifier.hs

@@ -13,6 +13,7 @@ import Spex.Verifier.Codec.Json
 import Spex.Verifier.Generator
 import Spex.Verifier.Generator.Env
 import Spex.Verifier.HttpClient
+import Spex.Verifier.Reseter
 
 ------------------------------------------------------------------------
 
@@ -48,6 +49,7 @@ verify spec deployment = do
   mSeed <- asks mSeed
   (prng, seed) <- liftIO (newPrng mSeed)
   client <- newHttpClient deployment
+  reseter client deployment.reset
   go numTests [] seed prng client 0 Map.empty
   where
     go :: Word -> [Op] -> Int -> Prng -> HttpClient -> Word -> Coverage -> App Result

src/Spex/Verifier/HealthChecker.hs

@@ -4,6 +4,7 @@ module Spex.Verifier.HealthChecker where
 
 import Control.Concurrent (threadDelay)
 import Control.Monad (when)
+import Data.ByteString (ByteString)
 import System.Exit
 import System.Process
 
@@ -24,6 +25,7 @@ healthChecker deployment@(Deployment _hostPort health _reset) = do
       http 50 path client
     HealthCheckScript fp -> script 50 fp
   where
+    script :: Word -> FilePath -> App ()
     script 0 _fp = info_ "" >> throwA HealthCheckFailed
     script n  fp = do
       (exitCode, _out, _err) <- liftIO (readProcessWithExitCode fp [] "")
@@ -33,6 +35,7 @@ healthChecker deployment@(Deployment _hostPort health _reset) = do
           wait n
           script (n - 1) fp
 
+    http :: Word -> ByteString -> HttpClient -> App ()
     http 0 _path _client = info_ "" >> throwA HealthCheckFailed
     http n  path  client = do
       eResp <- tryA $

src/Spex/Verifier/HttpClient.hs

@@ -68,8 +68,10 @@ httpRequest client op = do
                    status.statusCode status.statusMessage)
 
 toHttpMethod :: Method -> Http.Method
-toHttpMethod Get  = Http.methodGet
-toHttpMethod Post = Http.methodPost
+toHttpMethod Get    = Http.methodGet
+toHttpMethod Post   = Http.methodPost
+toHttpMethod Put    = Http.methodPut
+toHttpMethod Delete = Http.methodDelete
 
 toHttpPath :: [PathSegment Value] -> ByteString
 toHttpPath = BS8.intercalate "/" . map aux

src/Spex/Verifier/Reseter.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Spex.Verifier.Reseter where
+
+import System.Exit
+import System.Process
+
+import Spex.Monad
+import Spex.Syntax
+import Spex.Syntax.Operation
+import Spex.Syntax.Type
+import Spex.Syntax.Value
+import Spex.Verifier.HttpClient
+
+------------------------------------------------------------------------
+
+reseter :: HttpClient -> Reset -> App ()
+reseter client reset = do
+  case reset of
+    ResetPath path -> do
+      let op = Op "_reset" Delete [Path path] Nothing UnitT
+      debug (displayOp displayValue op)
+      eResp <- tryA $ httpRequest client op
+      case eResp of
+        Left _err -> throwA ResetFailed
+        Right (Ok2xx _body) -> return ()
+        Right ClientError4xx {} -> throwA ResetFailed
+        Right ServerError5xx {} -> throwA ResetFailed
+
+    ResetScript fp -> do
+      (exitCode, _out, _err) <- liftIO (readProcessWithExitCode fp [] "")
+      case exitCode of
+        ExitSuccess -> return ()
+        ExitFailure _code -> throwA ResetFailed