{-# LANGUAGE DeriveGeneric            #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns           #-}
{-# LANGUAGE OverloadedStrings        #-}

-- | Data types for curl-runnings tests

module Testing.CurlRunnings.Types
  ( AssertionFailure(..)
  , Authentication(..)
  , CaseResult(..)
  , CurlCase(..)
  , CurlRunningsState(..)
  , CurlSuite(..)
  , FullQueryText
  , Header(..)
  , HeaderMatcher(..)
  , Headers(..)
  , HttpMethod(..)
  , Index(..)
  , InterpolatedQuery(..)
  , JsonMatcher(..)
  , JsonSubExpr(..)
  , KeyValuePair(..)
  , KeyValuePairs(..)
  , PartialHeaderMatcher(..)
  , Payload(..)
  , Query(..)
  , QueryError(..)
  , SingleQueryText
  , StatusCodeMatcher(..)
  , TLSCheckType(..)

  , isFailing
  , isPassing
  , logger
  , unsafeLogger

  ) where

import           Data.Aeson
import           Data.Aeson.Types
import           Data.Maybe
import qualified Data.Text                                   as T
import qualified Data.Vector                                 as V
import           GHC.Generics
import           Testing.CurlRunnings.Internal
import qualified Testing.CurlRunnings.Internal.Aeson         as A
import           Testing.CurlRunnings.Internal.Headers
import           Testing.CurlRunnings.Internal.KeyValuePairs
import           Testing.CurlRunnings.Internal.Payload
import           Text.Printf

-- | A basic enum for supported HTTP verbs
data HttpMethod
  = GET
  | POST
  | PUT
  | PATCH
  | DELETE
  deriving (Int -> HttpMethod -> ShowS
[HttpMethod] -> ShowS
HttpMethod -> String
(Int -> HttpMethod -> ShowS)
-> (HttpMethod -> String)
-> ([HttpMethod] -> ShowS)
-> Show HttpMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HttpMethod] -> ShowS
$cshowList :: [HttpMethod] -> ShowS
show :: HttpMethod -> String
$cshow :: HttpMethod -> String
showsPrec :: Int -> HttpMethod -> ShowS
$cshowsPrec :: Int -> HttpMethod -> ShowS
Show, (forall x. HttpMethod -> Rep HttpMethod x)
-> (forall x. Rep HttpMethod x -> HttpMethod) -> Generic HttpMethod
forall x. Rep HttpMethod x -> HttpMethod
forall x. HttpMethod -> Rep HttpMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HttpMethod x -> HttpMethod
$cfrom :: forall x. HttpMethod -> Rep HttpMethod x
Generic)

instance FromJSON HttpMethod

instance ToJSON HttpMethod

-- | A predicate to apply to the json body from the response
data JsonMatcher
  -- | Performs `==`
  = Exactly Value
  -- | A list of matchers to make assertions that contains values exist in the response
  | Contains [JsonSubExpr]
  -- | A list of matchers to make assertions that contains values do not exist in the response
  | NotContains [JsonSubExpr]
  -- | We're specifiying both Contains and NotContains matchers
  | MixedContains [JsonMatcher]
  deriving (Int -> JsonMatcher -> ShowS
[JsonMatcher] -> ShowS
JsonMatcher -> String
(Int -> JsonMatcher -> ShowS)
-> (JsonMatcher -> String)
-> ([JsonMatcher] -> ShowS)
-> Show JsonMatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonMatcher] -> ShowS
$cshowList :: [JsonMatcher] -> ShowS
show :: JsonMatcher -> String
$cshow :: JsonMatcher -> String
showsPrec :: Int -> JsonMatcher -> ShowS
$cshowsPrec :: Int -> JsonMatcher -> ShowS
Show, (forall x. JsonMatcher -> Rep JsonMatcher x)
-> (forall x. Rep JsonMatcher x -> JsonMatcher)
-> Generic JsonMatcher
forall x. Rep JsonMatcher x -> JsonMatcher
forall x. JsonMatcher -> Rep JsonMatcher x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonMatcher x -> JsonMatcher
$cfrom :: forall x. JsonMatcher -> Rep JsonMatcher x
Generic)

instance ToJSON JsonMatcher

instance FromJSON JsonMatcher where
  parseJSON :: Value -> Parser JsonMatcher
parseJSON (Object Object
v)
    | KeyType -> Object -> Bool
justAndNotEmpty KeyType
"exactly" Object
v = Value -> JsonMatcher
Exactly (Value -> JsonMatcher) -> Parser Value -> Parser JsonMatcher
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> KeyType -> Parser Value
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"exactly"
    | KeyType -> Object -> Bool
justAndNotEmpty KeyType
"contains" Object
v Bool -> Bool -> Bool
&& KeyType -> Object -> Bool
justAndNotEmpty KeyType
"notContains" Object
v = do
      JsonMatcher
c <- [JsonSubExpr] -> JsonMatcher
Contains ([JsonSubExpr] -> JsonMatcher)
-> Parser [JsonSubExpr] -> Parser JsonMatcher
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> KeyType -> Parser [JsonSubExpr]
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"contains"
      JsonMatcher
n <- [JsonSubExpr] -> JsonMatcher
NotContains ([JsonSubExpr] -> JsonMatcher)
-> Parser [JsonSubExpr] -> Parser JsonMatcher
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> KeyType -> Parser [JsonSubExpr]
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"notContains"
      JsonMatcher -> Parser JsonMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (JsonMatcher -> Parser JsonMatcher)
-> JsonMatcher -> Parser JsonMatcher
forall a b. (a -> b) -> a -> b
$ [JsonMatcher] -> JsonMatcher
MixedContains [JsonMatcher
c, JsonMatcher
n]
    | KeyType -> Object -> Bool
