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


module CoinbasePro.Request
    ( RequestPath
    , Body

    , CBGet
    , CBRequest

    , run
    , run_
    , runWithManager

    , Runner

    , emptyBody
    , encodeRequestPath
    ) where

import           Control.Exception          (throw)
import           Control.Monad              (void)
import           Data.ByteString            (ByteString)
import qualified Data.ByteString.Builder    as BB
import qualified Data.ByteString.Lazy.Char8 as LC8
import           Data.Text                  (Text, unpack)
import           Network.HTTP.Client        (Manager, newManager)
import           Network.HTTP.Client.TLS    (tlsManagerSettings)
import           Network.HTTP.Types         (encodePathSegments)
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
""


encodeRequestPath :: [Text] -> RequestPath
encodeRequestPath :: [Text] -> ByteString
encodeRequestPath = ByteString -> ByteString
LC8.toStrict (ByteString -> ByteString)
-> ([Text] -> ByteString) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> ([Text] -> Builder) -> [Text] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Builder
encodePathSegments