{-# 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

-- ^ Sequenced `ClientM a` that result in `IO a`
type Runner a = ClientM a -> IO a


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


------------------------------------------------------------------------------
-- | Same as 'run', except uses `()` instead of a type `a`
run_ :: Environment -> Runner ()
run_ :: Environment -> Runner ()
run_ = (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Environment -> Runner 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 -> Runner a
runWithManager :: forall a. Manager -> Environment -> Runner a
runWithManager Manager
mgr Environment
env ClientM a
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a e. Exception e => e -> a
throw forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    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 forall a. Monoid a => a
mempty))
  where
    api :: String
api = Text -> String
unpack 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Builder
encodePathSegments