justAndNotEmpty KeyType
"contains" Object
v = [JsonSubExpr] -> JsonMatcher
Contains ([JsonSubExpr] -> JsonMatcher)
-> Parser [JsonSubExpr] -> Parser JsonMatcher
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> KeyType -> Parser [JsonSubExpr]
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"contains"
    | KeyType -> Object -> Bool
justAndNotEmpty KeyType
"notContains" Object
v = [JsonSubExpr] -> JsonMatcher
NotContains ([JsonSubExpr] -> JsonMatcher)
-> Parser [JsonSubExpr] -> Parser JsonMatcher
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> KeyType -> Parser [JsonSubExpr]
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"notContains"
  parseJSON Value
invalid = String -> Value -> Parser JsonMatcher
forall a. String -> Value -> Parser a
typeMismatch String
"JsonMatcher" Value
invalid

justAndNotEmpty :: A.KeyType -> A.MapType Value -> Bool
justAndNotEmpty :: KeyType -> Object -> Bool
justAndNotEmpty KeyType
key Object
obj =
  Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (KeyType -> Object -> Maybe Value
forall v. KeyType -> KeyMap v -> Maybe v
A.lookup KeyType
key Object
obj) Bool -> Bool -> Bool
&& KeyType -> Object -> Maybe Value
forall v. KeyType -> KeyMap v -> Maybe v
A.lookup KeyType
key Object
obj Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Null

-- | Simple predicate to check value constructor type
isContains :: JsonMatcher -> Bool
isContains :: JsonMatcher -> Bool
isContains (Contains [JsonSubExpr]
_) = Bool
True
isContains JsonMatcher
_            = Bool
False

-- | Simple predicate to check value constructor type
isNotContains :: JsonMatcher -> Bool
isNotContains :: JsonMatcher -> Bool
isNotContains (NotContains [JsonSubExpr]
_) = Bool
True
isNotContains JsonMatcher
_               = Bool
False

-- | Specify a key, value, or both to match against in the returned headers of a
-- response.
data PartialHeaderMatcher =
  PartialHeaderMatcher (Maybe T.Text)
                       (Maybe T.Text)
  deriving (Int -> PartialHeaderMatcher -> ShowS
[PartialHeaderMatcher] -> ShowS
PartialHeaderMatcher -> String
(Int -> PartialHeaderMatcher -> ShowS)
-> (PartialHeaderMatcher -> String)
-> ([PartialHeaderMatcher] -> ShowS)
-> Show PartialHeaderMatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialHeaderMatcher] -> ShowS
$cshowList :: [PartialHeaderMatcher] -> ShowS
show :: PartialHeaderMatcher -> String
$cshow :: PartialHeaderMatcher -> String
showsPrec :: Int -> PartialHeaderMatcher -> ShowS
$cshowsPrec :: Int -> PartialHeaderMatcher -> ShowS
Show, (forall x. PartialHeaderMatcher -> Rep PartialHeaderMatcher x)
-> (forall x. Rep PartialHeaderMatcher x -> PartialHeaderMatcher)
-> Generic PartialHeaderMatcher
forall x. Rep PartialHeaderMatcher x -> PartialHeaderMatcher
forall x. PartialHeaderMatcher -> Rep PartialHeaderMatcher x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PartialHeaderMatcher x -> PartialHeaderMatcher
$cfrom :: forall x. PartialHeaderMatcher -> Rep PartialHeaderMatcher x
Generic)
instance ToJSON PartialHeaderMatcher

-- | Collection of matchers to run against a single curl response
data HeaderMatcher =
  HeaderMatcher [PartialHeaderMatcher]
  deriving (Int -> HeaderMatcher -> ShowS
[HeaderMatcher] -> ShowS
HeaderMatcher -> String
(Int -> HeaderMatcher -> ShowS)
-> (HeaderMatcher -> String)
-> ([HeaderMatcher] -> ShowS)
-> Show HeaderMatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderMatcher] -> ShowS
$cshowList :: [HeaderMatcher] -> ShowS
show :: HeaderMatcher -> String
$cshow :: HeaderMatcher -> String
showsPrec :: Int -> HeaderMatcher -> ShowS
$cshowsPrec :: Int -> HeaderMatcher -> ShowS
Show, (forall x. HeaderMatcher -> Rep HeaderMatcher x)
-> (forall x. Rep HeaderMatcher x -> HeaderMatcher)
-> Generic HeaderMatcher
forall x. Rep HeaderMatcher x -> HeaderMatcher
forall x. HeaderMatcher -> Rep HeaderMatcher x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HeaderMatcher x -> HeaderMatcher
$cfrom :: forall x. HeaderMatcher -> Rep HeaderMatcher x
Generic)

instance ToJSON HeaderMatcher

-- | Different errors relating to querying json from previous test cases
data QueryError
  -- | The query was malformed and couldn't be parsed
  = QueryParseError T.Text
                    T.Text
  -- | The retrieved a value of the wrong type or was otherwise operating on the
  -- wrong type of thing
  | QueryTypeMismatch T.Text
                      Value
  -- | The query was parse-able
  | QueryValidationError T.Text
  -- | Tried to access a value in a null object.
  | NullPointer T.Text -- full query
                T.Text -- message
                deriving ((forall x. QueryError -> Rep QueryError x)
-> (forall x. Rep QueryError x -> QueryError) -> Generic QueryError
forall x. Rep QueryError x -> QueryError
forall x. QueryError -> Rep QueryError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryError x -> QueryError
$cfrom :: forall x. QueryError -> Rep QueryError x
Generic)

instance Show QueryError where
  show :: QueryError -> String
