{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE TypeOperators     #-}


module CoinbasePro.Request
    ( RequestPath
    , Body

    , CBGet
    , CBRequest

    , run
    , run_
    , runWithManager

    , Runner

    , emptyBody
    ) where

import           Control.Exception       (throw)
import           Control.Monad           (void)
import           Data.ByteString         (ByteString)
import           Data.Text               (unpack)
import           Network.HTTP.Client     (Manager, newManager)
import           Network.HTTP.Client.TLS (tlsManagerSettings)
import           Servant.API             (Get, JSON, (:>))
import           Servant.Client

import           CoinbasePro.Environment (Environment, apiEndpoint)
import           CoinbasePro.Headers     (UserAgent, UserAgentHeader)


type CBGet a = UserAgentHeader :> Get '[JSON] a


type CBRequest a = UserAgent -> ClientM a

-- ^ Serialized as a part of building CBAccessSign
type RequestPath = ByteString

-- ^ Serialized as a part of building CBAccessSign
type Body        = ByteString


type Runner a = ClientM a -> IO a


------------------------------------------------------------------------------
-- | Runs a coinbase pro HTTPS request and returns the result `a`
--
-- > run Production products >>= print
--
run :: Environment -> ClientM a -> IO a
run :: Environment -> ClientM a -> IO a
run Environment
env ClientM a
f = do
    Manager
mgr <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    Manager -> Environment -> ClientM a -> IO a
forall a. Manager -> Environment -> ClientM a -> IO a
runWithManager Manager
mgr Environment
env ClientM a
f


------------------------------------------------------------------------------
-- | Same as 'run', except uses `()` instead of a type `a`
run_ :: Environment -> ClientM a -> IO ()
run_ :: Environment -> ClientM a -> IO ()
run_ = (IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> (ClientM a -> IO a) -> ClientM a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((ClientM a -> IO a) -> ClientM a -> IO ())
-> (Environment -> ClientM a -> IO a)
-> Environment
-> ClientM a
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> ClientM a -> IO a
forall a. Environment -> ClientM a -> IO a
run


------------------------------------------------------------------------------
-- | Allows the user to use their own 'Network.HTTP.Client.Types.ManagerSettings`
-- with 'run'
--
-- @
-- do $
-- mgr  <- newManager tlsManagerSettings
-- prds <- runWithManager mgr Production products
-- print prds
-- @
--
runWithManager :: Manager -> Environment -> ClientM a -> IO a
runWithManager :: Manager -> Environment -> ClientM a -> IO a
runWithManager Manager
mgr Environment
env ClientM a
f = (ClientError -> IO a)
-> (a -> IO a) -> Either ClientError a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ClientError -> IO a
forall a e. Exception e => e -> a
throw a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ClientError a -> IO a) -> IO (Either ClientError a) -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
f (Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
mgr (Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
api Int
443 String
forall a. Monoid a => a
mempty))
  where
    api :: String
api = Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Environment -> Text
apiEndpoint Environment
env


emptyBody :: ByteString
emptyBody :: ByteString
emptyBody = ByteString
""