{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveAnyClass #-}
module Paddle.Client 
 ( API(..)
 , PaddleError(..)
 , PaddleResponse(..)
 , responseToEither
 , client
 , runClient
 ) where

import           Data.Aeson (FromJSON, parseJSON, (.:), withObject)
import           Protolude 
import           Prelude ()
import           Network.HTTP.Client ( Manager )
import           Servant.API
import           Servant.API.Generic
import           Servant.Client hiding (client)
import qualified Servant.Client
import           Servant.Client.Generic
import           Paddle.Client.DeleteModifier (DeleteModifier)
import           Paddle.Client.ListModifier (ListModifier)
import           Paddle.Client.GeneratePayLink (GeneratePayLink)
import           Paddle.Client.GeneratePayLinkResponse (GeneratePayLinkResponse)
import           Paddle.Client.ListModifierResponse (ListModifierResponse)
import           Paddle.Client.CreateModifier (CreateModifier)
import           Paddle.Client.CreateModifierResponse (CreateModifierResponse)
import           Paddle.Client.ListUsers (ListUsers)
import           Paddle.Client.ListUsersResponse (ListUsersResponse)
import           Paddle.Client.SubscriptionUsersUpdate (SubscriptionUsersUpdate)
import           Paddle.Client.SubscriptionUsersUpdateResponse (SubscriptionUsersUpdateResponse)

data PaddleError = PaddleError
  { PaddleError -> Text
message :: Text
  , PaddleError -> Int
code :: Int 
  } deriving (Int -> PaddleError -> ShowS
[PaddleError] -> ShowS
PaddleError -> String
(Int -> PaddleError -> ShowS)
-> (PaddleError -> String)
-> ([PaddleError] -> ShowS)
-> Show PaddleError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaddleError] -> ShowS
$cshowList :: [PaddleError] -> ShowS
show :: PaddleError -> String
$cshow :: PaddleError -> String
showsPrec :: Int -> PaddleError -> ShowS
$cshowsPrec :: Int -> PaddleError -> ShowS
Show, (forall x. PaddleError -> Rep PaddleError x)
-> (forall x. Rep PaddleError x -> PaddleError)
-> Generic PaddleError
forall x. Rep PaddleError x -> PaddleError
forall x. PaddleError -> Rep PaddleError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PaddleError x -> PaddleError
$cfrom :: forall x. PaddleError -> Rep PaddleError x
Generic, Value -> Parser [PaddleError]
Value -> Parser PaddleError
(Value -> Parser PaddleError)
-> (Value -> Parser [PaddleError]) -> FromJSON PaddleError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PaddleError]
$cparseJSONList :: Value -> Parser [PaddleError]
parseJSON :: Value -> Parser PaddleError
$cparseJSON :: Value -> Parser PaddleError
FromJSON)

instance Exception Paddle.Client.PaddleError

data PaddleResponse a = 
  ResponseError PaddleError | ResponseSuccess a
  deriving (Int -> PaddleResponse a -> ShowS
[PaddleResponse a] -> ShowS
PaddleResponse a -> String
(Int -> PaddleResponse a -> ShowS)
-> (PaddleResponse a -> String)
-> ([PaddleResponse a] -> ShowS)
-> Show (PaddleResponse a)
forall a. Show a => Int -> PaddleResponse a -> ShowS
forall a. Show a => [PaddleResponse a] -> ShowS
forall a. Show a => PaddleResponse a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PaddleResponse a] -> ShowS
$cshowList :: forall a. Show a => [PaddleResponse a] -> ShowS
show :: PaddleResponse a -> String
$cshow :: forall a. Show a => PaddleResponse a -> String
showsPrec :: Int -> PaddleResponse a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PaddleResponse a -> ShowS
Show)

responseToEither :: PaddleResponse a -> Either PaddleError a
responseToEither :: PaddleResponse a -> Either PaddleError a
responseToEither (ResponseError PaddleError
e) = PaddleError -> Either PaddleError a
forall a b. a -> Either a b
Left PaddleError
e
responseToEither (ResponseSuccess a
a) = a -> Either PaddleError a
forall a b. b -> Either a b
Right a
a

instance FromJSON a => FromJSON (PaddleResponse a) where
  parseJSON :: Value -> Parser (PaddleResponse a)
parseJSON = String
-> (Object -> Parser (PaddleResponse a))
-> Value
-> Parser (PaddleResponse a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PaddleResponse" ((Object -> Parser (PaddleResponse a))
 -> Value -> Parser (PaddleResponse a))