show (QueryParseError Text
t Text
q) = String -> Text -> ShowS
forall r. PrintfType r => String -> r
printf String
"error parsing query %s: %s" Text
q ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
  show (NullPointer Text
full Text
part) = String -> String -> ShowS
forall r. PrintfType r => String -> r
printf String
"null pointer in %s at %s" (Text -> String
T.unpack Text
full) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
part
  show (QueryTypeMismatch Text
message Value
val) = String -> Text -> ShowS
forall r. PrintfType r => String -> r
printf String
"type error: %s %s" Text
message ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Value -> String
forall a. Show a => a -> String
show Value
val
  show (QueryValidationError Text
message) = String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"invalid query: %s" Text
message

instance ToJSON QueryError

instance FromJSON HeaderMatcher where
  parseJSON :: Value -> Parser HeaderMatcher
parseJSON o :: Value
o@(String Text
v) =
    (Text -> Parser HeaderMatcher)
-> (Headers -> Parser HeaderMatcher)
-> Either Text Headers
-> Parser HeaderMatcher
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      (\Text
s -> String -> Value -> Parser HeaderMatcher
forall a. String -> Value -> Parser a
typeMismatch (String
"HeaderMatcher: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
s) Value
o)
      (\(HeaderSet [Header]
parsed) ->
         HeaderMatcher -> Parser HeaderMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (HeaderMatcher -> Parser HeaderMatcher)
-> ([PartialHeaderMatcher] -> HeaderMatcher)
-> [PartialHeaderMatcher]
-> Parser HeaderMatcher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PartialHeaderMatcher] -> HeaderMatcher
HeaderMatcher ([PartialHeaderMatcher] -> Parser HeaderMatcher)
-> [PartialHeaderMatcher] -> Parser HeaderMatcher
forall a b. (a -> b) -> a -> b
$
         (Header -> PartialHeaderMatcher)
-> [Header] -> [PartialHeaderMatcher]
forall a b. (a -> b) -> [a] -> [b]
map
           (\(Header Text
key Text
val) -> Maybe Text -> Maybe Text -> PartialHeaderMatcher
PartialHeaderMatcher (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val))
           [Header]
parsed)
      (Text -> Either Text Headers
parseHeaders Text
v)
  parseJSON (Object Object
v) = do
    PartialHeaderMatcher
partial <- Maybe Text -> Maybe Text -> PartialHeaderMatcher
PartialHeaderMatcher (Maybe Text -> Maybe Text -> PartialHeaderMatcher)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> PartialHeaderMatcher)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> KeyType -> Parser (Maybe Text)
forall a. FromJSON a => Object -> KeyType -> Parser (Maybe a)
.:? KeyType
"key" Parser (Maybe Text -> PartialHeaderMatcher)
-> Parser (Maybe Text) -> Parser PartialHeaderMatcher
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> KeyType -> Parser (Maybe Text)
forall a. FromJSON a => Object -> KeyType -> Parser (Maybe a)
.:? KeyType
"value"
    HeaderMatcher -> Parser HeaderMatcher
forall (m :: * -> *) a. Monad m => a -> m a
return (HeaderMatcher -> Parser HeaderMatcher)
-> HeaderMatcher -> Parser HeaderMatcher
forall a b. (a -> b) -> a -> b
$ [PartialHeaderMatcher] -> HeaderMatcher
HeaderMatcher [PartialHeaderMatcher
partial]
  parseJSON (Array Array
v) = [Parser HeaderMatcher] -> Parser HeaderMatcher
forall a. Monoid a => [a] -> a
mconcat ([Parser HeaderMatcher] -> Parser HeaderMatcher)
-> (Vector (Parser HeaderMatcher) -> [Parser HeaderMatcher])
-> Vector (Parser HeaderMatcher)
-> Parser HeaderMatcher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Parser HeaderMatcher) -> [Parser HeaderMatcher]
forall a. Vector a -> [a]
V.toList (Vector (Parser HeaderMatcher) -> Parser HeaderMatcher)
-> Vector (Parser HeaderMatcher) -> Parser HeaderMatcher
forall a b. (a -> b) -> a -> b
$ (Value -> Parser HeaderMatcher)
-> Array -> Vector (Parser HeaderMatcher)
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Parser HeaderMatcher
forall a. FromJSON a => Value -> Parser a
parseJSON Array
v
  parseJSON Value
invalid = String -> Value -> Parser HeaderMatcher
forall a. String -> Value -> Parser a
typeMismatch String
"HeaderMatcher" Value
invalid

-- | A matcher for a subvalue of a json payload
data JsonSubExpr
  -- | Assert some value anywhere in the json has a value equal to a given
  --  value. The motivation for this field is largely for checking contents of a
  --  top level array. It's also useful if you don't know the key ahead of time.
  = ValueMatch Value
  -- | Assert a key exists anywhere in the json
  | KeyMatch T.Text
  -- | Assert the key value pair can be found somewhere the json.
  | KeyValueMatch { JsonSubExpr -> Text
matchKey   :: T.Text
                  , JsonSubExpr -> Value
matchValue :: Value }
  deriving (Int -> JsonSubExpr -> ShowS
[JsonSubExpr] -> ShowS
JsonSubExpr -> String
(Int -> JsonSubExpr -> ShowS)
-> (JsonSubExpr -> String)
-> ([JsonSubExpr] -> ShowS)
-> Show JsonSubExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonSubExpr] -> ShowS
$cshowList :: [JsonSubExpr] -> ShowS
show :: JsonSubExpr -> String
$cshow :: JsonSubExpr -> String
showsPrec :: Int -> JsonSubExpr -> ShowS
$cshowsPrec :: Int -> JsonSubExpr -> ShowS
Show, (forall x. JsonSubExpr -> Rep JsonSubExpr x)
-> (forall x. Rep JsonSubExpr x -> JsonSubExpr)
-> Generic JsonSubExpr
forall x. Rep JsonSubExpr x -> JsonSubExpr
forall x. JsonSubExpr -> Rep JsonSubExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonSubExpr x -> JsonSubExpr
$cfrom :: forall x. JsonSubExpr -> Rep JsonSubExpr x
Generic)

