{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Test.Amazonka.Fixture
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Test.Amazonka.Fixture where

import Amazonka.Core
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 :: 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 (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
    TestName -> IO ByteString
LBS.readFile TestName
f
      IO ByteString
-> (ByteString -> IO (Either TestName (AWSResponse a)))
-> IO (Either TestName (AWSResponse a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Service
-> Proxy a -> ByteString -> IO (Either TestName (AWSResponse a))
forall a.
AWSRequest a =>
Service
-> Proxy a -> ByteString -> IO (Either TestName (AWSResponse a))
testResponse Service
s Proxy a
p
      IO (Either TestName (AWSResponse a))
-> (Either TestName (AWSResponse a) -> Assertion) -> Assertion
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TestName
-> AWSResponse a -> Either TestName (AWSResponse a) -> Assertion
forall a.
(Eq a, Show a) =>
TestName -> a -> Either TestName a -> Assertion
assertDiff TestName
f AWSResponse a
e

req ::
  (AWSRequest a, Eq a, Show a) =>
  TestName ->
  FilePath ->
  a ->
  TestTree
req :: TestName -> TestName -> a -> TestTree
req TestName
n TestName
f a
e = TestName -> Assertion -> TestTree
testCase TestName
n (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
  Either ParseException Req
a <- TestName -> IO (Either ParseException Req)
forall a. FromJSON a => TestName -> IO (Either ParseException a)
YAML.decodeFileEither TestName
f
  Req
e' <- IO Req
expected
  TestName -> Req -> Either TestName Req -> Assertion
forall a.
(Eq a, Show a) =>
TestName -> a -> Either TestName a -> Assertion
assertDiff TestName
f Req
e' ((ParseException -> TestName)
-> Either ParseException Req -> Either TestName Req
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParseException -> TestName
forall a. Show a => a -> TestName
show Either ParseException Req
a)
  where
    expected :: IO Req
expected = do
      let x :: ClientRequest
x = Signed a -> ClientRequest
forall a. Signed a -> ClientRequest
signedRequest (Algorithm a
forall a. Algorithm a
requestSign (a -> Request a
forall a. AWSRequest a => a -> Request a
request a
e) AuthEnv
auth Region
NorthVirginia UTCTime
time)
      ByteString
b <- RequestBody -> IO ByteString
sink (ClientRequest -> RequestBody
Client.requestBody ClientRequest
x)
      Req -> IO Req
forall (m :: * -> *) a. Monad m => a -> m a
return
        (Req -> IO Req) -> Req -> IO Req
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 -> ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> ByteString
forall a. ToByteString a => a -> ByteString
toBS ByteString
lbs)
      Client.RequestBodyBS ByteString
bs -> ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
      Client.RequestBodyBuilder Int64
_ Builder
b -> ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> ByteString
forall a. ToByteString a => a -> ByteString
toBS Builder
b)
      RequestBody
_ -> TestName -> IO ByteString
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 :: Service
-> Proxy a -> ByteString -> IO (Either TestName (AWSResponse a))
testResponse Service
s Proxy a
p ByteString
lbs = do
  Either Error (Response (AWSResponse a))
y <- ResourceT IO (Either Error (Response (AWSResponse a)))
-> IO (Either Error (Response (AWSResponse a)))
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (Logger
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> ResourceT IO (Either Error (Response (AWSResponse a)))
forall a (m :: * -> *).
(AWSRequest a, MonadResource m) =>
Logger
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
response Logger
forall (m :: * -> *) p p. Monad m => p -> p -> m ()
l Service
s Proxy a
p ClientResponse ClientBody
rs)

  Either TestName (AWSResponse a)
-> IO (Either TestName (AWSResponse a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TestName (AWSResponse a)
 -> IO (Either TestName (AWSResponse a)))
-> Either TestName (AWSResponse a)
-> IO (Either TestName (AWSResponse a))
forall a b. (a -> b) -> a -> b
$! (Error -> TestName)
-> Either Error (AWSResponse a) -> Either TestName (AWSResponse a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Error -> TestName
forall a. Show a => a -> TestName
show (Response (AWSResponse a) -> AWSResponse a
forall body. Response body -> body
Client.responseBody (Response (AWSResponse a) -> AWSResponse a)
-> Either Error (Response (AWSResponse a))
-> Either Error (AWSResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either Error (Response (AWSResponse a))
y)
  where
    l :: p -> p -> m ()
l p
_ p
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    rs :: ClientResponse ClientBody
rs =
      Response :: forall body.
Status
-> HttpVersion
-> [Header]
-> body
-> CookieJar
-> ResponseClose
-> Response body
Client.Response
        { responseStatus :: Status
responseStatus = Status
HTTP.status200,
          responseVersion :: HttpVersion
responseVersion = HttpVersion
HTTP.http11,
          responseHeaders :: [Header]
responseHeaders = [Header]
forall a. Monoid a => a
mempty,
          responseBody :: ClientBody
responseBody = ByteString -> ClientBody
forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
Conduit.sourceLbs ByteString
lbs,
          responseCookieJar :: CookieJar
responseCookieJar = CookieJar
forall a. Monoid a => a
mempty,
          responseClose' :: ResponseClose
responseClose' = Assertion -> ResponseClose
Client.ResponseClose (() -> Assertion
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" Maybe (Sensitive SessionToken)
forall a. Maybe a
Nothing Maybe ISO8601
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,
    Req -> [Header]
_headers :: [Header],
    Req -> ByteString
_body :: ByteString
  }
  deriving (Req -> Req -> Bool
(Req -> Req -> Bool) -> (Req -> Req -> Bool) -> Eq Req
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
(Int -> Req -> ShowS)
-> (Req -> TestName) -> ([Req] -> ShowS) -> Show Req
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. Req -> Rep Req x)
-> (forall x. Rep Req x -> Req) -> Generic Req
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 ([Header] -> [Header]
forall a b. Ord a => [(a, b)] -> [(a, b)]
sortKeys [Header]
h)

instance FromJSON Req where
  parseJSON :: Value -> Parser Req
parseJSON = TestName -> (Object -> Parser Req) -> Value -> Parser Req
forall a. TestName -> (Object -> Parser a) -> Value -> Parser a
withObject TestName
"req" ((Object -> Parser Req) -> Value -> Parser Req)
-> (Object -> Parser Req) -> Value -> Parser Req
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [(Text, Text)]
headers <- Object
o Object -> Text -> Parser (Maybe [(Text, Text)])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"headers" Parser (Maybe [(Text, Text)])
-> [(Text, Text)] -> Parser [(Text, Text)]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [(Text, Text)]
forall a. Monoid a => a
mempty

    ByteString
-> ByteString -> ByteString -> [Header] -> ByteString -> Req
mkReq
      (ByteString
 -> ByteString -> ByteString -> [Header] -> ByteString -> Req)
-> Parser ByteString
-> Parser
     (ByteString -> ByteString -> [Header] -> ByteString -> Req)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ByteString
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"method"
      Parser (ByteString -> ByteString -> [Header] -> ByteString -> Req)
-> Parser ByteString
-> Parser (ByteString -> [Header] -> ByteString -> Req)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ByteString)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"path" Parser (Maybe ByteString) -> ByteString -> Parser ByteString
forall a. Parser (Maybe a) -> a -> Parser a
.!= ByteString
"/")
      Parser (ByteString -> [Header] -> ByteString -> Req)
-> Parser ByteString -> Parser ([Header] -> ByteString -> Req)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ByteString)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"query" Parser (Maybe ByteString) -> ByteString -> Parser ByteString
forall a. Parser (Maybe a) -> a -> Parser a
.!= ByteString
forall a. Monoid a => a
mempty)
      Parser ([Header] -> ByteString -> Req)
-> Parser [Header] -> Parser (ByteString -> Req)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Header] -> Parser [Header]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((Text, Text) -> Header) -> [(Text, Text)] -> [Header]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> CI ByteString)
-> (Text -> ByteString) -> (Text, Text) -> Header
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> (Text -> ByteString) -> Text -> CI ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8) Text -> ByteString
Text.encodeUtf8) [(Text, Text)]
headers)
      Parser (ByteString -> Req) -> Parser ByteString -> Parser Req
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Text -> Parser (Maybe ByteString)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"body" Parser (Maybe ByteString) -> ByteString -> Parser ByteString
forall a. Parser (Maybe a) -> a -> Parser a
.!= ByteString
forall a. Monoid a => a
mempty)

sortKeys :: Ord a => [(a, b)] -> [(a, b)]
sortKeys :: [(a, b)] -> [(a, b)]
sortKeys = ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing (a, b) -> a
forall a b. (a, b) -> a
fst)