Client.hs

{-# 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
  { message :: Text
  , code :: Int 
  } deriving (Show, Generic, FromJSON)

instance Exception Paddle.Client.PaddleError

data PaddleResponse a = 
  ResponseError PaddleError | ResponseSuccess a
  deriving (Show)

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

instance FromJSON a => FromJSON (PaddleResponse a) where
  parseJSON = withObject "PaddleResponse" $ \v -> do
    isSuccessful <- v .: "success"
    if isSuccessful
    then ResponseSuccess <$> v .: "response"
    else ResponseError <$> v .: "error"

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

api :: Proxy (ToServantApi API)
api = genericApi (Proxy :: Proxy API)

client :: API (AsClientT ClientM)
client = fromServant $ Servant.Client.client api

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