instance FromJSON JsonSubExpr where
  parseJSON :: Value -> Parser JsonSubExpr
parseJSON (Object Object
v)
    | KeyType -> Object -> Bool
justAndNotEmpty KeyType
"keyValueMatch" Object
v =
      let toParse :: Value
toParse = Maybe Value -> Value
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ KeyType -> Object -> Maybe Value
forall v. KeyType -> KeyMap v -> Maybe v
A.lookup KeyType
"keyValueMatch" Object
v
      in case Value
toParse of
           Object Object
o -> Text -> Value -> JsonSubExpr
KeyValueMatch (Text -> Value -> JsonSubExpr)
-> Parser Text -> Parser (Value -> JsonSubExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> KeyType -> Parser Text
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"key" Parser (Value -> JsonSubExpr) -> Parser Value -> Parser JsonSubExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> KeyType -> Parser Value
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"value"
           Value
_        -> String -> Value -> Parser JsonSubExpr
forall a. String -> Value -> Parser a
typeMismatch String
"JsonSubExpr" Value
toParse
    | KeyType -> Object -> Bool
justAndNotEmpty KeyType
"keyMatch" Object
v =
      let toParse :: Value
toParse = Maybe Value -> Value
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ KeyType -> Object -> Maybe Value
forall v. KeyType -> KeyMap v -> Maybe v
A.lookup KeyType
"keyMatch" Object
v
      in case Value
toParse of
           String Text
s -> JsonSubExpr -> Parser JsonSubExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (JsonSubExpr -> Parser JsonSubExpr)
-> JsonSubExpr -> Parser JsonSubExpr
forall a b. (a -> b) -> a -> b
$ Text -> JsonSubExpr
KeyMatch Text
s
           Value
_        -> String -> Value -> Parser JsonSubExpr
forall a. String -> Value -> Parser a
typeMismatch String
"JsonSubExpr" Value
toParse
    | KeyType -> Object -> Bool
justAndNotEmpty KeyType
"valueMatch" Object
v = Value -> JsonSubExpr
ValueMatch (Value -> JsonSubExpr) -> Parser Value -> Parser JsonSubExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> KeyType -> Parser Value
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"valueMatch"
  parseJSON Value
invalid = String -> Value -> Parser JsonSubExpr
forall a. String -> Value -> Parser a
typeMismatch String
"JsonSubExpr" Value
invalid

instance ToJSON JsonSubExpr

-- | Check the status code of a response. You can specify one or many valid codes.
data StatusCodeMatcher
  = ExactCode Int
  | AnyCodeIn [Int]
  deriving (Int -> StatusCodeMatcher -> ShowS
[StatusCodeMatcher] -> ShowS
StatusCodeMatcher -> String
(Int -> StatusCodeMatcher -> ShowS)
-> (StatusCodeMatcher -> String)
-> ([StatusCodeMatcher] -> ShowS)
-> Show StatusCodeMatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StatusCodeMatcher] -> ShowS
$cshowList :: [StatusCodeMatcher] -> ShowS
show :: StatusCodeMatcher -> String
$cshow :: StatusCodeMatcher -> String
showsPrec :: Int -> StatusCodeMatcher -> ShowS
$cshowsPrec :: Int -> StatusCodeMatcher -> ShowS
Show, (forall x. StatusCodeMatcher -> Rep StatusCodeMatcher x)
-> (forall x. Rep StatusCodeMatcher x -> StatusCodeMatcher)
-> Generic StatusCodeMatcher
forall x. Rep StatusCodeMatcher x -> StatusCodeMatcher
forall x. StatusCodeMatcher -> Rep StatusCodeMatcher x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StatusCodeMatcher x -> StatusCodeMatcher
$cfrom :: forall x. StatusCodeMatcher -> Rep StatusCodeMatcher x
Generic)

instance ToJSON StatusCodeMatcher

instance FromJSON StatusCodeMatcher where
  parseJSON :: Value -> Parser StatusCodeMatcher
parseJSON obj :: Value
obj@(Number Scientific
_) = Int -> StatusCodeMatcher
ExactCode (Int -> StatusCodeMatcher)
-> Parser Int -> Parser StatusCodeMatcher
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
  parseJSON obj :: Value
obj@(Array Array
_)  = [Int] -> StatusCodeMatcher
AnyCodeIn ([Int] -> StatusCodeMatcher)
-> Parser [Int] -> Parser StatusCodeMatcher
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Int]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
obj
  parseJSON Value
invalid        = String -> Value -> Parser StatusCodeMatcher
forall a. String -> Value -> Parser a
typeMismatch String
"StatusCodeMatcher" Value
invalid

data Authentication =
  BasicAuthentication T.Text T.Text
  deriving (Int -> Authentication -> ShowS
[Authentication] -> ShowS
Authentication -> String
(Int -> Authentication -> ShowS)
-> (Authentication -> String)
-> ([Authentication] -> ShowS)
-> Show Authentication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Authentication] -> ShowS
$cshowList :: [Authentication] -> ShowS
show :: Authentication -> String
$cshow :: Authentication -> String
showsPrec :: Int -> Authentication -> ShowS
$cshowsPrec :: Int -> Authentication -> ShowS
Show, (forall x. Authentication -> Rep Authentication x)
-> (forall x. Rep Authentication x -> Authentication)
-> Generic Authentication
forall x. Rep Authentication x -> Authentication
forall x. Authentication -> Rep Authentication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Authentication x -> Authentication
$cfrom :: forall x. Authentication -> Rep Authentication x
Generic)

instance FromJSON Authentication where
  parseJSON :: Value -> Parser Authentication
