{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module serves the purpose of defining common functionality which remains the same across all OpenAPI specifications.
module StripeAPI.Common
  ( doCallWithConfiguration,
    doCallWithConfigurationM,
    doBodyCallWithConfiguration,
    doBodyCallWithConfigurationM,
    runWithConfiguration,
    textToByte,
    stringifyModel,
    anonymousSecurityScheme,
    Configuration (..),
    SecurityScheme,
    MonadHTTP (..),
    StringifyModel,
    JsonByteString (..),
    JsonDateTime (..),
    RequestBodyEncoding (..),
    QueryParameter (..),
    StripeT (..),
    StripeM,
  )
where

import qualified Control.Monad.IO.Class as MIO
import qualified Control.Monad.Reader as MR
import qualified Control.Monad.Trans.Class as MT
import qualified Data.Aeson as Aeson
import qualified Data.Bifunctor as BF
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy.Char8 as LB8
import qualified Data.HashMap.Strict as HMap
import qualified Data.Maybe as Maybe
import qualified Data.Scientific as Scientific
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Time.LocalTime as Time
import qualified Data.Vector as Vector
import qualified Network.HTTP.Client as HC
import qualified Network.HTTP.Simple as HS

-- | Abstracts the usage of 'Network.HTTP.Simple.httpBS' away,
--  so that it can be used for testing
class Monad m => MonadHTTP m where
  httpBS :: HS.Request -> m (HS.Response B8.ByteString)

-- | This instance is the default instance used for production code
instance MonadHTTP IO where
  httpBS :: Request -> IO (Response ByteString)
httpBS = Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HS.httpBS

instance MonadHTTP m => MonadHTTP (MR.ReaderT r m) where
  httpBS :: Request -> ReaderT r m (Response ByteString)
httpBS = m (Response ByteString) -> ReaderT r m (Response ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m (Response ByteString) -> ReaderT r m (Response ByteString))
-> (Request -> m (Response ByteString))
-> Request
-> ReaderT r m (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS

instance MonadHTTP m => MonadHTTP (StripeT m) where
  httpBS :: Request -> StripeT m (Response ByteString)
httpBS = m (Response ByteString) -> StripeT m (Response ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m (Response ByteString) -> StripeT m (Response ByteString))
-> (Request -> m (Response ByteString))
-> Request
-> StripeT m (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS

-- | The monad in which the operations can be run.
-- Contains the 'Configuration' to run the requests with.
--
-- Run it with 'runWithConfiguration'
newtype StripeT m a = StripeT (MR.ReaderT Configuration m a)
  deriving (a -> StripeT m b -> StripeT m a
(a -> b) -> StripeT m a -> StripeT m b
(forall a b. (a -> b) -> StripeT m a -> StripeT m b)
-> (forall a b. a -> StripeT m b -> StripeT m a)
-> Functor (StripeT m)
forall a b. a -> StripeT m b -> StripeT m a
forall a b. (a -> b) -> StripeT m a -> StripeT m b
forall (m :: * -> *) a b.
Functor m =>
a -> StripeT m b -> StripeT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> StripeT m a -> StripeT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> StripeT m b -> StripeT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> StripeT m b -> StripeT m a
fmap :: (a -> b) -> StripeT m a -> StripeT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> StripeT m a -> StripeT m b
Functor, Functor (StripeT m)
a -> StripeT m a
Functor (StripeT m)
-> (forall a. a -> StripeT m a)
-> (forall a b. StripeT m (a -> b) -> StripeT m a -> StripeT m b)
-> (forall a b c.
    (a -> b -> c) -> StripeT m a -> StripeT m b -> StripeT m c)
-> (forall a b. StripeT m a -> StripeT m b -> StripeT m b)
-> (forall a b. StripeT m a -> StripeT m b -> StripeT m a)
-> Applicative (StripeT m)
StripeT m a -> StripeT m b -> StripeT m b
StripeT m a -> StripeT m b -> StripeT m a
StripeT m (a -> b) -> StripeT m a -> StripeT m b
(a -> b -> c) -> StripeT m a -> StripeT m b -> StripeT m c
forall a. a -> StripeT m a
forall a b. StripeT m a -> StripeT m b -> StripeT m a
forall a b. StripeT m a -> StripeT m b -> StripeT m b
forall a b. StripeT m (a -> b) -> StripeT m a -> StripeT m b
forall a b c.
(a -> b -> c) -> StripeT m a -> StripeT m b -> StripeT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (StripeT m)
forall (m :: * -> *) a. Applicative m => a -> StripeT m a
forall (m :: * -> *) a b.
Applicative m =>
StripeT m a -> StripeT m b -> StripeT m a
forall (m :: * -> *) a b.
Applicative m =>
StripeT m a -> StripeT m b -> StripeT m b
forall (m :: * -> *) a b.
Applicative m =>
StripeT m (a -> b) -> StripeT m a -> StripeT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> StripeT m a -> StripeT m b -> StripeT m c
<* :: StripeT m a -> StripeT m b -> StripeT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
StripeT m a -> StripeT m b -> StripeT m a
*> :: StripeT m a -> StripeT m b -> StripeT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
StripeT m a -> StripeT m b -> StripeT m b
liftA2 :: (a -> b -> c) -> StripeT m a -> StripeT m b -> StripeT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> StripeT m a -> StripeT m b -> StripeT m c
<*> :: StripeT m (a -> b) -> StripeT m a -> StripeT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
StripeT m (a -> b) -> StripeT m a -> StripeT m b
pure :: a -> StripeT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> StripeT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (StripeT m)
Applicative, Applicative (StripeT m)
a -> StripeT m a
Applicative (StripeT m)
-> (forall a b. StripeT m a -> (a -> StripeT m b) -> StripeT m b)
-> (forall a b. StripeT m a -> StripeT m b -> StripeT m b)
-> (forall a. a -> StripeT m a)
-> Monad (StripeT m)
StripeT m a -> (a -> StripeT m b) -> StripeT m b
StripeT m a -> StripeT m b -> StripeT m b
forall a. a -> StripeT m a
forall a b. StripeT m a -> StripeT m b -> StripeT m b
forall a b. StripeT m a -> (a -> StripeT m b) -> StripeT m b
forall (m :: * -> *). Monad m => Applicative (StripeT m)
forall (m :: * -> *) a. Monad m => a -> StripeT m a
forall (m :: * -> *) a b.
Monad m =>
StripeT m a -> StripeT m b -> StripeT m b
forall (m :: * -> *) a b.
Monad m =>
StripeT m a -> (a -> StripeT m b) -> StripeT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> StripeT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> StripeT m a
>> :: StripeT m a -> StripeT m b -> StripeT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
StripeT m a -> StripeT m b -> StripeT m b
>>= :: StripeT m a -> (a -> StripeT m b) -> StripeT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
StripeT m a -> (a -> StripeT m b) -> StripeT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (StripeT m)
Monad, MR.MonadReader Configuration)

instance MT.MonadTrans StripeT where
  lift :: m a -> StripeT m a
lift = ReaderT Configuration m a -> StripeT m a
forall (m :: * -> *) a. ReaderT Configuration m a -> StripeT m a
StripeT (ReaderT Configuration m a -> StripeT m a)
-> (m a -> ReaderT Configuration m a) -> m a -> StripeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT Configuration m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift

instance MIO.MonadIO m => MIO.MonadIO (StripeT m) where
  liftIO :: IO a -> StripeT m a
liftIO = ReaderT Configuration m a -> StripeT m a
forall (m :: * -> *) a. ReaderT Configuration m a -> StripeT m a
StripeT (ReaderT Configuration m a -> StripeT m a)
-> (IO a -> ReaderT Configuration m a) -> IO a -> StripeT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT Configuration m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO

-- | Utility type which uses 'IO' as underlying monad
type StripeM a = StripeT IO a

-- | Run a 'StripeT' monad transformer in another monad with a specified configuration
runWithConfiguration :: Configuration -> StripeT m a -> m a
runWithConfiguration :: Configuration -> StripeT m a -> m a
runWithConfiguration Configuration
c (StripeT ReaderT Configuration m a
r) = ReaderT Configuration m a -> Configuration -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
MR.runReaderT ReaderT Configuration m a
r Configuration
c

-- | An operation can and must be configured with data, which may be common
-- for many operations.
--
-- This configuration consists of information about the server URL and the used security scheme.
--
-- In OpenAPI these information can be defined
--
-- * Root level
-- * Path level
-- * Operation level
--
-- To get started, the 'StripeAPI.Configuration.defaultConfiguration' can be used and changed accordingly.
--
-- Note that it is possible that @bearerAuthenticationSecurityScheme@ is not available because it is not a security scheme in the OpenAPI specification.
--
-- > defaultConfiguration
-- >   { configSecurityScheme = bearerAuthenticationSecurityScheme "token" }
data Configuration = Configuration
  { Configuration -> Text
configBaseURL :: Text,
    Configuration -> SecurityScheme
configSecurityScheme :: SecurityScheme
  }

-- | Defines how a request body is encoded
data RequestBodyEncoding
  = -- | Encode the body as JSON
    RequestBodyEncodingJSON
  | -- | Encode the body as form data
    RequestBodyEncodingFormData

-- | Defines a query parameter with the information necessary for serialization
data QueryParameter = QueryParameter
  { QueryParameter -> Text
queryParamName :: Text,
    QueryParameter -> Maybe Value
queryParamValue :: Maybe Aeson.Value,
    QueryParameter -> Text
queryParamStyle :: Text,
    QueryParameter -> Bool
queryParamExplode :: Bool
  }
  deriving (Int -> QueryParameter -> ShowS
[QueryParameter] -> ShowS
QueryParameter -> String
(Int -> QueryParameter -> ShowS)
-> (QueryParameter -> String)
-> ([QueryParameter] -> ShowS)
-> Show QueryParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryParameter] -> ShowS
$cshowList :: [QueryParameter] -> ShowS
show :: QueryParameter -> String
$cshow :: QueryParameter -> String
showsPrec :: Int -> QueryParameter -> ShowS
$cshowsPrec :: Int -> QueryParameter -> ShowS
Show, QueryParameter -> QueryParameter -> Bool
(QueryParameter -> QueryParameter -> Bool)
-> (QueryParameter -> QueryParameter -> Bool) -> Eq QueryParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryParameter -> QueryParameter -> Bool
$c/= :: QueryParameter -> QueryParameter -> Bool
== :: QueryParameter -> QueryParameter -> Bool
$c== :: QueryParameter -> QueryParameter -> Bool
Eq)

-- | This type specifies a security scheme which can modify a request according to the scheme (e. g. add an Authorization header)
type SecurityScheme = HS.Request -> HS.Request

-- | Anonymous security scheme which does not alter the request in any way
anonymousSecurityScheme :: SecurityScheme
anonymousSecurityScheme :: SecurityScheme
anonymousSecurityScheme = SecurityScheme
forall a. a -> a
id

-- | This is the main functionality of this module
--
--   It makes a concrete Call to a Server without a body
doCallWithConfiguration ::
  MonadHTTP m =>
  -- | Configuration options like base URL and security scheme
  Configuration ->
  -- | HTTP method (GET, POST, etc.)
  Text ->
  -- | Path to append to the base URL (path parameters should already be replaced)
  Text ->
  -- | Query parameters
  [QueryParameter] ->
  -- | The raw response from the server
  m (HS.Response B8.ByteString)
doCallWithConfiguration :: Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
doCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams =
  Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS (Request -> m (Response ByteString))
-> Request -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Configuration -> Text -> Text -> [QueryParameter] -> Request
createBaseRequest Configuration
config Text
method Text
path [QueryParameter]
queryParams

-- | Same as 'doCallWithConfiguration' but run in a 'MR.ReaderT' environment which contains the configuration.
-- This is useful if multiple calls have to be executed with the same configuration.
doCallWithConfigurationM ::
  MonadHTTP m =>
  Text ->
  Text ->
  [QueryParameter] ->
  StripeT m (HS.Response B8.ByteString)
doCallWithConfigurationM :: Text -> Text -> [QueryParameter] -> StripeT m (Response ByteString)
doCallWithConfigurationM Text
method Text
path [QueryParameter]
queryParams = do
  Configuration
config <- StripeT m Configuration
forall r (m :: * -> *). MonadReader r m => m r
MR.ask
  m (Response ByteString) -> StripeT m (Response ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m (Response ByteString) -> StripeT m (Response ByteString))
-> m (Response ByteString) -> StripeT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
doCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams

-- | This is the main functionality of this module
--
--   It makes a concrete Call to a Server with a body
doBodyCallWithConfiguration ::
  (MonadHTTP m, Aeson.ToJSON body) =>
  -- | Configuration options like base URL and security scheme
  Configuration ->
  -- | HTTP method (GET, POST, etc.)
  Text ->
  -- | Path to append to the base URL (path parameters should already be replaced)
  Text ->
  -- | Query parameters
  [QueryParameter] ->
  -- | Request body
  Maybe body ->
  -- | JSON or form data deepobjects
  RequestBodyEncoding ->
  -- | The raw response from the server
  m (HS.Response B8.ByteString)
doBodyCallWithConfiguration :: Configuration
-> Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> m (Response ByteString)
doBodyCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams Maybe body
Nothing RequestBodyEncoding
_ = Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
doCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams
doBodyCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams (Just body
body) RequestBodyEncoding
RequestBodyEncodingJSON =
  Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS (Request -> m (Response ByteString))
-> Request -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> SecurityScheme
HS.setRequestMethod (Text -> ByteString
textToByte Text
method) SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$ body -> SecurityScheme
forall a. ToJSON a => a -> SecurityScheme
HS.setRequestBodyJSON body
body Request
baseRequest
  where
    baseRequest :: Request
baseRequest = Configuration -> Text -> Text -> [QueryParameter] -> Request
createBaseRequest Configuration
config Text
method Text
path [QueryParameter]
queryParams
doBodyCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams (Just body
body) RequestBodyEncoding
RequestBodyEncodingFormData =
  Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS (Request -> m (Response ByteString))
-> Request -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> SecurityScheme
HS.setRequestMethod (Text -> ByteString
textToByte Text
method) SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> SecurityScheme
HS.setRequestBodyURLEncoded [(ByteString, ByteString)]
byteStringData Request
baseRequest
  where
    baseRequest :: Request
baseRequest = Configuration -> Text -> Text -> [QueryParameter] -> Request
createBaseRequest Configuration
config Text
method Text
path [QueryParameter]
queryParams
    byteStringData :: [(ByteString, ByteString)]
byteStringData = body -> [(ByteString, ByteString)]
forall a. ToJSON a => a -> [(ByteString, ByteString)]
createFormData body
body

-- | Same as 'doBodyCallWithConfiguration' but run in a 'MR.ReaderT' environment which contains the configuration.
-- This is useful if multiple calls have to be executed with the same configuration.
doBodyCallWithConfigurationM ::
  (MonadHTTP m, Aeson.ToJSON body) =>
  Text ->
  Text ->
  [QueryParameter] ->
  Maybe body ->
  RequestBodyEncoding ->
  StripeT m (HS.Response B8.ByteString)
doBodyCallWithConfigurationM :: Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> StripeT m (Response ByteString)
doBodyCallWithConfigurationM Text
method Text
path [QueryParameter]
queryParams Maybe body
body RequestBodyEncoding
encoding = do
  Configuration
config <- StripeT m Configuration
forall r (m :: * -> *). MonadReader r m => m r
MR.ask
  m (Response ByteString) -> StripeT m (Response ByteString)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m (Response ByteString) -> StripeT m (Response ByteString))
-> m (Response ByteString) -> StripeT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Configuration
-> Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Configuration
-> Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> m (Response ByteString)
doBodyCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams Maybe body
body RequestBodyEncoding
encoding

-- | Creates a Base Request
createBaseRequest ::
  -- | Configuration options like base URL and security scheme
  Configuration ->
  -- | HTTP method (GET, POST, etc.)
  Text ->
  -- | The path for which the placeholders have already been replaced
  Text ->
  -- | Query Parameters
  [QueryParameter] ->
  -- | The Response from the server
  HS.Request
createBaseRequest :: Configuration -> Text -> Text -> [QueryParameter] -> Request
createBaseRequest Configuration
config Text
method Text
path [QueryParameter]
queryParams =
  Configuration -> SecurityScheme
configSecurityScheme Configuration
config SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$
    ByteString -> SecurityScheme
HS.setRequestMethod (Text -> ByteString
textToByte Text
method) SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$
      Query -> SecurityScheme
HS.setRequestQueryString Query
query SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$
        ByteString -> SecurityScheme
HS.setRequestPath
          (String -> ByteString
B8.pack (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
byteToText ByteString
basePathModifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path))
          Request
baseRequest
  where
    baseRequest :: Request
baseRequest = Text -> Request
parseURL (Text -> Request) -> Text -> Request
forall a b. (a -> b) -> a -> b
$ Configuration -> Text
configBaseURL Configuration
config
    basePath :: ByteString
basePath = Request -> ByteString
HC.path Request
baseRequest
    basePathModifier :: ByteString
basePathModifier =
      if ByteString
basePath ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
B8.pack String
"/" Bool -> Bool -> Bool
&& Text -> Text -> Bool
T.isPrefixOf Text
"/" Text
path
        then ByteString
""
        else ByteString
basePath
    -- filters all maybe
    query :: Query
query = (ByteString -> Maybe ByteString)
-> (ByteString, ByteString) -> (ByteString, Maybe ByteString)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
BF.second ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString, ByteString) -> (ByteString, Maybe ByteString))
-> [(ByteString, ByteString)] -> Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QueryParameter] -> [(ByteString, ByteString)]
serializeQueryParams [QueryParameter]
queryParams

