{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Test.Amazonka.Fixture where
import Amazonka.Core
import Amazonka.Data
import Amazonka.Prelude
import Control.Monad.Trans.Resource
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.Conduit.Binary as Conduit
import qualified Data.List as List
import qualified Data.Ord as Ord
import qualified Data.Text.Encoding as Text
import qualified Data.Yaml as YAML
import qualified Network.HTTP.Client.Internal as Client
import Network.HTTP.Types (Method)
import qualified Network.HTTP.Types as HTTP
import Test.Amazonka.Assert
import Test.Amazonka.Orphans ()
import Test.Amazonka.TH
import Test.Tasty
import Test.Tasty.HUnit
res ::
(AWSRequest a, Eq (AWSResponse a), Show (AWSResponse a)) =>
TestName ->
FilePath ->
Service ->
Proxy a ->
AWSResponse a ->
TestTree
res :: forall a.
(AWSRequest a, Eq (AWSResponse a), Show (AWSResponse a)) =>
TestName
-> TestName -> Service -> Proxy a -> AWSResponse a -> TestTree
res TestName
n TestName
f Service
s Proxy a
p AWSResponse a
e =
TestName -> Assertion -> TestTree
testCase TestName
n forall a b. (a -> b) -> a -> b
$
TestName -> IO ByteString
LBS.readFile TestName
f
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
AWSRequest a =>
Service
-> Proxy a -> ByteString -> IO (Either TestName (AWSResponse a))
testResponse Service
s Proxy a
p
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a.
(Eq a, Show a) =>
TestName -> a -> Either TestName a -> Assertion
assertDiff TestName
f AWSResponse a
e
req ::
forall a.
(AWSRequest a, Eq a, Show a) =>
TestName ->
FilePath ->
a ->
TestTree
req :: forall a.
(AWSRequest a, Eq a, Show a) =>
TestName -> TestName -> a -> TestTree
req TestName
n TestName
f a
e = TestName -> Assertion -> TestTree
testCase TestName
n forall a b. (a -> b) -> a -> b
$ do
Either ParseException Req
a <- forall a. FromJSON a => TestName -> IO (Either ParseException a)
YAML.decodeFileEither TestName
f
Req
e' <- IO Req
expected
forall a.
(Eq a, Show a) =>
TestName -> a -> Either TestName a -> Assertion
assertDiff TestName
f Req
e' (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> TestName
show Either ParseException Req
a)
where
expected :: IO Req
expected = do
let x :: ClientRequest
x = forall a. Signed a -> ClientRequest
signedRequest (forall a. Algorithm a
requestSign (forall a. AWSRequest a => (Service -> Service) -> a -> Request a
request forall a. a -> a
id a
e) AuthEnv
auth Region
NorthVirginia UTCTime
time)
ByteString
b <- RequestBody -> IO ByteString
sink (ClientRequest -> RequestBody
Client.requestBody ClientRequest
x)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$!
ByteString
-> ByteString -> ByteString -> [Header] -> ByteString -> Req
mkReq
(ClientRequest -> ByteString
Client.method ClientRequest
x)
(ClientRequest -> ByteString
Client.path ClientRequest
x)
(ClientRequest -> ByteString
Client.queryString ClientRequest
x)
(ClientRequest -> [Header]
Client.requestHeaders ClientRequest
x)
ByteString
b
sink :: RequestBody -> IO ByteString
sink = \case
Client.RequestBodyLBS ByteString
lbs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. ToByteString a => a -> ByteString
toBS ByteString
lbs)
Client.RequestBodyBS ByteString
bs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
Client.RequestBodyBuilder Int64
_ Builder
b -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. ToByteString a => a -> ByteString
toBS Builder
b)
RequestBody
_ -> forall (m :: * -> *) a. MonadFail m => TestName -> m a
fail TestName
"Streaming body not supported."
testResponse ::
forall a.
AWSRequest a =>
Service ->
Proxy a ->
ByteStringLazy ->
IO (Either String (AWSResponse a))
testResponse :: forall a.
AWSRequest a =>
Service
-> Proxy a -> ByteString -> IO (Either TestName (AWSResponse a))
testResponse Service
s Proxy a
p ByteString
lbs = do
Either Error (Response (AWSResponse a))
y <- forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (forall a (m :: * -> *).
(AWSRequest a, MonadResource m) =>
(ByteString -> IO ByteString)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
response forall (f :: * -> *) a. Applicative f => a -> f a
pure Service
s Proxy a
p ClientResponse ClientBody
rs)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Show a => a -> TestName
show (forall body. Response body -> body
Client.responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Error (Response (AWSResponse a))
y)
where
rs :: ClientResponse ClientBody
rs =
Client.Response
{ responseStatus :: Status
responseStatus = Status
HTTP.status200,
responseVersion :: HttpVersion
responseVersion = HttpVersion
HTTP.http11,
responseHeaders :: [Header]
responseHeaders = forall a. Monoid a => a
mempty,
responseBody :: ClientBody
responseBody = forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
Conduit.sourceLbs ByteString
lbs,
responseCookieJar :: CookieJar
responseCookieJar = forall a. Monoid a => a
mempty,
responseClose' :: ResponseClose
responseClose' = Assertion -> ResponseClose
Client.ResponseClose (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
}
auth :: AuthEnv
auth :: AuthEnv
auth = AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv AccessKey
"access" Sensitive SecretKey
"secret" forall a. Maybe a
Nothing forall a. Maybe a
Nothing
time :: UTCTime
time :: UTCTime
time = $(mkTime "2009-10-28T22:32:00Z")
data Req = Req
{ Req -> ByteString
_method :: Method,
Req -> ByteString
_path :: ByteString,
Req -> ByteString
_query :: ByteString,
:: [Header],
Req -> ByteString
_body :: ByteString
}
deriving (Req -> Req -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Req -> Req -> Bool
$c/= :: Req -> Req -> Bool
== :: Req -> Req -> Bool
$c== :: Req -> Req -> Bool
Eq, Int -> Req -> ShowS
[Req] -> ShowS
Req -> TestName
forall a.
(Int -> a -> ShowS) -> (a -> TestName) -> ([a] -> ShowS) -> Show a
showList :: [Req] -> ShowS
$cshowList :: [Req] -> ShowS
show :: Req -> TestName
$cshow :: Req -> TestName
showsPrec :: Int -> Req -> ShowS
$cshowsPrec :: Int -> Req -> ShowS
Show, forall x. Rep Req x -> Req
forall x. Req -> Rep Req x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Req x -> Req
$cfrom :: forall x. Req -> Rep Req x
Generic)
mkReq :: Method -> ByteString -> ByteString -> [Header] -> ByteString -> Req
mkReq :: ByteString
-> ByteString -> ByteString -> [Header] -> ByteString -> Req
mkReq ByteString
m ByteString
p ByteString
q [Header]
h = ByteString
-> ByteString -> ByteString -> [Header] -> ByteString -> Req
Req ByteString
m ByteString
p ByteString
q (forall a b. Ord a => [(a, b)] -> [(a, b)]
sortKeys [Header]
h)
instance FromJSON Req where
parseJSON :: Value -> Parser Req
parseJSON = forall a. TestName -> (Object -> Parser a) -> Value -> Parser a
withObject TestName
"req" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
[(Text, Text)]
headers <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"headers" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty
ByteString
-> ByteString -> ByteString -> [Header] -> ByteString -> Req
mkReq
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"method"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path" forall a. Parser (Maybe a) -> a -> Parser a
.!= ByteString
"/")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"query" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall s. FoldCase s => s -> CI s
CI.mk forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) Text -> ByteString
Text.encodeUtf8) [(Text, Text)]
headers)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body" forall a. Parser (Maybe a) -> a -> Parser a
.!= forall a. Monoid a => a
mempty)
sortKeys :: Ord a => [(a, b)] -> [(a, b)]
sortKeys :: forall a b. Ord a => [(a, b)] -> [(a, b)]
sortKeys = forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing forall a b. (a, b) -> a
fst)