parseJSON (Object Object
o) = Text -> Text -> Authentication
BasicAuthentication (Text -> Text -> Authentication)
-> Parser Text -> Parser (Text -> Authentication)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> KeyType -> Parser Object
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"basic" Parser Object -> (Object -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> KeyType -> Parser Text
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"username")) Parser (Text -> Authentication)
-> Parser Text -> Parser Authentication
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> KeyType -> Parser Object
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"basic" Parser Object -> (Object -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Object -> KeyType -> Parser Text
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"password"))
  parseJSON Value
invalid    = String -> Value -> Parser Authentication
forall a. String -> Value -> Parser a
typeMismatch String
"Authentication" Value
invalid
instance ToJSON Authentication

-- | A single curl test case, the basic foundation of a curl-runnings test.
data CurlCase = CurlCase
  { CurlCase -> Text
name             :: T.Text -- ^ The name of the test case
  , CurlCase -> Text
url              :: T.Text -- ^ The target url to test
  , CurlCase -> HttpMethod
requestMethod    :: HttpMethod -- ^ Verb to use for the request
  , CurlCase -> Maybe Payload
requestData      :: Maybe Payload -- ^ Payload to send with the request, if any
  , CurlCase -> Maybe KeyValuePairs
queryParameters  :: Maybe KeyValuePairs -- ^ Query parameters to set in the request, if any
  , CurlCase -> Maybe Headers
headers          :: Maybe Headers -- ^ Headers to send with the request, if any
  , CurlCase -> Maybe Authentication
auth             :: Maybe Authentication -- ^ Authentication to add to the request, if any
  , CurlCase -> Maybe JsonMatcher
expectData       :: Maybe JsonMatcher -- ^ The assertions to make on the response payload, if any
  , CurlCase -> StatusCodeMatcher
expectStatus     :: StatusCodeMatcher -- ^ Assertion about the status code returned by the target
  , CurlCase -> Maybe HeaderMatcher
expectHeaders    :: Maybe HeaderMatcher -- ^ Assertions to make about the response headers, if any
  , CurlCase -> Maybe Int
allowedRedirects :: Maybe Int -- ^ Number of redirects to follow. Defaults to 10
  } deriving (Int -> CurlCase -> ShowS
[CurlCase] -> ShowS
CurlCase -> String
(Int -> CurlCase -> ShowS)
-> (CurlCase -> String) -> ([CurlCase] -> ShowS) -> Show CurlCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurlCase] -> ShowS
$cshowList :: [CurlCase] -> ShowS
show :: CurlCase -> String
$cshow :: CurlCase -> String
showsPrec :: Int -> CurlCase -> ShowS
$cshowsPrec :: Int -> CurlCase -> ShowS
Show, (forall x. CurlCase -> Rep CurlCase x)
-> (forall x. Rep CurlCase x -> CurlCase) -> Generic CurlCase
forall x. Rep CurlCase x -> CurlCase
forall x. CurlCase -> Rep CurlCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CurlCase x -> CurlCase
$cfrom :: forall x. CurlCase -> Rep CurlCase x
Generic)

instance FromJSON CurlCase

instance ToJSON CurlCase

-- | Represents the different type of test failures we can have. A single test case
-- | might return many assertion failures.
data AssertionFailure
  -- | The json we got back was wrong. We include this redundant field (it's
  -- included in the CurlCase field above) in order to enforce at the type
  -- level that we have to be expecting some data in order to have this type of
  -- failure.
  = DataFailure CurlCase
                JsonMatcher
                (Maybe Value)
  -- | The status code we got back was wrong
  | StatusFailure CurlCase
                  Int
  -- | The headers we got back were wrong
  | HeaderFailure CurlCase
                  HeaderMatcher
                  Headers
  -- | Something went wrong with a test case json query
  | QueryFailure CurlCase
                 QueryError
  -- | Something else
  | UnexpectedFailure deriving ((forall x. AssertionFailure -> Rep AssertionFailure x)
-> (forall x. Rep AssertionFailure x -> AssertionFailure)
-> Generic AssertionFailure
forall x. Rep AssertionFailure x -> AssertionFailure
forall x. AssertionFailure -> Rep AssertionFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssertionFailure x -> AssertionFailure
$cfrom :: forall x. AssertionFailure -> Rep AssertionFailure x
Generic)

instance ToJSON AssertionFailure

colorizeExpects :: String -> String
colorizeExpects :: ShowS
colorizeExpects String
t =
  let expectedColor :: Text
expectedColor = Text -> Text
makeRed Text
"Expected:"
      actualColor :: Text
actualColor = Text -> Text
makeRed Text
"Actual:"
      replacedExpected :: Text
replacedExpected = Text -> Text -> Text -> Text
T.replace Text
"Expected:" Text
expectedColor (String -> Text
T.pack String
t)
  in Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
T.replace Text
"Actual:" Text
actualColor Text
replacedExpected

instance Show AssertionFailure where
  show :: AssertionFailure -> String
show (StatusFailure CurlCase
c Int
receivedCode) =
    case CurlCase -> StatusCodeMatcher
expectStatus CurlCase
c of
      ExactCode Int
code ->
        ShowS
colorizeExpects ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> Text -> Text -> String -> ShowS
forall r. PrintfType r => String -> r
printf
          String
"[%s] Incorrect status code from %s. Expected: %s. Actual: %s"
          (CurlCase -> Text
name CurlCase
c)
          (CurlCase -> Text
url CurlCase
c)
          (Int -> String
forall a. Show a => a -> String
show Int
code)
          (Int -> String
forall a. Show a => a -> String
show Int
receivedCode)
      AnyCodeIn [Int]
codes ->
        ShowS
colorizeExpects ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> Text -> Text -> String -> ShowS
forall r. PrintfType r => String -> r
printf
          String
"[%s] Incorrect status code from %s. Expected: %s. Actual: %s"
          (CurlCase -> Text
name CurlCase
c)
          (CurlCase -> Text
url CurlCase
c)
          ([Int] -> String
forall a. Show a => a -> String
show [Int]
codes)
          (Int -> String
forall a. Show a => a -> String
show Int
receivedCode)
  show (DataFailure CurlCase
curlCase JsonMatcher
expected Maybe Value
receivedVal) =
    case JsonMatcher
