{-# 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-2023 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.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,
    Req -> [Header]
_headers :: [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)