module Testing.CurlRunnings.Types
( CurlSuite(..)
, CurlCase(..)
, HttpMethod(..)
, JsonMatcher(..)
, JsonSubExpr(..)
, StatusCodeMatcher(..)
, AssertionFailure(..)
, CaseResult(..)
, isPassing
, isFailing
) where
import Data.Aeson
import Data.Aeson.Encode.Pretty
import Data.Aeson.Types
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.HashMap.Strict as H
import Data.Maybe
import qualified Data.Text as T
import GHC.Generics
import Testing.CurlRunnings.Internal
import Text.Printf
data HttpMethod
= GET
| POST
| PUT
| PATCH
| DELETE
deriving (Show, Generic)
instance FromJSON HttpMethod
instance ToJSON HttpMethod
data JsonMatcher
= Exactly Value
| Contains [JsonSubExpr]
deriving (Show, Generic)
instance ToJSON JsonMatcher
instance FromJSON JsonMatcher where
parseJSON (Object v)
| isJust $ H.lookup "exactly" v = Exactly <$> v .: "exactly"
| isJust $ H.lookup "contains" v = Contains <$> v .: "contains"
parseJSON invalid = typeMismatch "JsonMatcher" invalid
data JsonSubExpr
= ValueMatch Value
| KeyValueMatch { matchKey :: T.Text
, matchValue :: Value }
deriving (Show, Generic)
instance FromJSON JsonSubExpr where
parseJSON (Object v)
| isJust $ H.lookup "keyValueMatch" v =
let toParse = fromJust $ H.lookup "keyValueMatch" v
in case toParse of
Object o -> KeyValueMatch <$> o .: "key" <*> o .: "value"
_ -> typeMismatch "JsonSubExpr" toParse
| isJust $ H.lookup "valueMatch" v = ValueMatch <$> v .: "valueMatch"
parseJSON invalid = typeMismatch "JsonSubExpr" invalid
instance ToJSON JsonSubExpr
data StatusCodeMatcher
= ExactCode Int
| AnyCodeIn [Int]
deriving (Show, Generic)
instance ToJSON StatusCodeMatcher
instance FromJSON StatusCodeMatcher where
parseJSON obj@(Number _) = ExactCode <$> parseJSON obj
parseJSON obj@(Array _) = AnyCodeIn <$> parseJSON obj
parseJSON invalid = typeMismatch "StatusCodeMatcher" invalid
data CurlCase = CurlCase
{ name :: String
, url :: String
, requestMethod :: HttpMethod
, requestData :: Maybe Value
, expectData :: Maybe JsonMatcher
, expectStatus :: StatusCodeMatcher
} deriving (Show, Generic)
instance FromJSON CurlCase
instance ToJSON CurlCase
data AssertionFailure
= DataFailure CurlCase
JsonMatcher
(Maybe Value)
| StatusFailure CurlCase
Int
| UnexpectedFailure
instance Show AssertionFailure where
show (StatusFailure c receivedCode) =
case expectStatus c of
ExactCode code ->
printf
"Incorrect status code from %s. Expected: %s. Actual: %s"
(url c)
(show code)
(show receivedCode)
AnyCodeIn codes ->
printf
"Incorrect status code from %s. Expected one of: %s. Actual: %s"
(url c)
(show codes)
(show receivedCode)
show (DataFailure curlCase expected receivedVal) =
case expected of
Exactly expectedVal ->
printf
"JSON response from %s didn't match spec. Expected: %s. Actual: %s"
(url curlCase)
(B8.unpack (encodePretty expectedVal))
(B8.unpack (encodePretty receivedVal))
(Contains expectedVals) ->
printf
"JSON response from %s didn't contain the matcher. Expected: %s to be each be subvalues in: %s"
(url curlCase)
(B8.unpack (encodePretty expectedVals))
(B8.unpack (encodePretty receivedVal))
show UnexpectedFailure = "Unexpected Error D:"
data CaseResult
= CasePass CurlCase
| CaseFail CurlCase
[AssertionFailure]
instance Show CaseResult where
show (CasePass c) = makeGreen "[PASS] " ++ name c
show (CaseFail c failures) =
makeRed "[FAIL] " ++
name c ++
"\n" ++
concatMap ((\s -> "\nAssertion failed: " ++ s) . (++ "\n") . show) failures
newtype CurlSuite =
CurlSuite [CurlCase]
deriving (Show, Generic)
instance FromJSON CurlSuite
instance ToJSON CurlSuite
isPassing :: CaseResult -> Bool
isPassing (CasePass _) = True
isPassing (CaseFail _ _) = False
isFailing :: CaseResult -> Bool
isFailing (CasePass _) = False
isFailing (CaseFail _ _) = True