expected of
      Exactly Value
expectedVal ->
        ShowS
colorizeExpects ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> Text -> Text -> String -> ShowS
forall r. PrintfType r => String -> r
printf
          String
"[%s] JSON response from %s didn't match spec. Expected: %s. Actual: %s"
          (CurlCase -> Text
name CurlCase
curlCase)
          (CurlCase -> Text
url CurlCase
curlCase)
          (Text -> String
T.unpack (Value -> Text
forall a. Show a => a -> Text
pShow Value
expectedVal))
          (Text -> String
T.unpack (Maybe Value -> Text
forall a. Show a => a -> Text
pShow Maybe Value
receivedVal))
      (Contains [JsonSubExpr]
expectedVals) ->
        ShowS
colorizeExpects ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> Text -> Text -> String -> ShowS
forall r. PrintfType r => String -> r
printf
          String
"[%s] JSON response from %s didn't contain the matcher. Expected: %s to each be subvalues in: %s"
          (CurlCase -> Text
name CurlCase
curlCase)
          (CurlCase -> Text
url CurlCase
curlCase)
          (Text -> String
T.unpack ([JsonSubExpr] -> Text
forall a. Show a => a -> Text
pShow [JsonSubExpr]
expectedVals))
          (Text -> String
T.unpack (Maybe Value -> Text
forall a. Show a => a -> Text
pShow Maybe Value
receivedVal))
      (NotContains [JsonSubExpr]
expectedVals) ->
        ShowS
colorizeExpects ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> Text -> Text -> String -> ShowS
forall r. PrintfType r => String -> r
printf
          String
"[%s] JSON response from %s did contain the matcher. Expected: %s not to be subvalues in: %s"
          (CurlCase -> Text
name CurlCase
curlCase)
          (CurlCase -> Text
url CurlCase
curlCase)
          (Text -> String
T.unpack ([JsonSubExpr] -> Text
forall a. Show a => a -> Text
pShow [JsonSubExpr]
expectedVals))
          (Text -> String
T.unpack (Maybe Value -> Text
forall a. Show a => a -> Text
pShow Maybe Value
receivedVal))
      (MixedContains [JsonMatcher]
expectedVals) ->
        ShowS
colorizeExpects ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        String -> Text -> Text -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf
          String
"[%s] JSON response from %s didn't satisfy the matcher. Expected: %s to each be subvalues and %s not to be subvalues in: %s"
          (CurlCase -> Text
name CurlCase
curlCase)
          (CurlCase -> Text
url CurlCase
curlCase)
          (Text -> String
T.unpack ([JsonMatcher] -> Text
forall a. Show a => a -> Text
pShow ((JsonMatcher -> Bool) -> [JsonMatcher] -> [JsonMatcher]
forall a. (a -> Bool) -> [a] -> [a]
filter JsonMatcher -> Bool
isContains [JsonMatcher]
expectedVals)))
          (Text -> String
T.unpack ([JsonMatcher] -> Text
forall a. Show a => a -> Text
pShow ((JsonMatcher -> Bool) -> [JsonMatcher] -> [JsonMatcher]
forall a. (a -> Bool) -> [a] -> [a]
filter JsonMatcher -> Bool
isNotContains [JsonMatcher]
expectedVals)))
          (Text -> String
T.unpack (Maybe Value -> Text
forall a. Show a => a -> Text
pShow Maybe Value
receivedVal))
  show (HeaderFailure CurlCase
curlCase HeaderMatcher
expected Headers
receivedHeaders) =
    ShowS
colorizeExpects ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> Text -> Text -> String -> ShowS
forall r. PrintfType r => String -> r
printf
      String
"[%s] Headers from %s didn't contain expected headers. Expected: %s. Actual: %s"
      (CurlCase -> Text
name CurlCase
curlCase)
      (CurlCase -> Text
url CurlCase
curlCase)
      (HeaderMatcher -> String
forall a. Show a => a -> String
show HeaderMatcher
expected)
      (Headers -> String
forall a. Show a => a -> String
show Headers
receivedHeaders)
  show (QueryFailure CurlCase
curlCase QueryError
queryErr) =
    ShowS
colorizeExpects ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> Text -> ShowS
forall r. PrintfType r => String -> r
printf String
"JSON query error in spec %s: %s" (CurlCase -> Text
name CurlCase
curlCase) (QueryError -> String
forall a. Show a => a -> String
show QueryError
queryErr)
  show AssertionFailure
UnexpectedFailure = String
"Unexpected Error D:"

-- | A type representing the result of a single curl, and all associated
-- assertions
data CaseResult
  = CasePass
      { CaseResult -> CurlCase
curlCase            :: CurlCase
      , CaseResult -> Maybe Headers
caseResponseHeaders :: Maybe Headers
      , CaseResult -> Maybe Value
caseResponseValue   :: Maybe Value
      , CaseResult -> Integer
elapsedTime         :: Integer -- ^ Elapsed time
      }
  | CaseFail
      { curlCase            :: CurlCase
      , caseResponseHeaders :: Maybe Headers
      , caseResponseValue   :: Maybe Value
      , CaseResult -> [AssertionFailure]
failures            :: [AssertionFailure]
      , elapsedTime         :: Integer -- ^ Elapsed time
      } deriving ((forall x. CaseResult -> Rep CaseResult x)
-> (forall x. Rep CaseResult x -> CaseResult) -> Generic CaseResult
forall x. Rep CaseResult x -> CaseResult
forall x. CaseResult -> Rep CaseResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CaseResult x -> CaseResult
$cfrom :: forall x. CaseResult -> Rep CaseResult x
Generic)

instance Show CaseResult where
  show :: CaseResult -> String
