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

module CoinbasePro.Authenticated.Request
    ( CBAuthT (..)
    , runCbAuthT
    , runDefCbAuthT

    , CoinbaseProCredentials (..)
    , CBSecretKey (..)

    , AuthGet
    , AuthPost
    , AuthDelete

    , authRequest
    , mkCBAccessSign
    , mkCBAccessTimeStamp
    ) where

import           Control.Monad.Catch               (MonadCatch, MonadThrow, MonadMask)
import           Control.Monad.IO.Class            (MonadIO, liftIO)
import           Control.Monad.Trans.Class         (MonadTrans, lift)
import           Control.Monad.Trans.Reader        (ReaderT, asks, runReaderT)
import           Crypto.Hash.Algorithms            (SHA256)
import qualified Crypto.MAC.HMAC                   as HMAC
import           Data.ByteArray.Encoding           (Base (Base64),
                                                    convertFromBase,
                                                    convertToBase)
import           Data.ByteString                   (ByteString)
import qualified Data.ByteString.Char8             as C8
import           Data.Text                         (pack)
import           Data.Text.Encoding                (encodeUtf8)
import           Data.Time.Clock                   (getCurrentTime)
import           Data.Time.Format                  (defaultTimeLocale,
                                                    formatTime)
import           GHC.TypeLits                      (Symbol)
import           Network.HTTP.Types                (Method)
import           Servant.API                       (AuthProtect, Delete, Get,
                                                    JSON, Post, (:>))
import           Servant.Client                    (ClientM)
import           Servant.Client.Core               (AuthClientData,
                                                    AuthenticatedRequest,
                                                    addHeader,
                                                    mkAuthenticatedRequest)
import qualified Servant.Client.Core               as SCC

import           CoinbasePro.Authenticated.Headers (CBAccessKey (..),
                                                    CBAccessPassphrase (..),
                                                    CBAccessSign (..),
                                                    CBAccessTimeStamp (..))
import           CoinbasePro.Environment           (Environment)
import           CoinbasePro.Headers               (userAgent)
import           CoinbasePro.Request               (Body, RequestPath, Runner,
                                                    run)


newtype CBSecretKey = CBSecretKey String
    deriving (CBSecretKey -> CBSecretKey -> Bool
(CBSecretKey -> CBSecretKey -> Bool)
-> (CBSecretKey -> CBSecretKey -> Bool) -> Eq CBSecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CBSecretKey -> CBSecretKey -> Bool
$c/= :: CBSecretKey -> CBSecretKey -> Bool
== :: CBSecretKey -> CBSecretKey -> Bool
$c== :: CBSecretKey -> CBSecretKey -> Bool
Eq)


data CoinbaseProCredentials = CoinbaseProCredentials
    { CoinbaseProCredentials -> CBAccessKey
cbAccessKey        :: CBAccessKey
    , CoinbaseProCredentials -> CBSecretKey
cbSecretKey        :: CBSecretKey
    , CoinbaseProCredentials -> CBAccessPassphrase
cbAccessPassphrase :: CBAccessPassphrase
    } deriving (CoinbaseProCredentials -> CoinbaseProCredentials -> Bool
(CoinbaseProCredentials -> CoinbaseProCredentials -> Bool)
-> (CoinbaseProCredentials -> CoinbaseProCredentials -> Bool)
-> Eq CoinbaseProCredentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoinbaseProCredentials -> CoinbaseProCredentials -> Bool
$c/= :: CoinbaseProCredentials -> CoinbaseProCredentials -> Bool
== :: CoinbaseProCredentials -> CoinbaseProCredentials -> Bool
$c== :: CoinbaseProCredentials -> CoinbaseProCredentials -> Bool
Eq)


