{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Testing.CurlRunnings
( runCase
, runSuite
, decodeFile
) where
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Data.Aeson
import Data.Aeson.Types
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as B8S
import qualified Data.ByteString.Lazy as B
import qualified Data.CaseInsensitive as CI
import Data.Either
import Data.List (find)
import Data.Maybe
import Data.String (fromString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.IO as TIO
import qualified Data.Vector as V
import qualified Data.Yaml.Include as YI
import qualified Dhall
import qualified Dhall.Import
import qualified Dhall.JSON
import qualified Dhall.Parser
import qualified Dhall.TypeCheck
import Network.Connection (TLSSettings (..))
import Network.HTTP.Conduit
import Network.HTTP.Simple hiding (Header)
import qualified Network.HTTP.Simple as HTTP
import qualified Network.HTTP.Types as NT
import System.Directory
import System.Environment
import Testing.CurlRunnings.Internal
import qualified Testing.CurlRunnings.Internal.Aeson as A
import Testing.CurlRunnings.Internal.Parser
import Testing.CurlRunnings.Types
import Text.Printf
import Text.Regex.Posix
decodeFile :: FilePath -> IO (Either String CurlSuite)
decodeFile :: FilePath -> IO (Either FilePath CurlSuite)
decodeFile FilePath
specPath =
FilePath -> IO Bool
doesFileExist FilePath
specPath IO Bool
-> (Bool -> IO (Either FilePath CurlSuite))
-> IO (Either FilePath CurlSuite)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
exists ->
if Bool
exists
then case [Text] -> Text
forall a. [a] -> a
last ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"." (FilePath -> Text
T.pack FilePath
specPath) of
Text
"json" ->
ByteString -> Either FilePath CurlSuite
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode' (ByteString -> Either FilePath CurlSuite)
-> IO ByteString -> IO (Either FilePath CurlSuite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile FilePath
specPath :: IO (Either String CurlSuite)
Text
"yaml" -> (ParseException -> FilePath)
-> Either ParseException CurlSuite -> Either FilePath CurlSuite
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ParseException -> FilePath
forall a. Show a => a -> FilePath
show (Either ParseException CurlSuite -> Either FilePath CurlSuite)
-> IO (Either ParseException CurlSuite)
-> IO (Either FilePath CurlSuite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Either ParseException CurlSuite)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
YI.decodeFileEither FilePath
specPath
Text
"yml" -> (ParseException -> FilePath)
-> Either ParseException CurlSuite -> Either FilePath CurlSuite
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ParseException -> FilePath
forall a. Show a => a -> FilePath
show (Either ParseException CurlSuite -> Either FilePath CurlSuite)
-> IO (Either ParseException CurlSuite)
-> IO (Either FilePath CurlSuite)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Either ParseException CurlSuite)
forall a. FromJSON a => FilePath -> IO (Either ParseException a)
YI.decodeFileEither FilePath
specPath
Text
"dhall" -> do
ExceptT FilePath IO CurlSuite -> IO (Either FilePath CurlSuite)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath IO CurlSuite -> IO (Either FilePath CurlSuite))
-> ExceptT FilePath IO CurlSuite -> IO (Either FilePath CurlSuite)
forall a b. (a -> b) -> a -> b
$ do
let showErrorWithMessage :: (Show a) => String -> a -> String
showErrorWithMessage :: FilePath -> a -> FilePath
showErrorWithMessage FilePath
message a
err = FilePath
message FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (a -> FilePath
forall a. Show a => a -> FilePath
show a
err)
Text
raw <- IO Text -> ExceptT FilePath IO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT FilePath IO Text)
-> IO Text -> ExceptT FilePath IO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
TIO.readFile FilePath
specPath
Expr Src Import
expr <-
(ParseError -> FilePath)
-> ExceptT ParseError IO (Expr Src Import)
-> ExceptT FilePath IO (Expr Src Import)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT (FilePath -> ParseError -> FilePath
forall a. Show a => FilePath -> a -> FilePath
showErrorWithMessage FilePath
"parser") (ExceptT ParseError IO (Expr Src Import)
-> ExceptT FilePath IO (Expr Src Import))
-> (Either ParseError (Expr Src Import)
-> ExceptT ParseError IO (Expr Src Import))
-> Either ParseError (Expr Src Import)
-> ExceptT FilePath IO (Expr Src Import)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either ParseError (Expr Src Import))
-> ExceptT ParseError IO (Expr Src Import)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ParseError (Expr Src Import))
-> ExceptT ParseError IO (Expr Src Import))
-> (Either ParseError (Expr Src Import)
-> IO (Either ParseError (Expr Src Import)))
-> Either ParseError (Expr Src Import)
-> ExceptT ParseError IO (Expr Src Import)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ParseError (Expr Src Import)
-> IO (Either ParseError (Expr Src Import))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError (Expr Src Import)
-> ExceptT FilePath IO (Expr Src Import))
-> Either ParseError (Expr Src Import)
-> ExceptT FilePath IO (Expr Src Import)
forall a b. (a -> b) -> a -> b
$
FilePath -> Text -> Either ParseError (Expr Src Import)
Dhall.Parser.exprFromText FilePath
"dhall parser" (Text
raw :: Dhall.Text)
Expr Src Void
expr' <- IO (Expr Src Void) -> ExceptT FilePath IO (Expr Src Void)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Expr Src Void) -> ExceptT FilePath IO (Expr Src Void))
-> IO (Expr Src Void) -> ExceptT FilePath IO (Expr Src Void)
forall a b. (a -> b) -> a -> b
$ Expr Src Import -> IO (Expr Src Void)
Dhall.Import.load Expr Src Import
expr
IO (Either FilePath CurlSuite) -> ExceptT FilePath IO CurlSuite
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either FilePath CurlSuite) -> ExceptT FilePath IO CurlSuite)
-> IO (Either FilePath CurlSuite) -> ExceptT FilePath IO CurlSuite
forall a b. (a -> b) -> a -> b
$
Either FilePath CurlSuite -> IO (Either FilePath CurlSuite)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath CurlSuite -> IO (Either FilePath CurlSuite))
-> Either FilePath CurlSuite -> IO (Either FilePath CurlSuite)
forall a b. (a -> b) -> a -> b
$ do
Expr Src Void
_ <-
(TypeError Src Void -> FilePath)
-> Either (TypeError Src Void) (Expr Src Void)
-> Either FilePath (Expr Src Void)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (FilePath -> TypeError Src Void -> FilePath
forall a. Show a => FilePath -> a -> FilePath
showErrorWithMessage FilePath
"typeof") (Either (TypeError Src Void) (Expr Src Void)
-> Either FilePath (Expr Src Void))
-> Either (TypeError Src Void) (Expr Src Void)
-> Either FilePath (Expr Src Void)
forall a b. (a -> b) -> a -> b
$
Expr Src Void -> Either (TypeError Src Void) (Expr Src Void)
forall s. Expr s Void -> Either (TypeError s Void) (Expr s Void)
Dhall.TypeCheck.typeOf Expr Src Void
expr'
Value
val <-
(CompileError -> FilePath)
-> Either CompileError Value -> Either FilePath Value
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (FilePath -> CompileError -> FilePath
forall a. Show a => FilePath -> a -> FilePath
showErrorWithMessage FilePath
"to json") (Either CompileError Value -> Either FilePath Value)
-> Either CompileError Value -> Either FilePath Value
forall a b. (a -> b) -> a -> b
$
Expr Src Void -> Either CompileError Value
forall s. Expr s Void -> Either CompileError Value
Dhall.JSON.dhallToJSON Expr Src Void
expr'
(FilePath -> FilePath)
-> Either FilePath CurlSuite -> Either FilePath CurlSuite
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (FilePath -> FilePath -> FilePath
forall a. Show a => FilePath -> a -> FilePath
showErrorWithMessage FilePath
"from json") (Either FilePath CurlSuite -> Either FilePath CurlSuite)
-> (Result CurlSuite -> Either FilePath CurlSuite)
-> Result CurlSuite
-> Either FilePath CurlSuite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result CurlSuite -> Either FilePath CurlSuite
forall a. Result a -> Either FilePath a
resultToEither (Result CurlSuite -> Either FilePath CurlSuite)
-> Result CurlSuite -> Either FilePath CurlSuite
forall a b. (a -> b) -> a -> b
$
Value -> Result CurlSuite
forall a. FromJSON a => Value -> Result a
fromJSON Value
val
Text
_ -> Either FilePath CurlSuite -> IO (Either FilePath CurlSuite)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath CurlSuite -> IO (Either FilePath CurlSuite))
-> (FilePath -> Either FilePath CurlSuite)
-> FilePath
-> IO (Either FilePath CurlSuite)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath CurlSuite
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath CurlSuite))
-> FilePath -> IO (Either FilePath CurlSuite)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"Invalid spec path %s" FilePath
specPath
else Either FilePath CurlSuite -> IO (Either FilePath CurlSuite)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath CurlSuite -> IO (Either FilePath CurlSuite))
-> (FilePath -> Either FilePath CurlSuite)
-> FilePath
-> IO (Either FilePath CurlSuite)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Either FilePath CurlSuite
forall a b. a -> Either a b
Left (FilePath -> IO (Either FilePath CurlSuite))
-> FilePath -> IO (Either FilePath CurlSuite)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%s not found" FilePath
specPath
resultToEither :: Result a -> Either String a
resultToEither :: Result a -> Either FilePath a
resultToEither (Error FilePath
s) = FilePath -> Either FilePath a
forall a b. a -> Either a b
Left FilePath
s
resultToEither (Success a
a) = a -> Either FilePath a
forall a b. b -> Either a b
Right a
a
noVerifyTlsManagerSettings :: ManagerSettings
noVerifyTlsManagerSettings :: ManagerSettings
noVerifyTlsManagerSettings = TLSSettings -> Maybe SockSettings -> ManagerSettings
mkManagerSettings TLSSettings
noVerifyTlsSettings Maybe SockSettings
forall a. Maybe a
Nothing
noVerifyTlsSettings :: TLSSettings
noVerifyTlsSettings :: TLSSettings
noVerifyTlsSettings =
TLSSettingsSimple :: Bool -> Bool -> Bool -> TLSSettings
TLSSettingsSimple
{ settingDisableCertificateValidation :: Bool
settingDisableCertificateValidation = Bool
True
, settingDisableSession :: Bool
settingDisableSession = Bool
True
, settingUseServerName :: Bool
settingUseServerName = Bool
False
}
appendQueryParameters :: [KeyValuePair] -> Request -> Request
appendQueryParameters :: [KeyValuePair] -> Request -> Request
appendQueryParameters [KeyValuePair]
newParams Request
r = [(ByteString, Maybe ByteString)] -> Request -> Request
setQueryString ([(ByteString, Maybe ByteString)]
existing [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
-> [(ByteString, Maybe ByteString)]
forall a. [a] -> [a] -> [a]
++ [(ByteString, Maybe ByteString)]
newQuery) Request
r where
existing :: [(ByteString, Maybe ByteString)]
existing = ByteString -> [(ByteString, Maybe ByteString)]
NT.parseQuery (ByteString -> [(ByteString, Maybe ByteString)])
-> ByteString -> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
queryString Request
r
newQuery :: [(ByteString, Maybe ByteString)]
newQuery = SimpleQuery -> [(ByteString, Maybe ByteString)]
NT.simpleQueryToQuery (SimpleQuery -> [(ByteString, Maybe ByteString)])
-> SimpleQuery -> [(ByteString, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ (KeyValuePair -> (ByteString, ByteString))
-> [KeyValuePair] -> SimpleQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(KeyValuePair KeyType
k Text
v) -> (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (KeyType -> Text) -> KeyType -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyType -> Text
A.toText (KeyType -> ByteString) -> KeyType -> ByteString
forall a b. (a -> b) -> a -> b
$ KeyType
k, Text -> ByteString
T.encodeUtf8 Text
v)) [KeyValuePair]
newParams
setPayload :: Maybe Payload -> Request -> Request
setPayload :: Maybe Payload -> Request -> Request
setPayload Maybe Payload
Nothing = Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON Value
emptyObject
setPayload (Just (JSON Value
v)) = Value -> Request -> Request
forall a. ToJSON a => a -> Request -> Request
setRequestBodyJSON Value
v
setPayload (Just (URLEncoded (KeyValuePairs [KeyValuePair]
xs))) = SimpleQuery -> Request -> Request
setRequestBodyURLEncoded (SimpleQuery -> Request -> Request)
-> SimpleQuery -> Request -> Request
forall a b. (a -> b) -> a -> b
$ [KeyValuePair] -> SimpleQuery
kvpairs [KeyValuePair]
xs where
kvpairs :: [KeyValuePair] -> SimpleQuery
kvpairs = (KeyValuePair -> (ByteString, ByteString))
-> [KeyValuePair] -> SimpleQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(KeyValuePair KeyType
k Text
v) -> (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (KeyType -> Text) -> KeyType -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyType -> Text
A.toText (KeyType -> ByteString) -> KeyType -> ByteString
forall a b. (a -> b) -> a -> b
$ KeyType
k, Text -> ByteString
T.encodeUtf8 Text
v))
runCase :: CurlRunningsState -> CurlCase -> IO CaseResult
runCase :: CurlRunningsState -> CurlCase -> IO CaseResult
runCase state :: CurlRunningsState
state@(CurlRunningsState Environment
_ [CaseResult]
_ LogLevel
_ TLSCheckType
tlsCheckType) CurlCase
curlCase = do
let eInterpolatedUrl :: Either QueryError Text
eInterpolatedUrl = CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state (Text -> Either QueryError Text) -> Text -> Either QueryError Text
forall a b. (a -> b) -> a -> b
$ CurlCase -> Text
url CurlCase
curlCase
eInterpolatedHeaders :: Either QueryError Headers
eInterpolatedHeaders =
CurlRunningsState
-> Maybe Authentication -> Headers -> Either QueryError Headers
interpolateHeaders CurlRunningsState
state (CurlCase -> Maybe Authentication
auth CurlCase
curlCase) (Headers -> Either QueryError Headers)
-> Headers -> Either QueryError Headers
forall a b. (a -> b) -> a -> b
$ Headers -> Maybe Headers -> Headers
forall a. a -> Maybe a -> a
fromMaybe ([Header] -> Headers
HeaderSet []) (CurlCase -> Maybe Headers
headers CurlCase
curlCase)
eInterpolatedQueryParams :: Either QueryError KeyValuePairs
eInterpolatedQueryParams = CurlRunningsState
-> KeyValuePairs -> Either QueryError KeyValuePairs
forall a.
(ToJSON a, FromJSON a) =>
CurlRunningsState -> a -> Either QueryError a
interpolateViaJSON CurlRunningsState
state (KeyValuePairs -> Either QueryError KeyValuePairs)
-> KeyValuePairs -> Either QueryError KeyValuePairs
forall a b. (a -> b) -> a -> b
$ KeyValuePairs -> Maybe KeyValuePairs -> KeyValuePairs
forall a. a -> Maybe a -> a
fromMaybe ([KeyValuePair] -> KeyValuePairs
KeyValuePairs []) (CurlCase -> Maybe KeyValuePairs
queryParameters CurlCase
curlCase)
case (Either QueryError Text
eInterpolatedUrl, Either QueryError Headers
eInterpolatedHeaders, Either QueryError KeyValuePairs
eInterpolatedQueryParams) of
(Left QueryError
err, Either QueryError Headers
_, Either QueryError KeyValuePairs
_) ->
CaseResult -> IO CaseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (CaseResult -> IO CaseResult) -> CaseResult -> IO CaseResult
forall a b. (a -> b) -> a -> b
$ CurlCase
-> Maybe Headers
-> Maybe Value
-> [AssertionFailure]
-> Integer
-> CaseResult
CaseFail CurlCase
curlCase Maybe Headers
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing [CurlCase -> QueryError -> AssertionFailure
QueryFailure CurlCase
curlCase QueryError
err] Integer
0
(Either QueryError Text
_, Left QueryError
err, Either QueryError KeyValuePairs
_) ->
CaseResult -> IO CaseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (CaseResult -> IO CaseResult) -> CaseResult -> IO CaseResult
forall a b. (a -> b) -> a -> b
$ CurlCase
-> Maybe Headers
-> Maybe Value
-> [AssertionFailure]
-> Integer
-> CaseResult
CaseFail CurlCase
curlCase Maybe Headers
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing [CurlCase -> QueryError -> AssertionFailure
QueryFailure CurlCase
curlCase QueryError
err] Integer
0
(Either QueryError Text
_, Either QueryError Headers
_, Left QueryError
err) ->
CaseResult -> IO CaseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (CaseResult -> IO CaseResult) -> CaseResult -> IO CaseResult
forall a b. (a -> b) -> a -> b
$ CurlCase
-> Maybe Headers
-> Maybe Value
-> [AssertionFailure]
-> Integer
-> CaseResult
CaseFail CurlCase
curlCase Maybe Headers
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing [CurlCase -> QueryError -> AssertionFailure
QueryFailure CurlCase
curlCase QueryError
err] Integer
0
(Right Text
interpolatedUrl, Right Headers
interpolatedHeaders, Right (KeyValuePairs [KeyValuePair]
interpolatedQueryParams)) ->
case Maybe (Either QueryError Payload)
-> Either QueryError (Maybe Payload)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe (Either QueryError Payload)
-> Either QueryError (Maybe Payload))
-> Maybe (Either QueryError Payload)
-> Either QueryError (Maybe Payload)
forall a b. (a -> b) -> a -> b
$ CurlRunningsState -> Payload -> Either QueryError Payload
forall a.
(ToJSON a, FromJSON a) =>
CurlRunningsState -> a -> Either QueryError a
interpolateViaJSON CurlRunningsState
state (Payload -> Either QueryError Payload)
-> Maybe Payload -> Maybe (Either QueryError Payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CurlCase -> Maybe Payload
requestData CurlCase
curlCase of
Left QueryError
l ->
CaseResult -> IO CaseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (CaseResult -> IO CaseResult) -> CaseResult -> IO CaseResult
forall a b. (a -> b) -> a -> b
$ CurlCase
-> Maybe Headers
-> Maybe Value
-> [AssertionFailure]
-> Integer
-> CaseResult
CaseFail CurlCase
curlCase Maybe Headers
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing [CurlCase -> QueryError -> AssertionFailure
QueryFailure CurlCase
curlCase QueryError
l] Integer
0
Right Maybe Payload
interpolatedData -> do
Request
initReq <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequest (FilePath -> IO Request) -> FilePath -> IO Request
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
interpolatedUrl
Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
noVerifyTlsManagerSettings
let !request :: Request
request =
Maybe Payload -> Request -> Request
setPayload Maybe Payload
interpolatedData (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
RequestHeaders -> Request -> Request
setRequestHeaders (Headers -> RequestHeaders
toHTTPHeaders Headers
interpolatedHeaders) (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[KeyValuePair] -> Request -> Request
appendQueryParameters [KeyValuePair]
interpolatedQueryParams (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(if TLSCheckType
tlsCheckType TLSCheckType -> TLSCheckType -> Bool
forall a. Eq a => a -> a -> Bool
== TLSCheckType
DoTLSCheck then Request -> Request
forall a. a -> a
id else (Manager -> Request -> Request
setRequestManager Manager
manager)) (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$
Request
initReq { method :: ByteString
method = FilePath -> ByteString
B8S.pack (FilePath -> ByteString)
-> (HttpMethod -> FilePath) -> HttpMethod -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpMethod -> FilePath
forall a. Show a => a -> FilePath
show (HttpMethod -> ByteString) -> HttpMethod -> ByteString
forall a b. (a -> b) -> a -> b
$ CurlCase -> HttpMethod
requestMethod CurlCase
curlCase
, redirectCount :: Int
redirectCount = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
10 (CurlCase -> Maybe Int
allowedRedirects CurlCase
curlCase) }
CurlRunningsState -> CurlRunningsLogger
logger CurlRunningsState
state LogLevel
DEBUG (Request -> Text
forall a. Show a => a -> Text
pShow Request
request)
CurlRunningsState -> CurlRunningsLogger
logger
CurlRunningsState
state
LogLevel
DEBUG
(Text
"Request body: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Payload -> Text
forall a. Show a => a -> Text
pShow (Payload -> Text) -> Payload -> Text
forall a b. (a -> b) -> a -> b
$ Payload -> Maybe Payload -> Payload
forall a. a -> Maybe a -> a
fromMaybe (Value -> Payload
JSON Value
emptyObject) Maybe Payload
interpolatedData))
Integer
start <- IO Integer
nowMillis
Response ByteString
response <- Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpBS Request
request
Integer
stop <- IO Integer
nowMillis
let elapsed :: Integer
elapsed = Integer
stop Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
start
let responseHeaderValues :: [ByteString]
responseHeaderValues = ((HeaderName, ByteString) -> ByteString)
-> RequestHeaders -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Response ByteString -> RequestHeaders
forall a. Response a -> RequestHeaders
getResponseHeaders Response ByteString
response)
if ByteString
"application/octet-stream" ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ByteString]
responseHeaderValues Bool -> Bool -> Bool
&&
ByteString
"application/vnd.apple.pkpass" ByteString -> [ByteString] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ByteString]
responseHeaderValues
then IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
(CurlRunningsState -> CurlRunningsLogger
logger CurlRunningsState
state LogLevel
DEBUG (Response ByteString -> Text
forall a. Show a => a -> Text
pShow Response ByteString
response))
(\(IOException
e :: IOException) ->
CurlRunningsState -> CurlRunningsLogger
logger CurlRunningsState
state LogLevel
ERROR (Text
"Error logging response: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a. Show a => a -> Text
pShow IOException
e))
else CurlRunningsState -> CurlRunningsLogger
logger
CurlRunningsState
state
LogLevel
DEBUG
Text
"Response output supressed (returned content-type was bytes)"
Maybe Value
returnVal <-
IO (Maybe Value)
-> (IOException -> IO (Maybe Value)) -> IO (Maybe Value)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
((Maybe Value -> IO (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value -> IO (Maybe Value))
-> (ByteString -> Maybe Value) -> ByteString -> IO (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode (ByteString -> Maybe Value)
-> (ByteString -> ByteString) -> ByteString -> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B.fromStrict (ByteString -> IO (Maybe Value)) -> ByteString -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall a. Response a -> a
getResponseBody Response ByteString
response) :: IO (Maybe Value))
(\(IOException
e :: IOException) ->
CurlRunningsState -> CurlRunningsLogger
logger
CurlRunningsState
state
LogLevel
ERROR
(Text
"Error decoding response into json: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> IOException -> Text
forall a. Show a => a -> Text
pShow IOException
e) IO () -> IO (Maybe Value) -> IO (Maybe Value)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Maybe Value -> IO (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
Null))
let returnCode :: Int
returnCode = Response ByteString -> Int
forall a. Response a -> Int
getResponseStatusCode Response ByteString
response
receivedHeaders :: Headers
receivedHeaders = RequestHeaders -> Headers
fromHTTPHeaders (RequestHeaders -> Headers) -> RequestHeaders -> Headers
forall a b. (a -> b) -> a -> b
$ Response ByteString -> RequestHeaders
forall a. Response a -> RequestHeaders
responseHeaders Response ByteString
response
assertionErrors :: [AssertionFailure]
assertionErrors =
(Maybe AssertionFailure -> AssertionFailure)
-> [Maybe AssertionFailure] -> [AssertionFailure]
forall a b. (a -> b) -> [a] -> [b]
map Maybe AssertionFailure -> AssertionFailure
forall a. HasCallStack => Maybe a -> a
fromJust ([Maybe AssertionFailure] -> [AssertionFailure])
-> [Maybe AssertionFailure] -> [AssertionFailure]
forall a b. (a -> b) -> a -> b
$
(Maybe AssertionFailure -> Bool)
-> [Maybe AssertionFailure] -> [Maybe AssertionFailure]
forall a. (a -> Bool) -> [a] -> [a]
filter
Maybe AssertionFailure -> Bool
forall a. Maybe a -> Bool
isJust
[ CurlRunningsState
-> CurlCase -> Maybe Value -> Maybe AssertionFailure
checkBody CurlRunningsState
state CurlCase
curlCase Maybe Value
returnVal
, CurlCase -> Int -> Maybe AssertionFailure
checkCode CurlCase
curlCase Int
returnCode
, CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure
checkHeaders CurlRunningsState
state CurlCase
curlCase Headers
receivedHeaders
]
CaseResult -> IO CaseResult
forall (m :: * -> *) a. Monad m => a -> m a
return (CaseResult -> IO CaseResult) -> CaseResult -> IO CaseResult
forall a b. (a -> b) -> a -> b
$
case [AssertionFailure]
assertionErrors of
[] -> CurlCase -> Maybe Headers -> Maybe Value -> Integer -> CaseResult
CasePass CurlCase
curlCase (Headers -> Maybe Headers
forall a. a -> Maybe a
Just Headers
receivedHeaders) Maybe Value
returnVal Integer
elapsed
[AssertionFailure]
failures ->
CurlCase
-> Maybe Headers
-> Maybe Value
-> [AssertionFailure]
-> Integer
-> CaseResult
CaseFail CurlCase
curlCase (Headers -> Maybe Headers
forall a. a -> Maybe a
Just Headers
receivedHeaders) Maybe Value
returnVal [AssertionFailure]
failures Integer
elapsed
checkHeaders ::
CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure
CurlRunningsState
_ CurlCase { expectHeaders :: CurlCase -> Maybe HeaderMatcher
expectHeaders = Maybe HeaderMatcher
Nothing } Headers
_ = Maybe AssertionFailure
forall a. Maybe a
Nothing
checkHeaders CurlRunningsState
state curlCase :: CurlCase
curlCase@CurlCase { expectHeaders :: CurlCase -> Maybe HeaderMatcher
expectHeaders = Just (HeaderMatcher [PartialHeaderMatcher]
m) } Headers
receivedHeaders =
let interpolatedHeaders :: Either QueryError [PartialHeaderMatcher]
interpolatedHeaders = (PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher)
-> [PartialHeaderMatcher]
-> Either QueryError [PartialHeaderMatcher]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CurlRunningsState
-> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
interpolatePartialHeader CurlRunningsState
state) [PartialHeaderMatcher]
m
in case Either QueryError [PartialHeaderMatcher]
interpolatedHeaders of
Left QueryError
f -> AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$ CurlCase -> QueryError -> AssertionFailure
QueryFailure CurlCase
curlCase QueryError
f
Right [PartialHeaderMatcher]
headerList ->
let notFound :: [PartialHeaderMatcher]
notFound =
(PartialHeaderMatcher -> Bool)
-> [PartialHeaderMatcher] -> [PartialHeaderMatcher]
forall a. (a -> Bool) -> [a] -> [a]
filter
(Bool -> Bool
not (Bool -> Bool)
-> (PartialHeaderMatcher -> Bool) -> PartialHeaderMatcher -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Headers -> PartialHeaderMatcher -> Bool
headerIn Headers
receivedHeaders)
(CurlRunningsState
-> CurlRunningsUnsafeLogger [PartialHeaderMatcher]
forall a. Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a
unsafeLogger CurlRunningsState
state LogLevel
DEBUG Text
"header matchers" [PartialHeaderMatcher]
headerList)
in if [PartialHeaderMatcher] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PartialHeaderMatcher]
notFound
then Maybe AssertionFailure
forall a. Maybe a
Nothing
else AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$
CurlCase -> HeaderMatcher -> Headers -> AssertionFailure
HeaderFailure
CurlCase
curlCase
([PartialHeaderMatcher] -> HeaderMatcher
HeaderMatcher [PartialHeaderMatcher]
headerList)
Headers
receivedHeaders
interpolatePartialHeader ::
CurlRunningsState
-> PartialHeaderMatcher
-> Either QueryError PartialHeaderMatcher
CurlRunningsState
state (PartialHeaderMatcher Maybe Text
k Maybe Text
v) =
let k' :: Maybe (Either QueryError Text)
k' = CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state (Text -> Either QueryError Text)
-> Maybe Text -> Maybe (Either QueryError Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
k
v' :: Maybe (Either QueryError Text)
v' = CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state (Text -> Either QueryError Text)
-> Maybe Text -> Maybe (Either QueryError Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
v
in case (Maybe (Either QueryError Text)
k', Maybe (Either QueryError Text)
v') of
(Just (Left QueryError
err), Maybe (Either QueryError Text)
_) -> QueryError -> Either QueryError PartialHeaderMatcher
forall a b. a -> Either a b
Left QueryError
err
(Maybe (Either QueryError Text)
_, Just (Left QueryError
err)) -> QueryError -> Either QueryError PartialHeaderMatcher
forall a b. a -> Either a b
Left QueryError
err
(Just (Right Text
p), Just (Right Text
q)) ->
PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
forall a b. b -> Either a b
Right (PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher)
-> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Maybe Text -> PartialHeaderMatcher
PartialHeaderMatcher (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
q)
(Just (Right Text
p), Maybe (Either QueryError Text)
Nothing) ->
PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
forall a b. b -> Either a b
Right (PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher)
-> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Maybe Text -> PartialHeaderMatcher
PartialHeaderMatcher (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p) Maybe Text
forall a. Maybe a
Nothing
(Maybe (Either QueryError Text)
Nothing, Just (Right Text
p)) ->
PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
forall a b. b -> Either a b
Right (PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher)
-> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Maybe Text -> PartialHeaderMatcher
PartialHeaderMatcher Maybe Text
forall a. Maybe a
Nothing (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
p)
(Maybe (Either QueryError Text), Maybe (Either QueryError Text))
_ ->
CurlRunningsState
-> CurlRunningsUnsafeLogger
(Either QueryError PartialHeaderMatcher)
forall a. Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a
unsafeLogger CurlRunningsState
state LogLevel
ERROR Text
"WARNING: empty header matcher found" (Either QueryError PartialHeaderMatcher
-> Either QueryError PartialHeaderMatcher)
-> (PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher)
-> PartialHeaderMatcher
-> Either QueryError PartialHeaderMatcher
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
forall a b. b -> Either a b
Right (PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher)
-> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
forall a b. (a -> b) -> a -> b
$
Maybe Text -> Maybe Text -> PartialHeaderMatcher
PartialHeaderMatcher Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
makeBasicAuthToken :: T.Text -> T.Text -> T.Text
makeBasicAuthToken :: Text -> Text -> Text
makeBasicAuthToken Text
u Text
p = ByteString -> Text
T.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text
u Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
p)
interpolateHeaders :: CurlRunningsState -> Maybe Authentication -> Headers -> Either QueryError Headers
CurlRunningsState
state Maybe Authentication
maybeAuth (HeaderSet [Header]
headerList) = do
[Header]
authHeaders <- case Maybe Authentication
maybeAuth of
(Just (BasicAuthentication Text
u Text
p)) ->
let interpolated :: Either QueryError [Text]
interpolated = [Either QueryError Text] -> Either QueryError [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state Text
u, CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state Text
p] in
case Either QueryError [Text]
interpolated of
Right [Text
u', Text
p'] -> [Header] -> Either QueryError [Header]
forall a b. b -> Either a b
Right [Text -> Text -> Header
Header Text
"Authorization" (Text
"Basic " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> Text -> Text
makeBasicAuthToken Text
u' Text
p'))]
Left QueryError
l -> QueryError -> Either QueryError [Header]
forall a b. a -> Either a b
Left QueryError
l
Either QueryError [Text]
_ -> QueryError -> Either QueryError [Header]
forall a b. a -> Either a b
Left (QueryError -> Either QueryError [Header])
-> QueryError -> Either QueryError [Header]
forall a b. (a -> b) -> a -> b
$ Text -> QueryError
QueryValidationError Text
"FIXME Pattern match error in interpolatingHeaders"
Maybe Authentication
_ -> [Header] -> Either QueryError [Header]
forall a b. b -> Either a b
Right []
[Header]
mainHeaders <- ((Header -> Either QueryError Header)
-> [Header] -> Either QueryError [Header]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(\(Header Text
k Text
v) ->
case [Either QueryError Text] -> Either QueryError [Text]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state Text
k, CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state Text
v] of
Left QueryError
err -> QueryError -> Either QueryError Header
forall a b. a -> Either a b
Left QueryError
err
Right [Text
k', Text
v'] -> Header -> Either QueryError Header
forall a b. b -> Either a b
Right (Header -> Either QueryError Header)
-> Header -> Either QueryError Header
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Header
Header Text
k' Text
v'
Either QueryError [Text]
_ -> QueryError -> Either QueryError Header
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Header)
-> QueryError -> Either QueryError Header
forall a b. (a -> b) -> a -> b
$ Text -> QueryError
QueryValidationError Text
"FIXME Pattern match error in interpolatingHeaders")
[Header]
headerList)
Headers -> Either QueryError Headers
forall a b. b -> Either a b
Right (Headers -> Either QueryError Headers)
-> ([Header] -> Headers) -> [Header] -> Either QueryError Headers
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Header] -> Headers
HeaderSet ([Header] -> Either QueryError Headers)
-> [Header] -> Either QueryError Headers
forall a b. (a -> b) -> a -> b
$ [Header]
mainHeaders [Header] -> [Header] -> [Header]
forall a. Semigroup a => a -> a -> a
<> [Header]
authHeaders
headerMatches :: PartialHeaderMatcher -> Header -> Bool
(PartialHeaderMatcher Maybe Text
mk Maybe Text
mv) (Header Text
k Text
v) =
Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k) Maybe Text
mk Bool -> Bool -> Bool
&& Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
v) Maybe Text
mv
headerIn :: Headers -> PartialHeaderMatcher -> Bool
(HeaderSet [Header]
received) PartialHeaderMatcher
headerMatcher =
(Header -> Bool) -> [Header] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (PartialHeaderMatcher -> Header -> Bool
headerMatches PartialHeaderMatcher
headerMatcher) [Header]
received
safeLast :: [a] -> Maybe a
safeLast :: [a] -> Maybe a
safeLast [] = Maybe a
forall a. Maybe a
Nothing
safeLast [a]
x = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. [a] -> a
last [a]
x
printR :: Show a => a -> IO a
printR :: a -> IO a
printR a
x = a -> IO ()
forall a. Show a => a -> IO ()
print a
x IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
runSuite :: CurlSuite -> LogLevel -> TLSCheckType -> IO [CaseResult]
runSuite :: CurlSuite -> LogLevel -> TLSCheckType -> IO [CaseResult]
runSuite (CurlSuite [CurlCase]
cases Maybe Text
filterRegex) LogLevel
logLevel TLSCheckType
tlsType = do
[(FilePath, FilePath)]
fullEnv <- IO [(FilePath, FilePath)]
getEnvironment
let envMap :: A.MapType T.Text
envMap :: Environment
envMap = [(KeyType, Text)] -> Environment
forall v. [(KeyType, v)] -> KeyMap v
A.fromList ([(KeyType, Text)] -> Environment)
-> [(KeyType, Text)] -> Environment
forall a b. (a -> b) -> a -> b
$ ((FilePath, FilePath) -> (KeyType, Text))
-> [(FilePath, FilePath)] -> [(KeyType, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
x, FilePath
y) -> (FilePath -> KeyType
forall a. IsString a => FilePath -> a
fromString FilePath
x :: A.KeyType, FilePath -> Text
T.pack FilePath
y)) [(FilePath, FilePath)]
fullEnv :: A.MapType T.Text
filterNameByRegexp :: CurlCase -> Bool
filterNameByRegexp CurlCase
curlCase =
Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
Bool
True
(\Text
regexp -> Text -> FilePath
T.unpack (CurlCase -> Text
name CurlCase
curlCase) FilePath -> FilePath -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> FilePath
T.unpack Text
regexp :: Bool)
Maybe Text
filterRegex
([CaseResult] -> CurlCase -> IO [CaseResult])
-> [CaseResult] -> [CurlCase] -> IO [CaseResult]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM
(\[CaseResult]
prevResults CurlCase
curlCase ->
case [CaseResult] -> Maybe CaseResult
forall a. [a] -> Maybe a
safeLast [CaseResult]
prevResults of
Just CaseFail {} -> [CaseResult] -> IO [CaseResult]
forall (m :: * -> *) a. Monad m => a -> m a
return [CaseResult]
prevResults
Just CasePass {} -> do
CaseResult
result <-
CurlRunningsState -> CurlCase -> IO CaseResult
runCase (Environment
-> [CaseResult] -> LogLevel -> TLSCheckType -> CurlRunningsState
CurlRunningsState Environment
envMap [CaseResult]
prevResults LogLevel
logLevel TLSCheckType
tlsType) CurlCase
curlCase IO CaseResult -> (CaseResult -> IO CaseResult) -> IO CaseResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
CaseResult -> IO CaseResult
forall a. Show a => a -> IO a
printR
[CaseResult] -> IO [CaseResult]
forall (m :: * -> *) a. Monad m => a -> m a
return ([CaseResult] -> IO [CaseResult])
-> [CaseResult] -> IO [CaseResult]
forall a b. (a -> b) -> a -> b
$ [CaseResult]
prevResults [CaseResult] -> [CaseResult] -> [CaseResult]
forall a. [a] -> [a] -> [a]
++ [CaseResult
result]
Maybe CaseResult
Nothing -> do
CaseResult
result <-
CurlRunningsState -> CurlCase -> IO CaseResult
runCase (Environment
-> [CaseResult] -> LogLevel -> TLSCheckType -> CurlRunningsState
CurlRunningsState Environment
envMap [] LogLevel
logLevel TLSCheckType
tlsType) CurlCase
curlCase IO CaseResult -> (CaseResult -> IO CaseResult) -> IO CaseResult
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CaseResult -> IO CaseResult
forall a. Show a => a -> IO a
printR
[CaseResult] -> IO [CaseResult]
forall (m :: * -> *) a. Monad m => a -> m a
return [CaseResult
result])
[]
((CurlCase -> Bool) -> [CurlCase] -> [CurlCase]
forall a. (a -> Bool) -> [a] -> [a]
filter CurlCase -> Bool
filterNameByRegexp [CurlCase]
cases)
checkBody ::
CurlRunningsState -> CurlCase -> Maybe Value -> Maybe AssertionFailure
checkBody :: CurlRunningsState
-> CurlCase -> Maybe Value -> Maybe AssertionFailure
checkBody CurlRunningsState
state curlCase :: CurlCase
curlCase@CurlCase { expectData :: CurlCase -> Maybe JsonMatcher
expectData = (Just (Exactly Value
expectedValue)) } (Just Value
receivedBody) =
case CurlRunningsState -> Value -> Either QueryError Value
runReplacements CurlRunningsState
state Value
expectedValue of
(Left QueryError
err) -> AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$ CurlCase -> QueryError -> AssertionFailure
QueryFailure CurlCase
curlCase QueryError
err
(Right Value
interpolated) ->
if (CurlRunningsState -> CurlRunningsUnsafeLogger Value
forall a. Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a
unsafeLogger CurlRunningsState
state LogLevel
DEBUG Text
"exact body matcher" Value
interpolated) Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/=
Value
receivedBody
then AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$
CurlCase -> JsonMatcher -> Maybe Value -> AssertionFailure
DataFailure
(CurlCase
curlCase {expectData :: Maybe JsonMatcher
expectData = JsonMatcher -> Maybe JsonMatcher
forall a. a -> Maybe a
Just (JsonMatcher -> Maybe JsonMatcher)
-> JsonMatcher -> Maybe JsonMatcher
forall a b. (a -> b) -> a -> b
$ Value -> JsonMatcher
Exactly Value
interpolated})
(Value -> JsonMatcher
Exactly Value
interpolated)
(Value -> Maybe Value
forall a. a -> Maybe a
Just Value
receivedBody)
else Maybe AssertionFailure
forall a. Maybe a
Nothing
checkBody CurlRunningsState
state curlCase :: CurlCase
curlCase@CurlCase { expectData :: CurlCase -> Maybe JsonMatcher
expectData = (Just (Contains [JsonSubExpr]
subexprs)) } (Just Value
receivedBody) =
case CurlRunningsState
-> [JsonSubExpr] -> Either QueryError [JsonSubExpr]
runReplacementsOnSubvalues CurlRunningsState
state [JsonSubExpr]
subexprs of
Left QueryError
f -> AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$ CurlCase -> QueryError -> AssertionFailure
QueryFailure CurlCase
curlCase QueryError
f
Right [JsonSubExpr]
updatedMatcher ->
if Value -> [JsonSubExpr] -> Bool
jsonContainsAll
Value
receivedBody
(CurlRunningsState -> CurlRunningsUnsafeLogger [JsonSubExpr]
forall a. Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a
unsafeLogger CurlRunningsState
state LogLevel
DEBUG Text
"partial json body matcher" [JsonSubExpr]
updatedMatcher)
then Maybe AssertionFailure
forall a. Maybe a
Nothing
else AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$
CurlCase -> JsonMatcher -> Maybe Value -> AssertionFailure
DataFailure CurlCase
curlCase ([JsonSubExpr] -> JsonMatcher
Contains [JsonSubExpr]
updatedMatcher) (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
receivedBody)
checkBody CurlRunningsState
state curlCase :: CurlCase
curlCase@CurlCase { expectData :: CurlCase -> Maybe JsonMatcher
expectData = (Just (NotContains [JsonSubExpr]
subexprs)) } (Just Value
receivedBody) =
case CurlRunningsState
-> [JsonSubExpr] -> Either QueryError [JsonSubExpr]
runReplacementsOnSubvalues CurlRunningsState
state [JsonSubExpr]
subexprs of
Left QueryError
f -> AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$ CurlCase -> QueryError -> AssertionFailure
QueryFailure CurlCase
curlCase QueryError
f
Right [JsonSubExpr]
updatedMatcher ->
if Value -> [JsonSubExpr] -> Bool
jsonContainsAny
Value
receivedBody
(CurlRunningsState -> CurlRunningsUnsafeLogger [JsonSubExpr]
forall a. Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a
unsafeLogger CurlRunningsState
state LogLevel
DEBUG Text
"partial json body matcher" [JsonSubExpr]
updatedMatcher)
then AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$
CurlCase -> JsonMatcher -> Maybe Value -> AssertionFailure
DataFailure
CurlCase
curlCase
([JsonSubExpr] -> JsonMatcher
NotContains [JsonSubExpr]
updatedMatcher)
(Value -> Maybe Value
forall a. a -> Maybe a
Just Value
receivedBody)
else Maybe AssertionFailure
forall a. Maybe a
Nothing
checkBody CurlRunningsState
state curlCase :: CurlCase
curlCase@CurlCase { expectData :: CurlCase -> Maybe JsonMatcher
expectData = (Just m :: JsonMatcher
m@(MixedContains [JsonMatcher]
subexprs)) } Maybe Value
receivedBody =
let failure :: Maybe AssertionFailure
failure =
Maybe (Maybe AssertionFailure) -> Maybe AssertionFailure
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe AssertionFailure) -> Maybe AssertionFailure)
-> Maybe (Maybe AssertionFailure) -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$
(Maybe AssertionFailure -> Bool)
-> [Maybe AssertionFailure] -> Maybe (Maybe AssertionFailure)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
Maybe AssertionFailure -> Bool
forall a. Maybe a -> Bool
isJust
((JsonMatcher -> Maybe AssertionFailure)
-> [JsonMatcher] -> [Maybe AssertionFailure]
forall a b. (a -> b) -> [a] -> [b]
map
(\JsonMatcher
subexpr ->
CurlRunningsState
-> CurlCase -> Maybe Value -> Maybe AssertionFailure
checkBody
CurlRunningsState
state
CurlCase
curlCase {expectData :: Maybe JsonMatcher
expectData = JsonMatcher -> Maybe JsonMatcher
forall a. a -> Maybe a
Just JsonMatcher
subexpr}
Maybe Value
receivedBody)
[JsonMatcher]
subexprs)
in (AssertionFailure -> AssertionFailure)
-> Maybe AssertionFailure -> Maybe AssertionFailure
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\AssertionFailure
_ -> CurlCase -> JsonMatcher -> Maybe Value -> AssertionFailure
DataFailure CurlCase
curlCase JsonMatcher
m Maybe Value
receivedBody) Maybe AssertionFailure
failure
checkBody CurlRunningsState
_ curlCase :: CurlCase
curlCase@CurlCase { expectData :: CurlCase -> Maybe JsonMatcher
expectData = (Just JsonMatcher
anything) } Maybe Value
Nothing =
AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$ CurlCase -> JsonMatcher -> Maybe Value -> AssertionFailure
DataFailure CurlCase
curlCase JsonMatcher
anything Maybe Value
forall a. Maybe a
Nothing
checkBody CurlRunningsState
_ CurlCase { expectData :: CurlCase -> Maybe JsonMatcher
expectData = Maybe JsonMatcher
Nothing } Maybe Value
_ = Maybe AssertionFailure
forall a. Maybe a
Nothing
runReplacementsOnSubvalues ::
CurlRunningsState -> [JsonSubExpr] -> Either QueryError [JsonSubExpr]
runReplacementsOnSubvalues :: CurlRunningsState
-> [JsonSubExpr] -> Either QueryError [JsonSubExpr]
runReplacementsOnSubvalues CurlRunningsState
state =
(JsonSubExpr -> Either QueryError JsonSubExpr)
-> [JsonSubExpr] -> Either QueryError [JsonSubExpr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(\JsonSubExpr
expr ->
case JsonSubExpr
expr of
ValueMatch Value
v ->
case CurlRunningsState -> Value -> Either QueryError Value
runReplacements CurlRunningsState
state Value
v of
Left QueryError
l -> QueryError -> Either QueryError JsonSubExpr
forall a b. a -> Either a b
Left QueryError
l
Right Value
newVal -> JsonSubExpr -> Either QueryError JsonSubExpr
forall a b. b -> Either a b
Right (JsonSubExpr -> Either QueryError JsonSubExpr)
-> JsonSubExpr -> Either QueryError JsonSubExpr
forall a b. (a -> b) -> a -> b
$ Value -> JsonSubExpr
ValueMatch Value
newVal
KeyMatch Text
k ->
case CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state Text
k of
Left QueryError
l -> QueryError -> Either QueryError JsonSubExpr
forall a b. a -> Either a b
Left QueryError
l
Right Text
newKey -> JsonSubExpr -> Either QueryError JsonSubExpr
forall a b. b -> Either a b
Right (JsonSubExpr -> Either QueryError JsonSubExpr)
-> JsonSubExpr -> Either QueryError JsonSubExpr
forall a b. (a -> b) -> a -> b
$ Text -> JsonSubExpr
KeyMatch Text
newKey
KeyValueMatch Text
k Value
v ->
case (CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state Text
k, CurlRunningsState -> Value -> Either QueryError Value
runReplacements CurlRunningsState
state Value
v) of
(Left QueryError
l, Either QueryError Value
_) -> QueryError -> Either QueryError JsonSubExpr
forall a b. a -> Either a b
Left QueryError
l
(Either QueryError Text
_, Left QueryError
l) -> QueryError -> Either QueryError JsonSubExpr
forall a b. a -> Either a b
Left QueryError
l
(Right Text
k', Right Value
v') ->
JsonSubExpr -> Either QueryError JsonSubExpr
forall a b. b -> Either a b
Right KeyValueMatch :: Text -> Value -> JsonSubExpr
KeyValueMatch {matchKey :: Text
matchKey = Text
k', matchValue :: Value
matchValue = Value
v'})
runReplacements :: CurlRunningsState -> Value -> Either QueryError Value
runReplacements :: CurlRunningsState -> Value -> Either QueryError Value
runReplacements CurlRunningsState
state (Object Object
o) =
let keys :: [KeyType]
keys = Object -> [KeyType]
forall v. KeyMap v -> [KeyType]
A.keys Object
o
keysWithUpdatedKeyVal :: [(KeyType, Either QueryError Text, Either QueryError Value)]
keysWithUpdatedKeyVal =
(KeyType
-> (KeyType, Either QueryError Text, Either QueryError Value))
-> [KeyType]
-> [(KeyType, Either QueryError Text, Either QueryError Value)]
forall a b. (a -> b) -> [a] -> [b]
map
(\KeyType
key ->
let value :: Value
value = 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
key Object
o
in ( KeyType
key
, CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state (KeyType -> Text
A.toText KeyType
key)
, CurlRunningsState -> Value -> Either QueryError Value
runReplacements CurlRunningsState
state Value
value))
[KeyType]
keys
in (Object -> Value)
-> Either QueryError Object -> Either QueryError Value
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight Object -> Value
Object (Either QueryError Object -> Either QueryError Value)
-> Either QueryError Object -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$
((KeyType, Either QueryError Text, Either QueryError Value)
-> Either QueryError Object -> Either QueryError Object)
-> Either QueryError Object
-> [(KeyType, Either QueryError Text, Either QueryError Value)]
-> Either QueryError Object
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\((KeyType
key, Either QueryError Text
eKeyResult, Either QueryError Value
eValueResult) :: ( A.KeyType
, Either QueryError T.Text
, Either QueryError Value)) (Either QueryError Object
eObjectToUpdate :: Either QueryError Object) ->
case (Either QueryError Text
eKeyResult, Either QueryError Value
eValueResult, Either QueryError Object
eObjectToUpdate)
of
(Left QueryError
queryErr, Either QueryError Value
_, Either QueryError Object
_) -> QueryError -> Either QueryError Object
forall a b. a -> Either a b
Left QueryError
queryErr
(Either QueryError Text
_, Left QueryError
queryErr, Either QueryError Object
_) -> QueryError -> Either QueryError Object
forall a b. a -> Either a b
Left QueryError
queryErr
(Either QueryError Text
_, Either QueryError Value
_, Left QueryError
queryErr) -> QueryError -> Either QueryError Object
forall a b. a -> Either a b
Left QueryError
queryErr
(Right Text
newKey, Right Value
newValue, Right Object
objectToUpdate) ->
let newKey' :: KeyType
newKey' = Text -> KeyType
A.fromText Text
newKey
in if KeyType
key KeyType -> KeyType -> Bool
forall a. Eq a => a -> a -> Bool
/= KeyType
newKey'
then let inserted :: Object
inserted = KeyType -> Value -> Object -> Object
forall v. KeyType -> v -> KeyMap v -> KeyMap v
A.insert KeyType
newKey' Value
newValue Object
objectToUpdate
deleted :: Object
deleted = KeyType -> Object -> Object
forall v. KeyType -> KeyMap v -> KeyMap v
A.delete KeyType
key Object
inserted
in Object -> Either QueryError Object
forall a b. b -> Either a b
Right Object
deleted
else Object -> Either QueryError Object
forall a b. b -> Either a b
Right (Object -> Either QueryError Object)
-> Object -> Either QueryError Object
forall a b. (a -> b) -> a -> b
$ KeyType -> Value -> Object -> Object
forall v. KeyType -> v -> KeyMap v -> KeyMap v
A.insert KeyType
key Value
newValue Object
objectToUpdate)
(Object -> Either QueryError Object
forall a b. b -> Either a b
Right Object
o)
[(KeyType, Either QueryError Text, Either QueryError Value)]
keysWithUpdatedKeyVal
runReplacements CurlRunningsState
p (Array Array
a) =
let results :: Either QueryError Array
results = (Value -> Either QueryError Value)
-> Array -> Either QueryError Array
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM (CurlRunningsState -> Value -> Either QueryError Value
runReplacements CurlRunningsState
p) Array
a
in case Either QueryError Array
results of
Left QueryError
l -> QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left QueryError
l
Right Array
r -> Value -> Either QueryError Value
forall a b. b -> Either a b
Right (Value -> Either QueryError Value)
-> Value -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ Array -> Value
Array Array
r
runReplacements CurlRunningsState
_ s :: Value
s@(String Text
"") = Value -> Either QueryError Value
forall a b. b -> Either a b
Right Value
s
runReplacements CurlRunningsState
state (String Text
s) =
case Text -> Either QueryError [InterpolatedQuery]
parseQuery Text
s of
Right [LiteralText Text
t] -> Value -> Either QueryError Value
forall a b. b -> Either a b
Right (Value -> Either QueryError Value)
-> Value -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
t
Right [q :: InterpolatedQuery
q@(InterpolatedQuery Text
_ Query
_)] ->
CurlRunningsState -> InterpolatedQuery -> Either QueryError Text
getStringValueForQuery CurlRunningsState
state InterpolatedQuery
q Either QueryError Text
-> (Text -> Either QueryError Value) -> Either QueryError Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Either QueryError Value
forall a b. b -> Either a b
Right (Value -> Either QueryError Value)
-> (Text -> Value) -> Text -> Either QueryError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String)
Right [q :: InterpolatedQuery
q@(NonInterpolatedQuery Query
_)] -> CurlRunningsState -> InterpolatedQuery -> Either QueryError Value
getValueForQuery CurlRunningsState
state InterpolatedQuery
q
Right [InterpolatedQuery]
_ -> (Text -> Value)
-> Either QueryError Text -> Either QueryError Value
forall b c a. (b -> c) -> Either a b -> Either a c
mapRight Text -> Value
String (Either QueryError Text -> Either QueryError Value)
-> Either QueryError Text -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state Text
s
Left QueryError
parseErr -> QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left QueryError
parseErr
runReplacements CurlRunningsState
_ Value
valToUpdate = Value -> Either QueryError Value
forall a b. b -> Either a b
Right Value
valToUpdate
interpolateViaJSON :: (ToJSON a, FromJSON a) => CurlRunningsState -> a -> Either QueryError a
interpolateViaJSON :: CurlRunningsState -> a -> Either QueryError a
interpolateViaJSON CurlRunningsState
state a
i = do
Value
replaced <- CurlRunningsState -> Value -> Either QueryError Value
runReplacements CurlRunningsState
state (Value -> Either QueryError Value)
-> Value -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
toJSON a
i
Result a -> Either QueryError a
forall b. Result b -> Either QueryError b
resultToEither' (Result a -> Either QueryError a)
-> Result a -> Either QueryError a
forall a b. (a -> b) -> a -> b
$ Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
replaced where
resultToEither' :: Result b -> Either QueryError b
resultToEither' (Error FilePath
e) = QueryError -> Either QueryError b
forall a b. a -> Either a b
Left (QueryError -> Either QueryError b)
-> QueryError -> Either QueryError b
forall a b. (a -> b) -> a -> b
$ Text -> QueryError
QueryValidationError (Text -> QueryError) -> Text -> QueryError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
e
resultToEither' (Success b
a) = b -> Either QueryError b
forall a b. b -> Either a b
Right b
a
interpolateQueryString ::
CurlRunningsState -> FullQueryText -> Either QueryError T.Text
interpolateQueryString :: CurlRunningsState -> Text -> Either QueryError Text
interpolateQueryString CurlRunningsState
state Text
query =
let parsedQuery :: Either QueryError [InterpolatedQuery]
parsedQuery = Text -> Either QueryError [InterpolatedQuery]
parseQuery Text
query
in case Either QueryError [InterpolatedQuery]
parsedQuery of
(Left QueryError
err) -> QueryError -> Either QueryError Text
forall a b. a -> Either a b
Left QueryError
err
(Right [InterpolatedQuery]
interpolatedQ) ->
let [Either QueryError Text]
lookups :: [Either QueryError T.Text] =
(InterpolatedQuery -> Either QueryError Text)
-> [InterpolatedQuery] -> [Either QueryError Text]
forall a b. (a -> b) -> [a] -> [b]
map (CurlRunningsState -> InterpolatedQuery -> Either QueryError Text
getStringValueForQuery CurlRunningsState
state) [InterpolatedQuery]
interpolatedQ
failure :: Maybe (Either QueryError Text)
failure = (Either QueryError Text -> Bool)
-> [Either QueryError Text] -> Maybe (Either QueryError Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Either QueryError Text -> Bool
forall a b. Either a b -> Bool
isLeft [Either QueryError Text]
lookups
[Text]
goodLookups :: [T.Text] =
(Either QueryError Text -> Text)
-> [Either QueryError Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (Text -> Either QueryError Text -> Text
forall b a. b -> Either a b -> b
fromRight (FilePath -> Text
T.pack FilePath
"error")) [Either QueryError Text]
lookups
in Either QueryError Text
-> Maybe (Either QueryError Text) -> Either QueryError Text
forall a. a -> Maybe a -> a
fromMaybe (Text -> Either QueryError Text
forall a b. b -> Either a b
Right (Text -> Either QueryError Text) -> Text -> Either QueryError Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> Text) -> Text -> [Text] -> Text
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (FilePath -> Text
T.pack FilePath
"") [Text]
goodLookups) Maybe (Either QueryError Text)
failure
getStringValueForQuery ::
CurlRunningsState -> InterpolatedQuery -> Either QueryError T.Text
getStringValueForQuery :: CurlRunningsState -> InterpolatedQuery -> Either QueryError Text
getStringValueForQuery CurlRunningsState
_ (LiteralText Text
rawText) = Text -> Either QueryError Text
forall a b. b -> Either a b
Right Text
rawText
getStringValueForQuery CurlRunningsState
state (NonInterpolatedQuery Query
q) =
CurlRunningsState -> InterpolatedQuery -> Either QueryError Text
getStringValueForQuery CurlRunningsState
state (InterpolatedQuery -> Either QueryError Text)
-> InterpolatedQuery -> Either QueryError Text
forall a b. (a -> b) -> a -> b
$ Text -> Query -> InterpolatedQuery
InterpolatedQuery Text
"" Query
q
getStringValueForQuery CurlRunningsState
state i :: InterpolatedQuery
i@(InterpolatedQuery Text
rawText (Query [Index]
_)) =
case CurlRunningsState -> InterpolatedQuery -> Either QueryError Value
getValueForQuery CurlRunningsState
state InterpolatedQuery
i of
Left QueryError
l -> QueryError -> Either QueryError Text
forall a b. a -> Either a b
Left QueryError
l
Right (String Text
s) -> Text -> Either QueryError Text
forall a b. b -> Either a b
Right (Text -> Either QueryError Text) -> Text -> Either QueryError Text
forall a b. (a -> b) -> a -> b
$ Text
rawText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
(Right Value
o) -> QueryError -> Either QueryError Text
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Text)
-> QueryError -> Either QueryError Text
forall a b. (a -> b) -> a -> b
$ Text -> Value -> QueryError
QueryTypeMismatch Text
"Expected a string" Value
o
getStringValueForQuery (CurlRunningsState Environment
env [CaseResult]
_ LogLevel
_ TLSCheckType
_) (InterpolatedQuery Text
rawText (EnvironmentVariable Text
v)) =
Text -> Either QueryError Text
forall a b. b -> Either a b
Right (Text -> Either QueryError Text) -> Text -> Either QueryError Text
forall a b. (a -> b) -> a -> b
$ Text
rawText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> KeyType -> Environment -> Text
forall a. a -> KeyType -> MapType a -> a
A.findWithDefault Text
"" (Text -> KeyType
A.fromText Text
v) Environment
env
getValueForQuery ::
CurlRunningsState -> InterpolatedQuery -> Either QueryError Value
getValueForQuery :: CurlRunningsState -> InterpolatedQuery -> Either QueryError Value
getValueForQuery CurlRunningsState
_ (LiteralText Text
rawText) = Value -> Either QueryError Value
forall a b. b -> Either a b
Right (Value -> Either QueryError Value)
-> Value -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
rawText
getValueForQuery (CurlRunningsState Environment
_ [CaseResult]
previousResults LogLevel
_ TLSCheckType
_) full :: InterpolatedQuery
full@(NonInterpolatedQuery (Query [Index]
indexes)) =
case [Index] -> Index
forall a. [a] -> a
head [Index]
indexes of
(CaseResultIndex Integer
i) ->
let maybeCase :: Maybe CaseResult
maybeCase = [CaseResult] -> Int -> Maybe CaseResult
forall a. [a] -> Int -> Maybe a
arrayGet [CaseResult]
previousResults (Int -> Maybe CaseResult) -> Int -> Maybe CaseResult
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
in if Maybe CaseResult -> Bool
forall a. Maybe a -> Bool
isJust Maybe CaseResult
maybeCase
then let CasePass{Maybe Value
caseResponseValue :: CaseResult -> Maybe Value
caseResponseValue :: Maybe Value
caseResponseValue} = Maybe CaseResult -> CaseResult
forall a. HasCallStack => Maybe a -> a
fromJust Maybe CaseResult
maybeCase
jsonToIndex :: Either QueryError Value
jsonToIndex =
case Maybe Value
caseResponseValue of
Just Value
v -> Value -> Either QueryError Value
forall a b. b -> Either a b
Right Value
v
Maybe Value
Nothing ->
QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Value)
-> QueryError -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$
Text -> Text -> QueryError
NullPointer
(FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ InterpolatedQuery -> FilePath
forall a. Show a => a -> FilePath
show InterpolatedQuery
full)
Text
"No data was returned from this case"
in (Either QueryError Value -> Index -> Either QueryError Value)
-> Either QueryError Value -> [Index] -> Either QueryError Value
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
(\Either QueryError Value
eitherVal Index
index ->
case (Either QueryError Value
eitherVal, Index
index) of
(Left QueryError
l, Index
_) -> QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left QueryError
l
(Right (Object Object
o), KeyIndex Text
k) ->
Value -> Either QueryError Value
forall a b. b -> Either a b
Right (Value -> Either QueryError Value)
-> Value -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ Value -> KeyType -> Object -> Value
forall a. a -> KeyType -> MapType a -> a
A.findWithDefault Value
Null (Text -> KeyType
A.fromText Text
k :: A.KeyType) Object
o
(Right (Array Array
a), ArrayIndex Integer
i') ->
Either QueryError Value
-> (Value -> Either QueryError Value)
-> Maybe Value
-> Either QueryError Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Value)
-> QueryError -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$
Text -> Text -> QueryError
NullPointer (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ InterpolatedQuery -> FilePath
forall a. Show a => a -> FilePath
show InterpolatedQuery
full) (Text -> QueryError) -> Text -> QueryError
forall a b. (a -> b) -> a -> b
$
Text
"Array index not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i'))
Value -> Either QueryError Value
forall a b. b -> Either a b
Right
([Value] -> Int -> Maybe Value
forall a. [a] -> Int -> Maybe a
arrayGet (Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
a) (Int -> Maybe Value) -> Int -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i')
(Right Value
Null, Index
q) ->
QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Value)
-> QueryError -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$
Text -> Text -> QueryError
NullPointer (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ InterpolatedQuery -> FilePath
forall a. Show a => a -> FilePath
show InterpolatedQuery
full) (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Index -> FilePath
forall a. Show a => a -> FilePath
show Index
q)
(Right Value
o, Index
_) ->
QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Value)
-> QueryError -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> QueryError
QueryTypeMismatch (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Index -> FilePath
forall a. Show a => a -> FilePath
show Index
index) Value
o)
Either QueryError Value
jsonToIndex
([Index] -> [Index]
forall a. [a] -> [a]
tail [Index]
indexes)
else QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Value)
-> QueryError -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$
Text -> Text -> QueryError
NullPointer (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ InterpolatedQuery -> FilePath
forall a. Show a => a -> FilePath
show InterpolatedQuery
full) (Text -> QueryError) -> Text -> QueryError
forall a b. (a -> b) -> a -> b
$
Text
"Attempted to index into previous a test case that didn't exist: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Text
T.pack (Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
i)
Index
_ ->
QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Value)
-> (Text -> QueryError) -> Text -> Either QueryError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> QueryError
QueryValidationError (Text -> Either QueryError Value)
-> Text -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$
FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$
FilePath
"'$< ... >' queries must start with a RESPONSES[index] query: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
InterpolatedQuery -> FilePath
forall a. Show a => a -> FilePath
show InterpolatedQuery
full
getValueForQuery (CurlRunningsState Environment
env [CaseResult]
_ LogLevel
_ TLSCheckType
_) (NonInterpolatedQuery (EnvironmentVariable Text
var)) =
Value -> Either QueryError Value
forall a b. b -> Either a b
Right (Value -> Either QueryError Value)
-> (Text -> Value) -> Text -> Either QueryError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Either QueryError Value)
-> Text -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ Text -> KeyType -> Environment -> Text
forall a. a -> KeyType -> MapType a -> a
A.findWithDefault Text
"" (Text -> KeyType
A.fromText Text
var) Environment
env
getValueForQuery CurlRunningsState
state (InterpolatedQuery Text
_ Query
q) =
case CurlRunningsState -> InterpolatedQuery -> Either QueryError Value
getValueForQuery CurlRunningsState
state (Query -> InterpolatedQuery
NonInterpolatedQuery Query
q) of
Right (String Text
s) -> Value -> Either QueryError Value
forall a b. b -> Either a b
Right (Value -> Either QueryError Value)
-> (Text -> Value) -> Text -> Either QueryError Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Either QueryError Value)
-> Text -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ Text
s
Right Value
Null -> Value -> Either QueryError Value
forall a b. b -> Either a b
Right Value
Null
Right Value
v -> QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left (QueryError -> Either QueryError Value)
-> QueryError -> Either QueryError Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> QueryError
QueryTypeMismatch (FilePath -> Text
T.pack FilePath
"Expected a string") Value
v
Left QueryError
l -> QueryError -> Either QueryError Value
forall a b. a -> Either a b
Left QueryError
l
jsonContains ::
((JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool)
-> Value
-> [JsonSubExpr]
-> Bool
jsonContains :: ((JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool)
-> Value -> [JsonSubExpr] -> Bool
jsonContains (JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool
f Value
jsonValue =
let traversedValue :: [Value]
traversedValue = Value -> [Value]
traverseValue Value
jsonValue
in (JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool
f ((JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool)
-> (JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool
forall a b. (a -> b) -> a -> b
$ \JsonSubExpr
match' ->
case JsonSubExpr
match' of
ValueMatch Value
subval -> Value
subval Value -> [Value] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Value]
traversedValue
KeyMatch Text
key -> (Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Value -> KeyType -> Bool
`containsKey` (Text -> KeyType
A.fromText Text
key)) [Value]
traversedValue
KeyValueMatch Text
key Value
subval ->
(Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Value
o -> Value -> KeyType -> Value -> Bool
containsKeyVal Value
o (Text -> KeyType
A.fromText Text
key) Value
subval) [Value]
traversedValue
jsonContainsAll :: Value -> [JsonSubExpr] -> Bool
jsonContainsAll :: Value -> [JsonSubExpr] -> Bool
jsonContainsAll = ((JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool)
-> Value -> [JsonSubExpr] -> Bool
jsonContains (JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
jsonContainsAny :: Value -> [JsonSubExpr] -> Bool
jsonContainsAny :: Value -> [JsonSubExpr] -> Bool
jsonContainsAny = ((JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool)
-> Value -> [JsonSubExpr] -> Bool
jsonContains (JsonSubExpr -> Bool) -> [JsonSubExpr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
containsKeyVal :: Value -> A.KeyType -> Value -> Bool
containsKeyVal :: Value -> KeyType -> Value -> Bool
containsKeyVal Value
jsonValue KeyType
key Value
val =
case Value
jsonValue of
Object Object
o -> KeyType -> Object -> Maybe Value
forall v. KeyType -> KeyMap v -> Maybe v
A.lookup KeyType
key Object
o Maybe Value -> Maybe Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value -> Maybe Value
forall a. a -> Maybe a
Just Value
val
Value
_ -> Bool
False
containsKey :: Value -> A.KeyType -> Bool
containsKey :: Value -> KeyType -> Bool
containsKey Value
jsonValue KeyType
key =
case Value
jsonValue of
Object Object
o -> Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Value -> Bool) -> Maybe Value -> Bool
forall a b. (a -> b) -> a -> b
$ KeyType -> Object -> Maybe Value
forall v. KeyType -> KeyMap v -> Maybe v
A.lookup KeyType
key Object
o
Value
_ -> Bool
False
traverseValue :: Value -> [Value]
traverseValue :: Value -> [Value]
traverseValue Value
val =
case Value
val of
Object Object
o -> Value
val Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (Value -> [Value]) -> [Value] -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Value]
traverseValue (Object -> [Value]
forall v. KeyMap v -> [v]
A.elems Object
o)
Array Array
o -> Value
val Value -> [Value] -> [Value]
forall a. a -> [a] -> [a]
: (Value -> [Value]) -> Array -> [Value]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Value -> [Value]
traverseValue Array
o
n :: Value
n@(Number Scientific
_) -> [Value
n]
s :: Value
s@(String Text
_) -> [Value
s]
b :: Value
b@(Bool Bool
_) -> [Value
b]
Value
Null -> []
checkCode :: CurlCase -> Int -> Maybe AssertionFailure
checkCode :: CurlCase -> Int -> Maybe AssertionFailure
checkCode curlCase :: CurlCase
curlCase@CurlCase { expectStatus :: CurlCase -> StatusCodeMatcher
expectStatus = (ExactCode Int
expectedCode) } Int
receivedCode
| Int
expectedCode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
receivedCode = AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$ CurlCase -> Int -> AssertionFailure
StatusFailure CurlCase
curlCase Int
receivedCode
| Bool
otherwise = Maybe AssertionFailure
forall a. Maybe a
Nothing
checkCode curlCase :: CurlCase
curlCase@CurlCase { expectStatus :: CurlCase -> StatusCodeMatcher
expectStatus = (AnyCodeIn [Int]
l) } Int
receivedCode
| Int
receivedCode Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
l = AssertionFailure -> Maybe AssertionFailure
forall a. a -> Maybe a
Just (AssertionFailure -> Maybe AssertionFailure)
-> AssertionFailure -> Maybe AssertionFailure
forall a b. (a -> b) -> a -> b
$ CurlCase -> Int -> AssertionFailure
StatusFailure CurlCase
curlCase Int
receivedCode
| Bool
otherwise = Maybe AssertionFailure
forall a. Maybe a
Nothing
fromHTTPHeaders :: HTTP.ResponseHeaders -> Headers
RequestHeaders
rh = [Header] -> Headers
HeaderSet ([Header] -> Headers) -> [Header] -> Headers
forall a b. (a -> b) -> a -> b
$ ((HeaderName, ByteString) -> Header) -> RequestHeaders -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName, ByteString) -> Header
fromHTTPHeader RequestHeaders
rh
fromHTTPHeader :: HTTP.Header -> Header
(HeaderName
a, ByteString
b) =
Text -> Text -> Header
Header (FilePath -> Text
T.pack (FilePath -> Text)
-> (ByteString -> FilePath) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
B8S.unpack (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString
forall s. CI s -> s
CI.original HeaderName
a) (FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
B8S.unpack ByteString
b)
toHTTPHeader :: Header -> HTTP.Header
(Header Text
a Text
b) =
(ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> HeaderName)
-> (FilePath -> ByteString) -> FilePath -> HeaderName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
B8S.pack (FilePath -> HeaderName) -> FilePath -> HeaderName
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
a, FilePath -> ByteString
B8S.pack (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
b)
toHTTPHeaders :: Headers -> HTTP.RequestHeaders
(HeaderSet [Header]
h) = (Header -> (HeaderName, ByteString)) -> [Header] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map Header -> (HeaderName, ByteString)
toHTTPHeader [Header]
h