show CasePass{CurlCase
curlCase :: CurlCase
curlCase :: CaseResult -> CurlCase
curlCase, Integer
elapsedTime :: Integer
elapsedTime :: CaseResult -> Integer
elapsedTime} = Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
makeGreen (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"[PASS] " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%s (%0.2f seconds)" (CurlCase -> Text
name CurlCase
curlCase) (Integer -> Double
millisToS Integer
elapsedTime))
  show CaseFail{CurlCase
curlCase :: CurlCase
curlCase :: CaseResult -> CurlCase
curlCase, [AssertionFailure]
failures :: [AssertionFailure]
failures :: CaseResult -> [AssertionFailure]
failures, Integer
elapsedTime :: Integer
elapsedTime :: CaseResult -> Integer
elapsedTime} =
    Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
makeRed Text
"[FAIL] " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    CurlCase -> Text
name CurlCase
curlCase Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Double -> String
forall r. PrintfType r => String -> r
printf String
" (%0.2f seconds) " (Integer -> Double
millisToS Integer
elapsedTime)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ((AssertionFailure -> Text) -> [AssertionFailure] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((\Text
s -> Text
"\nAssertion failed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s) (Text -> Text)
-> (AssertionFailure -> Text) -> AssertionFailure -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") (Text -> Text)
-> (AssertionFailure -> Text) -> AssertionFailure -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Text
T.pack (String -> Text)
-> (AssertionFailure -> String) -> AssertionFailure -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssertionFailure -> String
forall a. Show a => a -> String
show)) [AssertionFailure]
failures)

instance ToJSON CaseResult where
  toJSON :: CaseResult -> Value
toJSON CasePass {CurlCase
curlCase :: CurlCase
curlCase :: CaseResult -> CurlCase
curlCase, Maybe Headers
caseResponseHeaders :: Maybe Headers
caseResponseHeaders :: CaseResult -> Maybe Headers
caseResponseHeaders, Maybe Value
caseResponseValue :: Maybe Value
caseResponseValue :: CaseResult -> Maybe Value
caseResponseValue, Integer
elapsedTime :: Integer
elapsedTime :: CaseResult -> Integer
elapsedTime} =
    [Pair] -> Value
object
      [ KeyType
"testPassed" KeyType -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= (Bool -> Value
Bool Bool
True)
      , KeyType
"case" KeyType -> CurlCase -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= CurlCase
curlCase
      , KeyType
"responseHeaders" KeyType -> Maybe Headers -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= Maybe Headers
caseResponseHeaders
      , KeyType
"responseValue" KeyType -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= Maybe Value
caseResponseValue
      , KeyType
"elapsedTimeSeconds" KeyType -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= Integer -> Double
millisToS Integer
elapsedTime
      ]
  toJSON CaseFail {CurlCase
curlCase :: CurlCase
curlCase :: CaseResult -> CurlCase
curlCase, Maybe Headers
caseResponseHeaders :: Maybe Headers
caseResponseHeaders :: CaseResult -> Maybe Headers
caseResponseHeaders, Maybe Value
caseResponseValue :: Maybe Value
caseResponseValue :: CaseResult -> Maybe Value
caseResponseValue, Integer
elapsedTime :: Integer
elapsedTime :: CaseResult -> Integer
elapsedTime, [AssertionFailure]
failures :: [AssertionFailure]
failures :: CaseResult -> [AssertionFailure]
failures} =
    [Pair] -> Value
object
      [ KeyType
"testPassed" KeyType -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= (Bool -> Value
Bool Bool
False)
      , KeyType
"case" KeyType -> CurlCase -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= CurlCase
curlCase
      , KeyType
"responseHeaders" KeyType -> Maybe Headers -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= Maybe Headers
caseResponseHeaders
      , KeyType
"responseValue" KeyType -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= Maybe Value
caseResponseValue
      , KeyType
"elapsedTimeSeconds" KeyType -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= Integer -> Double
millisToS Integer
elapsedTime
      , KeyType
"failures" KeyType -> [AssertionFailure] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => KeyType -> v -> kv
.= [AssertionFailure]
failures
      ]

-- | A wrapper type around a set of test cases. This is the top level spec type
-- that we parse a test spec file into
data CurlSuite = CurlSuite
  { CurlSuite -> [CurlCase]
suiteCases      :: [CurlCase]
  , CurlSuite -> Maybe Text
suiteCaseFilter :: Maybe T.Text
  } deriving (Int -> CurlSuite -> ShowS
[CurlSuite] -> ShowS
CurlSuite -> String
(Int -> CurlSuite -> ShowS)
-> (CurlSuite -> String)
-> ([CurlSuite] -> ShowS)
-> Show CurlSuite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurlSuite] -> ShowS
$cshowList :: [CurlSuite] -> ShowS
show :: CurlSuite -> String
$cshow :: CurlSuite -> String
showsPrec :: Int -> CurlSuite -> ShowS
$cshowsPrec :: Int -> CurlSuite -> ShowS
Show, (forall x. CurlSuite -> Rep CurlSuite x)
-> (forall x. Rep CurlSuite x -> CurlSuite) -> Generic CurlSuite
forall x. Rep CurlSuite x -> CurlSuite
forall x. CurlSuite -> Rep CurlSuite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CurlSuite x -> CurlSuite
$cfrom :: forall x. CurlSuite -> Rep CurlSuite x
Generic)

noFilterSuite :: [CurlCase] -> CurlSuite
noFilterSuite :: [CurlCase] -> CurlSuite
noFilterSuite = ([CurlCase] -> Maybe Text -> CurlSuite)
-> Maybe Text -> [CurlCase] -> CurlSuite
forall a b c. (a -> b -> c) -> b -> a -> c
flip [CurlCase] -> Maybe Text -> CurlSuite
CurlSuite Maybe Text
forall a. Maybe a
Nothing