newtype CBAuthT m a = CBAuthT { CBAuthT m a -> ReaderT CoinbaseProCredentials m a
unCbAuth :: ReaderT CoinbaseProCredentials m a }
    deriving (a -> CBAuthT m b -> CBAuthT m a
(a -> b) -> CBAuthT m a -> CBAuthT m b
(forall a b. (a -> b) -> CBAuthT m a -> CBAuthT m b)
-> (forall a b. a -> CBAuthT m b -> CBAuthT m a)
-> Functor (CBAuthT m)
forall a b. a -> CBAuthT m b -> CBAuthT m a
forall a b. (a -> b) -> CBAuthT m a -> CBAuthT m b
forall (m :: * -> *) a b.
Functor m =>
a -> CBAuthT m b -> CBAuthT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CBAuthT m a -> CBAuthT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CBAuthT m b -> CBAuthT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> CBAuthT m b -> CBAuthT m a
fmap :: (a -> b) -> CBAuthT m a -> CBAuthT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> CBAuthT m a -> CBAuthT m b
Functor, Functor (CBAuthT m)
a -> CBAuthT m a
Functor (CBAuthT m)
-> (forall a. a -> CBAuthT m a)
-> (forall a b. CBAuthT m (a -> b) -> CBAuthT m a -> CBAuthT m b)
-> (forall a b c.
    (a -> b -> c) -> CBAuthT m a -> CBAuthT m b -> CBAuthT m c)
-> (forall a b. CBAuthT m a -> CBAuthT m b -> CBAuthT m b)
-> (forall a b. CBAuthT m a -> CBAuthT m b -> CBAuthT m a)
-> Applicative (CBAuthT m)
CBAuthT m a -> CBAuthT m b -> CBAuthT m b
CBAuthT m a -> CBAuthT m b -> CBAuthT m a
CBAuthT m (a -> b) -> CBAuthT m a -> CBAuthT m b
(a -> b -> c) -> CBAuthT m a -> CBAuthT m b -> CBAuthT m c
forall a. a -> CBAuthT m a
forall a b. CBAuthT m a -> CBAuthT m b -> CBAuthT m a
forall a b. CBAuthT m a -> CBAuthT m b -> CBAuthT m b
forall a b. CBAuthT m (a -> b) -> CBAuthT m a -> CBAuthT m b
forall a b c.
(a -> b -> c) -> CBAuthT m a -> CBAuthT m b -> CBAuthT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (CBAuthT m)
forall (m :: * -> *) a. Applicative m => a -> CBAuthT m a
forall (m :: * -> *) a b.
Applicative m =>
CBAuthT m a -> CBAuthT m b -> CBAuthT m a
forall (m :: * -> *) a b.
Applicative m =>
CBAuthT m a -> CBAuthT m b -> CBAuthT m b
forall (m :: * -> *) a b.
Applicative m =>
CBAuthT m (a -> b) -> CBAuthT m a -> CBAuthT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> CBAuthT m a -> CBAuthT m b -> CBAuthT m c
<* :: CBAuthT m a -> CBAuthT m b -> CBAuthT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
CBAuthT m a -> CBAuthT m b -> CBAuthT m a
*> :: CBAuthT m a -> CBAuthT m b -> CBAuthT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
CBAuthT m a -> CBAuthT m b -> CBAuthT m b
liftA2 :: (a -> b -> c) -> CBAuthT m a -> CBAuthT m b -> CBAuthT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> CBAuthT m a -> CBAuthT m b -> CBAuthT m c
<*> :: CBAuthT m (a -> b) -> CBAuthT m a -> CBAuthT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
CBAuthT m (a -> b) -> CBAuthT m a -> CBAuthT m b
pure :: a -> CBAuthT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> CBAuthT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (CBAuthT m)
Applicative, Applicative (CBAuthT m)
a -> CBAuthT m a
Applicative (CBAuthT m)
-> (forall a b. CBAuthT m a -> (a -> CBAuthT m b) -> CBAuthT m b)
-> (forall a b. CBAuthT m a -> CBAuthT m b -> CBAuthT m b)
-> (forall a. a -> CBAuthT m a)
-> Monad (CBAuthT m)
CBAuthT m a -> (a -> CBAuthT m b) -> CBAuthT m b
CBAuthT m a -> CBAuthT m b -> CBAuthT m b
forall a. a -> CBAuthT m a
forall a b. CBAuthT m a -> CBAuthT m b -> CBAuthT m b
forall a b. CBAuthT m a -> (a -> CBAuthT m b) -> CBAuthT m b
forall (m :: * -> *). Monad m => Applicative (CBAuthT m)
forall (m :: * -> *) a. Monad m => a -> CBAuthT m a
forall (m :: * -> *) a b.
Monad m =>
CBAuthT m a -> CBAuthT m b -> CBAuthT m b
forall (m :: * -> *) a b.
Monad m =>
CBAuthT m a -> (a -> CBAuthT m b) -> CBAuthT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> CBAuthT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> CBAuthT m a
>> :: CBAuthT m a -> CBAuthT m b -> CBAuthT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
CBAuthT m a -> CBAuthT m b -> CBAuthT m b
>>= :: CBAuthT m a -> (a -> CBAuthT m b) -> CBAuthT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
CBAuthT m a -> (a -> CBAuthT m b) -> CBAuthT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (CBAuthT m)
Monad, Monad (CBAuthT m)
Monad (CBAuthT m)
-> (forall a. IO a -> CBAuthT m a) -> MonadIO (CBAuthT m)
IO a -> CBAuthT m a
forall a. IO a -> CBAuthT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (CBAuthT m)
forall (m :: * -> *) a. MonadIO m => IO a -> CBAuthT m a
liftIO :: IO a -> CBAuthT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> CBAuthT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (CBAuthT m)
MonadIO, m a -> CBAuthT m a
(forall (m :: * -> *) a. Monad m => m a -> CBAuthT m a)
-> MonadTrans CBAuthT
forall (m :: * -> *) a. Monad m => m a -> CBAuthT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> CBAuthT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> CBAuthT m a
MonadTrans, Monad (CBAuthT m)
e -> CBAuthT m a
Monad (CBAuthT m)
-> (forall e a. Exception e => e -> CBAuthT m a)
-> MonadThrow (CBAuthT m)
forall e a. Exception e => e -> CBAuthT m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (CBAuthT m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> CBAuthT m a
throwM :: e -> CBAuthT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> CBAuthT m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (CBAuthT m)
MonadThrow, MonadThrow (CBAuthT m)
MonadThrow (CBAuthT m)
-> (forall e a.
    Exception e =>
    CBAuthT m a -> (e -> CBAuthT m a) -> CBAuthT m a)
-> MonadCatch (CBAuthT m)
CBAuthT m a -> (e -> CBAuthT m a) -> CBAuthT m a
forall e a.
Exception e =>
CBAuthT m a -> (e -> CBAuthT m a) -> CBAuthT m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (CBAuthT m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
CBAuthT m a -> (e -> CBAuthT m a) -> CBAuthT m a
catch :: CBAuthT m a -> (e -> CBAuthT m a) -> CBAuthT m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
CBAuthT m a -> (e -> CBAuthT m a) -> CBAuthT m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (CBAuthT m)
MonadCatch, MonadCatch (CBAuthT m)
MonadCatch (CBAuthT m)
-> (forall b.
    ((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
    -> CBAuthT m b)
-> (forall b.
    ((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
    -> CBAuthT m b)
-> (forall a b c.
    CBAuthT m a
    -> (a -> ExitCase b -> CBAuthT m c)
    -> (a -> CBAuthT m b)
    -> CBAuthT m (b, c))
-> MonadMask (CBAuthT m)
CBAuthT m a
-> (a -> ExitCase b -> CBAuthT m c)
-> (a -> CBAuthT m b)
-> CBAuthT m (b, c)
((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
-> CBAuthT m b
((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
-> CBAuthT m b
forall b.
((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
-> CBAuthT m b
forall a b c.
CBAuthT m a
-> (a -> ExitCase b -> CBAuthT m c)
-> (a -> CBAuthT m b)
-> CBAuthT m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (CBAuthT m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
-> CBAuthT m b
forall (m :: * -> *) a b c.
MonadMask m =>
CBAuthT m a
-> (a -> ExitCase b -> CBAuthT m c)
-> (a -> CBAuthT m b)
-> CBAuthT m (b, c)
generalBracket :: CBAuthT m a
-> (a -> ExitCase b -> CBAuthT m c)
-> (a -> CBAuthT m b)
-> CBAuthT m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
CBAuthT m a
-> (a -> ExitCase b -> CBAuthT m c)
-> (a -> CBAuthT m b)
-> CBAuthT m (b, c)
uninterruptibleMask :: ((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
-> CBAuthT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
-> CBAuthT m b
mask :: ((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
-> CBAuthT m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. CBAuthT m a -> CBAuthT m a) -> CBAuthT m b)
-> CBAuthT m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (CBAuthT m)
MonadMask)


-- | Sequences `ClientM` actions using the same auth credentials
--
-- This allows for custom `Runner`s to be used.
runCbAuthT :: Runner a -> CoinbaseProCredentials -> CBAuthT ClientM a -> IO a
runCbAuthT :: Runner a -> CoinbaseProCredentials -> CBAuthT ClientM a -> IO a
runCbAuthT Runner a
runEnv CoinbaseProCredentials
cpc = Runner a
runEnv Runner a
-> (CBAuthT ClientM a -> ClientM a) -> CBAuthT ClientM a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT CoinbaseProCredentials ClientM a
 -> CoinbaseProCredentials -> ClientM a)
-> CoinbaseProCredentials
-> ReaderT CoinbaseProCredentials ClientM a
-> ClientM a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT CoinbaseProCredentials ClientM a
-> CoinbaseProCredentials -> ClientM a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT CoinbaseProCredentials
cpc (ReaderT CoinbaseProCredentials ClientM a -> ClientM a)
-> (CBAuthT ClientM a -> ReaderT CoinbaseProCredentials ClientM a)
-> CBAuthT ClientM a
-> ClientM a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CBAuthT ClientM a -> ReaderT CoinbaseProCredentials ClientM a
forall (m :: * -> *) a.
CBAuthT m a -> ReaderT CoinbaseProCredentials m a
unCbAuth


-- | Sequences `ClientM` actions using the same auth credentials
--
-- Should be used over `runCbAuthT` unless a bespoke `Runner` needs to be used.
runDefCbAuthT :: Environment -> CoinbaseProCredentials -> CBAuthT ClientM a -> IO a
runDefCbAuthT :: Environment -> CoinbaseProCredentials -> CBAuthT ClientM a -> IO a
runDefCbAuthT Environment
env = Runner a -> CoinbaseProCredentials -> CBAuthT ClientM a -> IO a
forall a.
Runner a -> CoinbaseProCredentials -> CBAuthT ClientM a -> IO a
runCbAuthT (Environment -> Runner a
forall a. Environment -> Runner a
run Environment
env)


type instance AuthClientData (AuthProtect "CBAuth") = (CBAccessKey, CBAccessSign, CBAccessTimeStamp, CBAccessPassphrase)


type CBAuthAPI (auth :: Symbol) method a = AuthProtect auth :> method '[JSON] a


type AuthGet a    = CBAuthAPI "CBAuth" Get a
type AuthPost a   = CBAuthAPI "CBAuth" Post a
type AuthDelete a = CBAuthAPI "CBAuth" Delete a


addAuthHeaders :: (CBAccessKey, CBAccessSign, CBAccessTimeStamp, CBAccessPassphrase) -> SCC.Request -> SCC.Request
addAuthHeaders :: (CBAccessKey, CBAccessSign, CBAccessTimeStamp, CBAccessPassphrase)
-> Request -> Request
addAuthHeaders (CBAccessKey
key, CBAccessSign
sig, CBAccessTimeStamp
timestamp, CBAccessPassphrase
pass) Request
req =
      HeaderName -> CBAccessKey -> Request -> Request
forall a. ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader HeaderName
"CB-ACCESS-KEY" CBAccessKey
key
    (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> CBAccessSign -> Request -> Request
forall a. ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader HeaderName
"CB-ACCESS-SIGN" CBAccessSign
sig
    (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> CBAccessTimeStamp -> Request -> Request
forall a. ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader HeaderName
"CB-ACCESS-TIMESTAMP" CBAccessTimeStamp
timestamp
    (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> CBAccessPassphrase -> Request -> Request
forall a. ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader HeaderName
"CB-ACCESS-PASSPHRASE" CBAccessPassphrase
pass
    (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> UserAgent -> Request -> Request
forall a. ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader HeaderName
"User-Agent" UserAgent
userAgent Request
req


authRequest :: Method -> RequestPath -> Body
            -> (AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM b)
            -> CBAuthT ClientM b
authRequest :: Method
-> Method
-> Method
-> (AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM b)
-> CBAuthT ClientM b
authRequest Method
method Method
requestPath Method
body AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM b
f = do
    CBAccessKey
ak <- ReaderT CoinbaseProCredentials ClientM CBAccessKey
-> CBAuthT ClientM CBAccessKey
forall (m :: * -> *) a.
ReaderT CoinbaseProCredentials m a -> CBAuthT m a
CBAuthT (ReaderT CoinbaseProCredentials ClientM CBAccessKey
 -> CBAuthT ClientM CBAccessKey)
-> ReaderT CoinbaseProCredentials ClientM CBAccessKey
-> CBAuthT ClientM CBAccessKey
forall a b. (a -> b) -> a -> b
$ (CoinbaseProCredentials -> CBAccessKey)
-> ReaderT CoinbaseProCredentials ClientM CBAccessKey
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks CoinbaseProCredentials -> CBAccessKey
cbAccessKey
    CBSecretKey
sk <- ReaderT CoinbaseProCredentials ClientM CBSecretKey
-> CBAuthT ClientM CBSecretKey
forall (m :: * -> *) a.
ReaderT CoinbaseProCredentials m a -> CBAuthT m a
CBAuthT (ReaderT CoinbaseProCredentials ClientM CBSecretKey
 -> CBAuthT ClientM CBSecretKey)
-> ReaderT CoinbaseProCredentials ClientM CBSecretKey
-> CBAuthT ClientM CBSecretKey
forall a b. (a -> b) -> a -> b
$ (CoinbaseProCredentials -> CBSecretKey)
-> ReaderT CoinbaseProCredentials ClientM CBSecretKey
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks CoinbaseProCredentials -> CBSecretKey
cbSecretKey
    CBAccessPassphrase
pp <- ReaderT CoinbaseProCredentials ClientM CBAccessPassphrase
-> CBAuthT ClientM CBAccessPassphrase
forall (m :: * -> *) a.
ReaderT CoinbaseProCredentials m a -> CBAuthT m a
CBAuthT (ReaderT CoinbaseProCredentials ClientM CBAccessPassphrase
 -> CBAuthT ClientM CBAccessPassphrase)
-> ReaderT CoinbaseProCredentials ClientM CBAccessPassphrase
-> CBAuthT ClientM CBAccessPassphrase
forall a b. (a -> b) -> a -> b
$ (CoinbaseProCredentials -> CBAccessPassphrase)
-> ReaderT CoinbaseProCredentials ClientM CBAccessPassphrase
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks CoinbaseProCredentials -> CBAccessPassphrase
cbAccessPassphrase

    CBAccessTimeStamp
ts <- IO CBAccessTimeStamp -> CBAuthT ClientM CBAccessTimeStamp
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CBAccessTimeStamp
mkCBAccessTimeStamp
    let cbs :: CBAccessSign
cbs = CBSecretKey
-> CBAccessTimeStamp -> Method -> Method -> Method -> CBAccessSign
mkCBAccessSign CBSecretKey
sk CBAccessTimeStamp
ts Method
method Method
requestPath Method
body
    ClientM b -> CBAuthT ClientM b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClientM b -> CBAuthT ClientM b)
-> (AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM b)
-> AuthenticatedRequest (AuthProtect "CBAuth")
-> CBAuthT ClientM b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthenticatedRequest (AuthProtect "CBAuth") -> ClientM b
f (AuthenticatedRequest (AuthProtect "CBAuth") -> CBAuthT ClientM b)
-> AuthenticatedRequest (AuthProtect "CBAuth") -> CBAuthT ClientM b
forall a b. (a -> b) -> a -> b
$ AuthClientData (AuthProtect "CBAuth")
-> (AuthClientData (AuthProtect "CBAuth") -> Request -> Request)
-> AuthenticatedRequest (AuthProtect "CBAuth")
forall a.
AuthClientData a
-> (AuthClientData a -> Request -> Request)
-> AuthenticatedRequest a
mkAuthenticatedRequest (CBAccessKey
ak, CBAccessSign
cbs, CBAccessTimeStamp
ts, CBAccessPassphrase
pp) (CBAccessKey, CBAccessSign, CBAccessTimeStamp, CBAccessPassphrase)
-> Request -> Request
AuthClientData (AuthProtect "CBAuth") -> Request -> Request
addAuthHeaders


mkCBAccessTimeStamp :: IO CBAccessTimeStamp
mkCBAccessTimeStamp :: IO CBAccessTimeStamp
mkCBAccessTimeStamp = Text -> CBAccessTimeStamp
CBAccessTimeStamp (Text -> CBAccessTimeStamp)
-> (UTCTime -> Text) -> UTCTime -> CBAccessTimeStamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (UTCTime -> String) -> UTCTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%s%Q" (UTCTime -> CBAccessTimeStamp)
-> IO UTCTime -> IO CBAccessTimeStamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime


mkCBAccessSign :: CBSecretKey -> CBAccessTimeStamp -> Method -> RequestPath -> Body -> CBAccessSign
mkCBAccessSign :: CBSecretKey
-> CBAccessTimeStamp -> Method -> Method -> Method -> CBAccessSign
mkCBAccessSign CBSecretKey
sk CBAccessTimeStamp
ts Method
method Method
requestPath Method
body = Method -> CBAccessSign
CBAccessSign (Method -> CBAccessSign) -> Method -> CBAccessSign
forall a b. (a -> b) -> a -> b
$ Base -> HMAC SHA256 -> Method
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base64 HMAC SHA256
hmac
  where
    dak :: Method
dak  = CBSecretKey -> Method
decodeApiKey CBSecretKey
sk
    msg :: Method
msg  = CBAccessTimeStamp -> Method -> Method -> Method -> Method
mkMsg CBAccessTimeStamp
ts Method
method Method
requestPath Method
body
    hmac :: HMAC SHA256
hmac = Method -> Method -> HMAC SHA256
forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
HMAC.hmac Method
dak Method
msg :: HMAC.HMAC SHA256

    mkMsg :: CBAccessTimeStamp -> Method -> RequestPath -> Body -> ByteString
    mkMsg :: CBAccessTimeStamp -> Method -> Method -> Method -> Method
mkMsg (CBAccessTimeStamp Text
s) Method
m Method
rp Method
b = Text -> Method
encodeUtf8 Text
s Method -> Method -> Method
forall a. Semigroup a => a -> a -> a
<> Method
m Method -> Method -> Method
forall a. Semigroup a => a -> a -> a
<> Method
rp Method -> Method -> Method
forall a. Semigroup a => a -> a -> a
<> Method
b


decodeApiKey :: CBSecretKey -> ByteString
decodeApiKey :: CBSecretKey -> Method
decodeApiKey (CBSecretKey String
s) = (String -> Method)
-> (Method -> Method) -> Either String Method -> Method
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Method
forall a. HasCallStack => String -> a
error Method -> Method
forall a. a -> a
id (Either String Method -> Method)
-> (Method -> Either String Method) -> Method -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Base -> Method -> Either String Method
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64 (Method -> Method) -> Method -> Method
forall a b. (a -> b) -> a -> b
$ String -> Method
C8.pack String
s