{-# LANGUAGE BangPatterns             #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE NamedFieldPuns           #-}
{-# LANGUAGE OverloadedStrings        #-}
{-# LANGUAGE ScopedTypeVariables      #-}


-- | curl-runnings is a framework for writing declaratively writing curl based tests for your API's.
-- Write your test specifications with yaml or json, and you're done!
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

-- | decode a json, yaml, or dhall file into a suite object
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
  }

-- | Fetch existing query parameters from the request and append those specfied in the queryParameters field.
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
-- TODO - for backwards compatability, empty requests will set an empty json
-- payload. Given that we support multiple content types, this funtionality
-- isn't exactly correct anymore. This behavior should be considered
-- deprecated and will be updated with the next major version release of
-- curl-runnings.
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))

-- | Run a single test case, and returns the result. IO is needed here since this method is responsible
-- for actually curling the test case endpoint and parsing the result.
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
          -- If the response is just returning bytes, we won't print them
          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))
              -- TODO: we should log as much info as possible without printing the raw body
            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
checkHeaders :: CurlRunningsState -> CurlCase -> Headers -> Maybe AssertionFailure
checkHeaders 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
interpolatePartialHeader :: CurlRunningsState
-> PartialHeaderMatcher -> Either QueryError PartialHeaderMatcher
interpolatePartialHeader 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
interpolateHeaders :: CurlRunningsState
-> Maybe Authentication -> Headers -> Either QueryError Headers
interpolateHeaders 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

-- | Does this header contain our matcher?
headerMatches :: PartialHeaderMatcher -> Header -> Bool
headerMatches :: PartialHeaderMatcher -> Header -> Bool
headerMatches (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

-- | Does any of these headers contain our matcher?
headerIn :: Headers -> PartialHeaderMatcher -> Bool
headerIn :: Headers -> PartialHeaderMatcher -> Bool
headerIn (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

-- | Runs the test cases in order and stop when an error is hit. Returns all the results
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)

-- | Check if the retrieved value fail's the case's assertion
checkBody ::
     CurlRunningsState -> CurlCase -> Maybe Value -> Maybe AssertionFailure
-- | We are looking for an exact payload match, and we have a payload to check
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
-- | We are checking a list of expected subvalues, and we have a payload to check
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)
-- | We are checking a list of expected absent subvalues, and we have a payload to check
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
-- | We are checking for both contains and notContains vals, and we have a payload to check
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
-- | We expected a body but didn't get one
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
-- | No assertions on the body
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
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
              -- (old key, new key, new value)
             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)
            -- TODO there should be a more elegant way to write this error
            -- handling below
                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
-- special case, i can't figure out how to get the parser to parse empty strings :'(
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

-- | Given an instance of both ToJSON and FromJSON return a new instance with
-- interpolated values.
-- NB: interpolateViaJSON assumes that fromJSON . toJSON is identity
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

-- | Given a query string, return some text with interpolated values. Type
-- errors will be returned if queries don't resolve to strings
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

-- | Lookup the text at the specified query
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

-- | Lookup the value for the specified query
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

-- | Does the json value contain all of these sub-values?
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

-- | Does the json value contain any of these sub-values?
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

-- | Does the json value contain the given key value pair?
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

-- | Does the json value contain the given key value pair?
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

-- | Fully traverse the json and return a list of all the values
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         -> []

-- | Verify the returned http status code is ok, construct the right failure
-- type if needed
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

-- | Utility conversion from HTTP headers to CurlRunnings headers.
fromHTTPHeaders :: HTTP.ResponseHeaders -> Headers
fromHTTPHeaders :: RequestHeaders -> Headers
fromHTTPHeaders 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

-- | Utility conversion from an HTTP header to a CurlRunnings header.
fromHTTPHeader :: HTTP.Header -> Header
fromHTTPHeader :: (HeaderName, ByteString) -> Header
fromHTTPHeader (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)

-- | Utility conversion from an HTTP header to a CurlRunnings header.
toHTTPHeader :: Header -> HTTP.Header
toHTTPHeader :: Header -> (HeaderName, ByteString)
toHTTPHeader (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)

-- | Utility conversion from CurlRunnings headers to HTTP headers.
toHTTPHeaders :: Headers -> HTTP.RequestHeaders
toHTTPHeaders :: Headers -> RequestHeaders
toHTTPHeaders (HeaderSet [Header]
h) = (Header -> (HeaderName, ByteString)) -> [Header] -> RequestHeaders
forall a b. (a -> b) -> [a] -> [b]
map Header -> (HeaderName, ByteString)
toHTTPHeader [Header]
h