instance ToJSON CurlSuite

instance FromJSON CurlSuite where
  parseJSON :: Value -> Parser CurlSuite
parseJSON (Object Object
v)  = [CurlCase] -> CurlSuite
noFilterSuite ([CurlCase] -> CurlSuite) -> Parser [CurlCase] -> Parser CurlSuite
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> KeyType -> Parser [CurlCase]
forall a. FromJSON a => Object -> KeyType -> Parser a
.: KeyType
"cases"
  parseJSON a :: Value
a@(Array Array
_) = [CurlCase] -> CurlSuite
noFilterSuite ([CurlCase] -> CurlSuite) -> Parser [CurlCase] -> Parser CurlSuite
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [CurlCase]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
a
  parseJSON Value
invalid     = String -> Value -> Parser CurlSuite
forall a. String -> Value -> Parser a
typeMismatch String
"JsonMatcher" Value
invalid

-- | Simple predicate that checks if the result is passing
isPassing :: CaseResult -> Bool
isPassing :: CaseResult -> Bool
isPassing CasePass {} = Bool
True
isPassing CaseFail {} = Bool
False

-- | Simple predicate that checks if the result is failing
isFailing :: CaseResult -> Bool
isFailing :: CaseResult -> Bool
isFailing = Bool -> Bool
not (Bool -> Bool) -> (CaseResult -> Bool) -> CaseResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaseResult -> Bool
isPassing

-- | A map of the system environment
type Environment = A.MapType T.Text

data TLSCheckType = SkipTLSCheck | DoTLSCheck deriving (Int -> TLSCheckType -> ShowS
[TLSCheckType] -> ShowS
TLSCheckType -> String
(Int -> TLSCheckType -> ShowS)
-> (TLSCheckType -> String)
-> ([TLSCheckType] -> ShowS)
-> Show TLSCheckType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TLSCheckType] -> ShowS
$cshowList :: [TLSCheckType] -> ShowS
show :: TLSCheckType -> String
$cshow :: TLSCheckType -> String
showsPrec :: Int -> TLSCheckType -> ShowS
$cshowsPrec :: Int -> TLSCheckType -> ShowS
Show, TLSCheckType -> TLSCheckType -> Bool
(TLSCheckType -> TLSCheckType -> Bool)
-> (TLSCheckType -> TLSCheckType -> Bool) -> Eq TLSCheckType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TLSCheckType -> TLSCheckType -> Bool
$c/= :: TLSCheckType -> TLSCheckType -> Bool
== :: TLSCheckType -> TLSCheckType -> Bool
$c== :: TLSCheckType -> TLSCheckType -> Bool
Eq)

-- | The state of a suite. Tracks environment variables, and all the test results so far
data CurlRunningsState = CurlRunningsState Environment [CaseResult] LogLevel TLSCheckType

logger :: CurlRunningsState -> CurlRunningsLogger
logger :: CurlRunningsState -> CurlRunningsLogger
logger (CurlRunningsState Environment
_ [CaseResult]
_ LogLevel
l TLSCheckType
_) = LogLevel -> CurlRunningsLogger
makeLogger LogLevel
l

unsafeLogger :: Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a
unsafeLogger :: CurlRunningsState -> CurlRunningsUnsafeLogger a
unsafeLogger (CurlRunningsState Environment
_ [CaseResult]
_ LogLevel
l TLSCheckType
_) = LogLevel -> CurlRunningsUnsafeLogger a
forall a. Show a => LogLevel -> CurlRunningsUnsafeLogger a
makeUnsafeLogger LogLevel
l

-- | A single lookup operation in a json query
data Index
  -- | Drill into the json of a specific test case. The RESPONSES object is
  -- accessible as an array of values that have come back from previous test
  -- cases
  = CaseResultIndex Integer
  -- | A standard json key lookup.
  | KeyIndex T.Text
  -- | A standard json array index lookup.
  | ArrayIndex Integer
  deriving (Int -> Index -> ShowS
[Index] -> ShowS
Index -> String
(Int -> Index -> ShowS)
-> (Index -> String) -> ([Index] -> ShowS) -> Show Index
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Index] -> ShowS
$cshowList :: [Index] -> ShowS
show :: Index -> String
$cshow :: Index -> String
showsPrec :: Int -> Index -> ShowS
$cshowsPrec :: Int -> Index -> ShowS
Show)

-- | A single entity to be queries from a json value
data Query =
  -- | A single query contains a list of discrete index operations
  Query [Index] |
  -- | Lookup a string in the environment
  EnvironmentVariable T.Text
  deriving (Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> String
$cshow :: Query -> String
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Show)

-- | A distinct parsed unit in a query
data InterpolatedQuery
  -- | Regular text, no query
  = LiteralText T.Text
  -- | Some leading text, then a query
  | InterpolatedQuery T.Text
                      Query
  -- | Just a query, no leading text
  | NonInterpolatedQuery Query
  deriving (Int -> InterpolatedQuery -> ShowS
[InterpolatedQuery] -> ShowS
InterpolatedQuery -> String
(Int -> InterpolatedQuery -> ShowS)
-> (InterpolatedQuery -> String)
-> ([InterpolatedQuery] -> ShowS)
-> Show InterpolatedQuery
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InterpolatedQuery] -> ShowS
$cshowList :: [InterpolatedQuery] -> ShowS
show :: InterpolatedQuery -> String
$cshow :: InterpolatedQuery -> String
showsPrec :: Int -> InterpolatedQuery -> ShowS
$cshowsPrec :: Int -> InterpolatedQuery -> ShowS
Show)

-- | The full string in which a query appears, eg "prefix-${{RESPONSES[0].key.another_key[0].last_key}}"
type FullQueryText = T.Text
-- | The string for one query given the FullQueryText above, the single query text would be RESPONSES[0].key.another_key[0].last_key
type SingleQueryText = T.Text