serializeQueryParams :: [QueryParameter] -> [(B8.ByteString, B8.ByteString)]
serializeQueryParams :: [QueryParameter] -> [(ByteString, ByteString)]
serializeQueryParams = ([QueryParameter]
-> (QueryParameter -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryParameter -> [(ByteString, ByteString)]
serializeQueryParam)

serializeQueryParam :: QueryParameter -> [(B8.ByteString, B8.ByteString)]
serializeQueryParam :: QueryParameter -> [(ByteString, ByteString)]
serializeQueryParam QueryParameter {Bool
Maybe Value
Text
queryParamExplode :: Bool
queryParamStyle :: Text
queryParamValue :: Maybe Value
queryParamName :: Text
queryParamExplode :: QueryParameter -> Bool
queryParamStyle :: QueryParameter -> Text
queryParamValue :: QueryParameter -> Maybe Value
queryParamName :: QueryParameter -> Text
..} =
  let concatValues :: ByteString -> [(Text, ByteString)] -> [(Text, ByteString)]
concatValues ByteString
joinWith = if Bool
queryParamExplode then (Text, ByteString) -> [(Text, ByteString)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, ByteString) -> [(Text, ByteString)])
-> ([(Text, ByteString)] -> (Text, ByteString))
-> [(Text, ByteString)]
-> [(Text, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
queryParamName,) (ByteString -> (Text, ByteString))
-> ([(Text, ByteString)] -> ByteString)
-> [(Text, ByteString)]
-> (Text, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
B8.intercalate ByteString
joinWith ([ByteString] -> ByteString)
-> ([(Text, ByteString)] -> [ByteString])
-> [(Text, ByteString)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, ByteString) -> ByteString)
-> [(Text, ByteString)] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, ByteString) -> ByteString
forall a b. (a, b) -> b
snd else [(Text, ByteString)] -> [(Text, ByteString)]
forall a. a -> a
id
   in (Text -> ByteString)