-> (Object -> Parser (PaddleResponse a))
-> Value
-> Parser (PaddleResponse a)
forall a b. (a -> b) -> a -> b
$ \Object
v -> do
    Bool
isSuccessful <- Object
v Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"success"
    if Bool
isSuccessful
    then a -> PaddleResponse a
forall a. a -> PaddleResponse a
ResponseSuccess (a -> PaddleResponse a) -> Parser a -> Parser (PaddleResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"response"
    else PaddleError -> PaddleResponse a
forall a. PaddleError -> PaddleResponse a
ResponseError (PaddleError -> PaddleResponse a)
-> Parser PaddleError -> Parser (PaddleResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser PaddleError
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"error"

data API route = API
    { API route
-> route
   :- ("subscription"
       :> ("modifiers"
           :> (ReqBody '[JSON] ListModifier
               :> Post '[JSON] (PaddleResponse [ListModifierResponse]))))
modifiersList :: route :-
        "subscription" :>
        "modifiers" :>
        ReqBody '[JSON] ListModifier :>
        Post '[JSON] (PaddleResponse [ListModifierResponse])
    , API route
-> route
   :- ("subscription"
       :> ("modifiers"
           :> ("create"
               :> (ReqBody '[JSON] CreateModifier
                   :> Post '[JSON] (PaddleResponse CreateModifierResponse)))))
modifiersCreate :: route :-
        "subscription" :>
        "modifiers" :>
        "create" :>
        ReqBody '[JSON] CreateModifier :>
        Post '[JSON] (PaddleResponse CreateModifierResponse)
    , API route
-> route
   :- ("subscription"
       :> ("modifiers"
           :> ("delete"
               :> (ReqBody '[JSON] DeleteModifier
                   :> Post '[JSON] (PaddleResponse (Maybe ()))))))
modifiersDelete :: route :-
        "subscription" :>
        "modifiers" :>
        "delete" :>
        ReqBody '[JSON] DeleteModifier :>
        Post '[JSON] (PaddleResponse (Maybe ())) -- https://github.com/bos/aeson/issues/744
    , API route
-> route
   :- ("product"
       :> ("generate_pay_link"
           :> (ReqBody '[JSON] GeneratePayLink
               :> Post '[JSON] (PaddleResponse GeneratePayLinkResponse))))
productGeneratePayLink :: route :-
        "product" :>
        "generate_pay_link" :>
        ReqBody '[JSON] GeneratePayLink :>
        Post '[JSON] (PaddleResponse GeneratePayLinkResponse)
    , API route
-> route
   :- ("subscription"
       :> ("users"
           :> (ReqBody '[JSON] ListUsers
               :> Post '[JSON] (PaddleResponse [ListUsersResponse]))))
usersList :: route :-
        "subscription" :>
        "users" :>
        ReqBody '[JSON] ListUsers :>
        Post '[JSON] (PaddleResponse [ListUsersResponse])
    , API route
-> route
   :- ("subscription"
       :> ("users"
           :> ("update"
               :> (ReqBody '[JSON] SubscriptionUsersUpdate
                   :> Post
                        '[JSON] (PaddleResponse SubscriptionUsersUpdateResponse)))))
subscriptionUsersUpdate :: route :-
        "subscription" :>
        "users" :>
        "update" :>
        ReqBody '[JSON] SubscriptionUsersUpdate :>
        Post '[JSON] (PaddleResponse SubscriptionUsersUpdateResponse)
    } deriving ((forall x. API route -> Rep (API route) x)
-> (forall x. Rep (API route) x -> API route)
-> Generic (API route)
forall x. Rep (API route) x -> API route
forall x. API route -> Rep (API route) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall route x. Rep (API route) x -> API route
forall route x. API route -> Rep (API route) x
$cto :: forall route x. Rep (API route) x -> API route
$cfrom :: forall route x. API route -> Rep (API route) x
Generic)

api :: Proxy (ToServantApi API)
api :: Proxy (ToServantApi API)
api = Proxy API -> Proxy (ToServantApi API)
forall (routes :: * -> *).
GenericServant routes AsApi =>
Proxy routes -> Proxy (ToServantApi routes)
genericApi (Proxy API
forall k (t :: k). Proxy t
Proxy :: Proxy API)

client :: API (AsClientT ClientM)
client :: API (AsClientT ClientM)
client = ToServant API (AsClientT ClientM) -> API (AsClientT ClientM)
forall (routes :: * -> *) mode.
GenericServant routes mode =>
ToServant routes mode -> routes mode
fromServant (ToServant API (AsClientT ClientM) -> API (AsClientT ClientM))
-> ToServant API (AsClientT ClientM) -> API (AsClientT ClientM)
forall a b. (a -> b) -> a -> b
$ Proxy
  ((("subscription"
     :> ("modifiers"
         :> (ReqBody '[JSON] ListModifier
             :> Post '[JSON] (PaddleResponse [ListModifierResponse]))))
    :<|> (("subscription"
           :> ("modifiers"
               :> ("create"
                   :> (ReqBody '[JSON] CreateModifier
                       :> Post '[JSON] (PaddleResponse CreateModifierResponse)))))
          :<|> ("subscription"
                :> ("modifiers"
                    :> ("delete"
                        :> (ReqBody '[JSON] DeleteModifier
                            :> Post '[JSON] (PaddleResponse (Maybe ()))))))))
   :<|> (("product"
          :> ("generate_pay_link"
              :> (ReqBody '[JSON] GeneratePayLink
                  :> Post '[JSON] (PaddleResponse GeneratePayLinkResponse))))
         :<|> (("subscription"
                :> ("users"
                    :> (ReqBody '[JSON] ListUsers
                        :> Post '[JSON] (PaddleResponse [ListUsersResponse]))))
               :<|> ("subscription"
                     :> ("users"
                         :> ("update"
                             :> (ReqBody '[JSON] SubscriptionUsersUpdate
                                 :> Post
                                      '[JSON]
                                      (PaddleResponse SubscriptionUsersUpdateResponse))))))))
-> Client
     ClientM
     ((("subscription"
        :> ("modifiers"
            :> (ReqBody '[JSON] ListModifier
                :> Post '[JSON] (PaddleResponse [ListModifierResponse]))))
       :<|> (("subscription"
              :> ("modifiers"
                  :> ("create"
                      :> (ReqBody '[JSON] CreateModifier
                          :> Post '[JSON] (PaddleResponse CreateModifierResponse)))))
             :<|> ("subscription"
                   :> ("modifiers"
                       :> ("delete"
                           :> (ReqBody '[JSON] DeleteModifier
                               :> Post '[JSON] (PaddleResponse (Maybe ()))))))))
      :<|> (("product"
             :> ("generate_pay_link"
                 :> (ReqBody '[JSON] GeneratePayLink
                     :> Post '[JSON] (PaddleResponse GeneratePayLinkResponse))))
            :<|> (("subscription"
                   :> ("users"
                       :> (ReqBody '[JSON] ListUsers
                           :> Post '[JSON] (PaddleResponse [ListUsersResponse]))))
                  :<|> ("subscription"
                        :> ("users"
                            :> ("update"
                                :> (ReqBody '[JSON] SubscriptionUsersUpdate
                                    :> Post
                                         '[JSON]
                                         (PaddleResponse SubscriptionUsersUpdateResponse))))))))
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
Servant.Client.client Proxy
  ((("subscription"
     :> ("modifiers"
         :> (ReqBody '[JSON] ListModifier
             :> Post '[JSON] (PaddleResponse [ListModifierResponse]))))
    :<|> (("subscription"
           :> ("modifiers"
               :> ("create"
                   :> (ReqBody '[JSON] CreateModifier
                       :> Post '[JSON] (PaddleResponse CreateModifierResponse)))))
          :<|> ("subscription"
                :> ("modifiers"
                    :> ("delete"
                        :> (ReqBody '[JSON] DeleteModifier
                            :> Post '[JSON] (PaddleResponse (Maybe ()))))))))
   :<|> (("product"
          :> ("generate_pay_link"
              :> (ReqBody '[JSON] GeneratePayLink
                  :> Post '[JSON] (PaddleResponse GeneratePayLinkResponse))))
         :<|> (("subscription"
                :> ("users"
                    :> (ReqBody '[JSON] ListUsers
                        :> Post '[JSON] (PaddleResponse [ListUsersResponse]))))
               :<|> ("subscription"
                     :> ("users"
                         :> ("update"
                             :> (ReqBody '[JSON] SubscriptionUsersUpdate
                                 :> Post
                                      '[JSON]
                                      (PaddleResponse SubscriptionUsersUpdateResponse))))))))
Proxy (ToServantApi API)
api

runClient :: Manager -> ClientM a -> IO (Either ClientError a)
runClient :: Manager -> ClientM a -> IO (Either ClientError a)
runClient Manager
httpmanager ClientM a
cmd = do
  (ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
`runClientM` ClientEnv
env) ClientM a
cmd
  where
    env :: ClientEnv
    env :: ClientEnv
env = Manager -> BaseUrl -> ClientEnv
Servant.Client.mkClientEnv Manager
httpmanager (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
"vendors.paddle.com" Int
443 String
"api/2.0")