http-test 0.1.2 → 0.1.3

raw patch · 2 files changed

+61/−23 lines, 2 files

Files

• Test/HTTP.hs +60/−22
• http-test.cabal +1/−1

@@ -1,4 +1,4 @@-module Test.HTTP (httpTest, session, get, getJSON, postForm, assert, debug, Program, Session) where+module Test.HTTP (httpTest, session, get, getJSON, withJSON, postForm, assert, assertEq, assertParse, debug, Program, Session) where  import Network.Curl hiding (curlGetString) @@ -16,6 +16,7 @@ import Data.Maybe import GHC.Conc import qualified Data.Aeson as Ae+import Data.Aeson.Types (Parser, parseEither) import Safe (readMay) import System.Environment import System.Exit@@ -27,13 +28,10 @@ type Program = ReaderT (TVar [Results]) IO  data SessionState = SessionState { sessionResults :: Results,-                               sessionBaseUrl :: String,-                               sessionCurl :: Curl }----what we really want---type Session = EitherT String (State.StateT SessionState IO)+                                   sessionBaseUrl :: String,+                                   sessionCurl :: Curl } -type Session = State.StateT SessionState IO+type Session a = State.StateT SessionState (ErrorT String IO) a  type Results = [(String, Maybe String)] @@ -59,17 +57,26 @@ session :: String -- ^ Session name (used for logging failures)         -> String -- ^ Base URL         -> Session () -- ^ the actions and assertions that define the session-        ->  Program ()+        -> Program () session sessionName baseURL m = do    c <- liftIO $ initialize    let state0 = SessionState [] baseURL c    liftIO $ setopts c [CurlCookieJar (sessionName++"_cookies"),                         CurlFollowLocation True]-   SessionState res _ _ <- liftIO $ State.execStateT m state0-   res_tv <- ask-   liftIO $ atomically $ do -       others <- readTVar res_tv-       writeTVar res_tv $ others ++ [res]+   res <- liftIO $ runErrorT $ State.execStateT m state0+   case res of +      Right (SessionState res _ _) -> do+         res_tv <- ask+         liftIO $ atomically $ do +            others <- readTVar res_tv+            writeTVar res_tv $ others ++ [reverse res]+      Left err -> do+         res_tv <- ask+         liftIO $ atomically $ do +            others <- readTVar res_tv+            writeTVar res_tv $ others ++ +                               [[(sessionName, +                                 Just $ sessionName ++ " session failure:" ++err)]]  -- | GET a web page as a String get :: String -- ^ URL@@ -87,14 +94,28 @@  -- | GET a JSON value getJSON :: Ae.FromJSON a => -        String -- ^ URL-        -> Session a+           String  -- ^ URL+           -> Session a getJSON url = do   str <- get url-  let Just x = Ae.decode' $ fromStrict $ encodeUtf8 $ T.pack str-  return x+  case Ae.eitherDecode' $ fromStrict $ encodeUtf8 $ T.pack str of+    Right x -> return x+    Left err -> throwError $  "GET "++url ++ " JSON decoding failure: "++ err --- | POST a form++-- | perform an action with a JSON value from a GET+withJSON :: Ae.FromJSON a => +           String  -- ^ URL+           -> (a -> Session ()) -- ^ action to perform on successfully decoded value+           -> Session ()+withJSON url mu = do+  str <- get url+  case Ae.eitherDecode' $ fromStrict $ encodeUtf8 $ T.pack str of+    Right x -> mu x+    Left err -> do failTest ("GET "++url) $ "JSON decoding failure: "++ err+                   return ()++-- | Post a form postForm :: String -- ^ URL          -> [(String,String)]  -- ^ form fields          -> Session String@@ -109,10 +130,27 @@ assert :: String -- ^ assertion name (used for reporting failures        -> Bool -- ^ Boolean of which we are asserting truth        -> Session ()-assert assName True = -  passTest assName-assert assName False =-  failTest assName "fail" +assert assName True = passTest assName+assert assName False = failTest assName "fail" ++-- | assert equality, for better output messages+assertEq :: (Show a, Eq a) => String -- ^ assertion name (used for reporting failures+       -> a  -- ^ a value+       -> a  -- ^ what it is meant to be equal to+       -> Session ()+assertEq assName x y | x == y    = passTest assName+                     | otherwise = failTest assName $ "not equal: "++show x ++" /= "++show y++-- | make an assertion in the Parser monad, ofr use with JSON value+assertParse :: String      -- ^ assertion name (used for reporting failures+            -> Parser Bool -- ^ Boolean of which we are asserting truth+            -> Session ()+assertParse assName pb  =+  case parseEither (const pb) () of+    Left err -> failTest assName $ "parse failure: "++err+    Right True -> passTest assName+    Right False -> failTest assName "fail" +  -- | Output a string to stdout if @--verbose@ is in command line arguments debug :: String -> Session ()

@@ -1,5 +1,5 @@ Name:                http-test-Version:             0.1.2+Version:             0.1.3 synopsis:            Test framework for HTTP APIs Description:         A simple framework for making assertions about the                       responses of HTTP servers.