-> (Text, ByteString) -> (ByteString, ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first Text -> ByteString
textToByte ((Text, ByteString) -> (ByteString, ByteString))
-> [(Text, ByteString)] -> [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Value
queryParamValue of
        Maybe Value
Nothing -> []
        Just Value
value ->
          ( case Text
queryParamStyle of
              Text
"form" -> ByteString -> [(Text, ByteString)] -> [(Text, ByteString)]
concatValues ByteString
","
              Text
"spaceDelimited" -> ByteString -> [(Text, ByteString)] -> [(Text, ByteString)]
concatValues ByteString
" "
              Text
"pipeDelimited" -> ByteString -> [(Text, ByteString)] -> [(Text, ByteString)]
concatValues ByteString
"|"
              Text
"deepObject" -> [(Text, ByteString)]
-> [(Text, ByteString)] -> [(Text, ByteString)]
forall a b. a -> b -> a
const ([(Text, ByteString)]
 -> [(Text, ByteString)] -> [(Text, ByteString)])
-> [(Text, ByteString)]
-> [(Text, ByteString)]
-> [(Text, ByteString)]
forall a b. (a -> b) -> a -> b
$ (Text -> ByteString) -> (Text, Text) -> (Text, ByteString)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
BF.second Text -> ByteString
textToByte ((Text, Text) -> (Text, ByteString))
-> [(Text, Text)] -> [(Text, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed Text
queryParamName Value
value
              Text
_ -> [(Text, ByteString)]
-> [(Text, ByteString)] -> [(Text, ByteString)]
forall a b. a -> b -> a
const []
          )
            ([(Text, ByteString)] -> [(Text, ByteString)])
-> [(Text, ByteString)] -> [(Text, ByteString)]
forall a b. (a -> b) -> a -> b
$ Text -> Value -> [(Text, ByteString)]
jsonToFormDataFlat Text
queryParamName Value
value

encodeStrict :: Aeson.ToJSON a => a -> B8.ByteString
encodeStrict :: a -> ByteString
encodeStrict = ByteString -> ByteString
LB8.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode

jsonToFormDataFlat :: Text -> Aeson.Value -> [(Text, B8.ByteString)]
jsonToFormDataFlat :: Text -> Value -> [(Text, ByteString)]
jsonToFormDataFlat Text
_ Value
Aeson.Null = []
jsonToFormDataFlat Text
name (Aeson.Number Scientific
a) = [(Text
name, Scientific -> ByteString
forall a. ToJSON a => a -> ByteString
encodeStrict Scientific
a)]
jsonToFormDataFlat Text
name (Aeson.String Text
a) = [(Text
name, Text -> ByteString
textToByte Text
a)]
jsonToFormDataFlat Text
name (Aeson.Bool Bool
a) = [(Text
name, Bool -> ByteString
forall a. ToJSON a => a -> ByteString
encodeStrict Bool
a)]
jsonToFormDataFlat Text
_ (Aeson.Object Object
object) = Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList Object
object [(Text, Value)]
-> ((Text, Value) -> [(Text, ByteString)]) -> [(Text, ByteString)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Value -> [(Text, ByteString)])
-> (Text, Value) -> [(Text, ByteString)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> [(Text, ByteString)]
jsonToFormDataFlat
jsonToFormDataFlat Text
name (Aeson.Array Array
vector) = Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
vector [Value] -> (Value -> [(Text, ByteString)]) -> [(Text, ByteString)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value -> [(Text, ByteString)]
jsonToFormDataFlat Text
name

-- | creates form data bytestring array
createFormData :: (Aeson.ToJSON a) => a -> [(B8.ByteString, B8.ByteString)]
createFormData :: a -> [(ByteString, ByteString)]
createFormData a
body =
  let formData :: [(Text, Text)]
formData = Value -> [(Text, Text)]
jsonToFormData (Value -> [(Text, Text)]) -> Value -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
body
   in ((Text, Text) -> (ByteString, ByteString))
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> ByteString)
-> (Text -> ByteString) -> (Text, Text) -> (ByteString, ByteString)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
BF.bimap Text -> ByteString
textToByte Text -> ByteString
textToByte) [(Text, Text)]
formData

-- | Convert a 'B8.ByteString' to 'Text'
byteToText :: B8.ByteString -> Text
byteToText :: ByteString -> Text
byteToText = String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B8.unpack

-- | Convert 'Text' a to 'B8.ByteString'
textToByte :: Text -> B8.ByteString
textToByte :: Text -> ByteString
textToByte = String -> ByteString
B8.pack (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

parseURL :: Text -> HS.Request
parseURL :: Text -> Request
parseURL Text
url =
  Request -> Maybe Request -> Request
forall a. a -> Maybe a -> a
Maybe.fromMaybe Request
HS.defaultRequest (Maybe Request -> Request) -> Maybe Request -> Request
forall a b. (a -> b) -> a -> b
$
    String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HS.parseRequest (String -> Maybe Request) -> String -> Maybe Request
forall a b. (a -> b) -> a -> b
$
      Text -> String
T.unpack Text
url

jsonToFormData :: Aeson.Value -> [(Text, Text)]
jsonToFormData :: Value -> [(Text, Text)]
jsonToFormData = Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed Text
""

jsonToFormDataPrefixed :: Text -> Aeson.Value -> [(Text, Text)]
jsonToFormDataPrefixed :: Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed Text
prefix (Aeson.Number Scientific
a) = case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
a :: Maybe Int of
  Just Int
myInt -> [(Text
prefix, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
myInt)]
  Maybe Int
Nothing -> [(Text
prefix, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> String
forall a. Show a => a -> String
show Scientific
a)]
jsonToFormDataPrefixed Text
prefix (Aeson.Bool Bool
True) = [(Text
prefix, Text
"true")]
jsonToFormDataPrefixed Text
prefix (Aeson.Bool Bool
False) = [(Text
prefix, Text
"false")]
jsonToFormDataPrefixed Text
_ Value
Aeson.Null = []
jsonToFormDataPrefixed Text
prefix (Aeson.String Text
a) = [(Text
prefix, Text
a)]
jsonToFormDataPrefixed Text
"" (Aeson.Object Object
object) =
  Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList Object
object [(Text, Value)]
-> ((Text, Value) -> [(Text, Text)]) -> [(Text, Text)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Value -> [(Text, Text)])
-> (Text, Value) -> [(Text, Text)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed
jsonToFormDataPrefixed Text
prefix (Aeson.Object Object
object) =
  Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HMap.toList Object
object [(Text, Value)]
-> ((Text, Value) -> [(Text, Text)]) -> [(Text, Text)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(Text
x, Value
y) -> Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Value
y)
jsonToFormDataPrefixed Text
prefix (Aeson.Array Array
vector) =
  Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
vector [Value] -> (Value -> [(Text, Text)]) -> [(Text, Text)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[]")

-- | This type class makes the code generation for URL parameters easier as it allows to stringify a value
--
-- The 'Show' class is not sufficient as strings should not be stringified with quotes.
class Show a => StringifyModel a where
  -- | Stringifies a showable value
  --
  -- >>> stringifyModel "Test"
  -- "Test"
  --
  -- >>> stringifyModel 123
  -- "123"
  stringifyModel :: a -> String

instance StringifyModel String where
  -- stringifyModel :: String -> String
  stringifyModel :: ShowS
stringifyModel = ShowS
forall a. a -> a
id

instance StringifyModel Text where
  -- stringifyModel :: Text -> String
  stringifyModel :: Text -> String
stringifyModel = Text -> String
T.unpack

instance {-# OVERLAPS #-} Show a => StringifyModel a where
  -- stringifyModel :: Show a => a -> String
  stringifyModel :: a -> String
stringifyModel = a -> String
forall a. Show a => a -> String
show

-- | Wraps a 'B8.ByteString' to implement 'Aeson.ToJSON' and 'Aeson.FromJSON'
newtype JsonByteString = JsonByteString B8.ByteString
  deriving (Int -> JsonByteString -> ShowS
[JsonByteString] -> ShowS
JsonByteString -> String
(Int -> JsonByteString -> ShowS)
-> (JsonByteString -> String)
-> ([JsonByteString] -> ShowS)
-> Show JsonByteString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonByteString] -> ShowS
$cshowList :: [JsonByteString] -> ShowS
show :: JsonByteString -> String
$cshow :: JsonByteString -> String
showsPrec :: Int -> JsonByteString -> ShowS
$cshowsPrec :: Int -> JsonByteString -> ShowS
Show, JsonByteString -> JsonByteString -> Bool
(JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool) -> Eq JsonByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JsonByteString -> JsonByteString -> Bool
$c/= :: JsonByteString -> JsonByteString -> Bool
== :: JsonByteString -> JsonByteString -> Bool
$c== :: JsonByteString -> JsonByteString -> Bool
Eq, Eq JsonByteString
Eq JsonByteString
-> (JsonByteString -> JsonByteString -> Ordering)
-> (JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> JsonByteString)
-> (JsonByteString -> JsonByteString -> JsonByteString)
-> Ord JsonByteString
JsonByteString -> JsonByteString -> Bool
JsonByteString -> JsonByteString -> Ordering
JsonByteString -> JsonByteString -> JsonByteString
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: JsonByteString -> JsonByteString -> JsonByteString
$cmin :: JsonByteString -> JsonByteString -> JsonByteString
max :: JsonByteString -> JsonByteString -> JsonByteString
$cmax :: JsonByteString -> JsonByteString -> JsonByteString
>= :: JsonByteString -> JsonByteString -> Bool
$c>= :: JsonByteString -> JsonByteString -> Bool
> :: JsonByteString -> JsonByteString -> Bool
$c> :: JsonByteString -> JsonByteString -> Bool
<= :: JsonByteString -> JsonByteString -> Bool
$c<= :: JsonByteString -> JsonByteString -> Bool
< :: JsonByteString -> JsonByteString -> Bool
$c< :: JsonByteString -> JsonByteString -> Bool
compare :: JsonByteString -> JsonByteString -> Ordering
$ccompare :: JsonByteString -> JsonByteString -> Ordering
$cp1Ord :: Eq JsonByteString
Ord)

instance Aeson.ToJSON JsonByteString where
  toJSON :: JsonByteString -> Value
toJSON (JsonByteString ByteString
s) = String -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B8.unpack ByteString
s

instance Aeson.FromJSON JsonByteString where
  parseJSON :: Value -> Parser JsonByteString
parseJSON (Aeson.String Text
s) = JsonByteString -> Parser JsonByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JsonByteString -> Parser JsonByteString)
-> JsonByteString -> Parser JsonByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> JsonByteString
JsonByteString (ByteString -> JsonByteString) -> ByteString -> JsonByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
textToByte Text
s
  parseJSON Value
_ = String -> Parser JsonByteString
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Value cannot be converted to a 'JsonByteString'"

-- | Wraps a 'Time.ZonedTime' to implement 'Aeson.ToJSON' and 'Aeson.FromJSON'
newtype JsonDateTime = JsonDateTime Time.ZonedTime
  deriving (Int -> JsonDateTime -> ShowS
[JsonDateTime] -> ShowS
JsonDateTime -> String
(Int -> JsonDateTime -> ShowS)
-> (JsonDateTime -> String)
-> ([JsonDateTime] -> ShowS)
-> Show JsonDateTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JsonDateTime] -> ShowS
$cshowList :: [JsonDateTime] -> ShowS
show :: JsonDateTime -> String
$cshow :: JsonDateTime -> String
showsPrec :: Int -> JsonDateTime -> ShowS
$cshowsPrec :: Int -> JsonDateTime -> ShowS
Show)

instance Eq JsonDateTime where
  (JsonDateTime ZonedTime
d1) == :: JsonDateTime -> JsonDateTime -> Bool
== (JsonDateTime ZonedTime
d2) = ZonedTime -> UTCTime
Time.zonedTimeToUTC ZonedTime
d1 UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== ZonedTime -> UTCTime
Time.zonedTimeToUTC ZonedTime
d2

instance Ord JsonDateTime where
  (JsonDateTime ZonedTime
d1) <= :: JsonDateTime -> JsonDateTime -> Bool
<= (JsonDateTime ZonedTime
d2) = ZonedTime -> UTCTime
Time.zonedTimeToUTC ZonedTime
d1 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= ZonedTime -> UTCTime
Time.zonedTimeToUTC ZonedTime
d2

instance Aeson.ToJSON JsonDateTime where
  toJSON :: JsonDateTime -> Value
toJSON (JsonDateTime ZonedTime
d) = ZonedTime -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ZonedTime
d

instance Aeson.FromJSON JsonDateTime where
  parseJSON :: Value -> Parser JsonDateTime
parseJSON Value
o = ZonedTime -> JsonDateTime
JsonDateTime (ZonedTime -> JsonDateTime)
-> Parser ZonedTime -> Parser JsonDateTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ZonedTime
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
o