{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

module CoinbasePro.WebSocketFeed.Request
  ( RequestMessageType (..)
  , ChannelName(..)
  , WebSocketFeedRequest (..)
  , AuthenticatedWebSocketFeedRequest

  , authenticatedWebSocketFeedRequest
  ) where

import           Control.Monad.IO.Class            (liftIO)
import           Data.Aeson                        (FromJSON (..), ToJSON (..),
                                                    object, withText, (.=))
import           Network.HTTP.Types                (methodGet)

import           CoinbasePro.Authenticated.Headers (CBAccessKey (..),
                                                    CBAccessPassphrase (..),
                                                    CBAccessSign (..),
                                                    CBAccessTimeStamp (..))
import           CoinbasePro.Authenticated.Request (CoinbaseProCredentials (..),
                                                    mkCBAccessSign,
                                                    mkCBAccessTimeStamp)
import           CoinbasePro.Request               (emptyBody,
                                                    encodeRequestPath)
import           CoinbasePro.Types                 (ProductId)


data RequestMessageType = Subscribe | Unsubscribe
    deriving (RequestMessageType -> RequestMessageType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestMessageType -> RequestMessageType -> Bool
$c/= :: RequestMessageType -> RequestMessageType -> Bool
== :: RequestMessageType -> RequestMessageType -> Bool
$c== :: RequestMessageType -> RequestMessageType -> Bool
Eq, Eq RequestMessageType
RequestMessageType -> RequestMessageType -> Bool
RequestMessageType -> RequestMessageType -> Ordering
RequestMessageType -> RequestMessageType -> RequestMessageType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RequestMessageType -> RequestMessageType -> RequestMessageType
$cmin :: RequestMessageType -> RequestMessageType -> RequestMessageType
max :: RequestMessageType -> RequestMessageType -> RequestMessageType
$cmax :: RequestMessageType -> RequestMessageType -> RequestMessageType
>= :: RequestMessageType -> RequestMessageType -> Bool
$c>= :: RequestMessageType -> RequestMessageType -> Bool
> :: RequestMessageType -> RequestMessageType -> Bool
$c> :: RequestMessageType -> RequestMessageType -> Bool
<= :: RequestMessageType -> RequestMessageType -> Bool
$c<= :: RequestMessageType -> RequestMessageType -> Bool
< :: RequestMessageType -> RequestMessageType -> Bool
$c< :: RequestMessageType -> RequestMessageType -> Bool
compare :: RequestMessageType -> RequestMessageType -> Ordering
$ccompare :: RequestMessageType -> RequestMessageType -> Ordering
Ord)


instance Show RequestMessageType where
    show :: RequestMessageType -> String
show RequestMessageType
Subscribe   = String
"subscribe"
    show RequestMessageType
Unsubscribe = String
"unsubscribe"


data ChannelName = Heartbeat | Status | Ticker | Level2 | Matches | Full
    deriving (ChannelName -> ChannelName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChannelName -> ChannelName -> Bool
$c/= :: ChannelName -> ChannelName -> Bool
== :: ChannelName -> ChannelName -> Bool
$c== :: ChannelName -> ChannelName -> Bool
Eq, Eq ChannelName
ChannelName -> ChannelName -> Bool
ChannelName -> ChannelName -> Ordering
ChannelName -> ChannelName -> ChannelName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChannelName -> ChannelName -> ChannelName
$cmin :: ChannelName -> ChannelName -> ChannelName
max :: ChannelName -> ChannelName -> ChannelName
$cmax :: ChannelName -> ChannelName -> ChannelName
>= :: ChannelName -> ChannelName -> Bool
$c>= :: ChannelName -> ChannelName -> Bool
> :: ChannelName -> ChannelName -> Bool
$c> :: ChannelName -> ChannelName -> Bool
<= :: ChannelName -> ChannelName -> Bool
$c<= :: ChannelName -> ChannelName -> Bool
< :: ChannelName -> ChannelName -> Bool
$c< :: ChannelName -> ChannelName -> Bool
compare :: ChannelName -> ChannelName -> Ordering
$ccompare :: ChannelName -> ChannelName -> Ordering
Ord)


instance Show ChannelName where
    show :: ChannelName -> String
show ChannelName
Heartbeat = String
"heartbeat"
    show ChannelName
Status    = String
"status"
    show ChannelName
Ticker    = String
"ticker"
    show ChannelName
Level2    = String
"level2"
    show ChannelName
Matches   = String
"matches"
    show ChannelName
Full      = String
"full"


instance ToJSON ChannelName where
    toJSON :: ChannelName -> Value
toJSON ChannelName
Heartbeat = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ChannelName
Heartbeat
    toJSON ChannelName
Status    = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ChannelName
Status
    toJSON ChannelName
Ticker    = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ChannelName
Ticker
    toJSON ChannelName
Level2    = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ChannelName
Level2
    toJSON ChannelName
Matches   = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ChannelName
Matches
    toJSON ChannelName
Full      = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ChannelName
Full


instance FromJSON ChannelName where
    parseJSON :: Value -> Parser ChannelName
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"channel name" forall a b. (a -> b) -> a -> b
$ \case
        Text
"heartbeat" -> forall (m :: * -> *) a. Monad m => a -> m a
return ChannelName
Heartbeat
        Text
"status"    -> forall (m :: * -> *) a. Monad m => a -> m a
return ChannelName
Status
        Text
"ticker"    -> forall (m :: * -> *) a. Monad m => a -> m a
return ChannelName
Ticker
        Text
"level2"    -> forall (m :: * -> *) a. Monad m => a -> m a
return ChannelName
Level2
        Text
"matches"   -> forall (m :: * -> *) a. Monad m => a -> m a
return ChannelName
Matches
        Text
"full"      -> forall (m :: * -> *) a. Monad m => a -> m a
return ChannelName
Full
        Text
_           -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse channel"


data WebSocketFeedRequest = WebSocketFeedRequest
    { WebSocketFeedRequest -> RequestMessageType
reqMsgType    :: RequestMessageType
    , WebSocketFeedRequest -> [ProductId]
reqProductIds :: [ProductId]
    , WebSocketFeedRequest -> [ChannelName]
reqChannels   :: [ChannelName]
    } deriving (WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
$c/= :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
== :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
$c== :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
Eq, Eq WebSocketFeedRequest
WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
WebSocketFeedRequest -> WebSocketFeedRequest -> Ordering
WebSocketFeedRequest
-> WebSocketFeedRequest -> WebSocketFeedRequest
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WebSocketFeedRequest
-> WebSocketFeedRequest -> WebSocketFeedRequest
$cmin :: WebSocketFeedRequest
-> WebSocketFeedRequest -> WebSocketFeedRequest
max :: WebSocketFeedRequest
-> WebSocketFeedRequest -> WebSocketFeedRequest
$cmax :: WebSocketFeedRequest
-> WebSocketFeedRequest -> WebSocketFeedRequest
>= :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
$c>= :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
> :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
$c> :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
<= :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
$c<= :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
< :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
$c< :: WebSocketFeedRequest -> WebSocketFeedRequest -> Bool
compare :: WebSocketFeedRequest -> WebSocketFeedRequest -> Ordering
$ccompare :: WebSocketFeedRequest -> WebSocketFeedRequest -> Ordering
Ord, Int -> WebSocketFeedRequest -> ShowS
[WebSocketFeedRequest] -> ShowS
WebSocketFeedRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebSocketFeedRequest] -> ShowS
$cshowList :: [WebSocketFeedRequest] -> ShowS
show :: WebSocketFeedRequest -> String
$cshow :: WebSocketFeedRequest -> String
showsPrec :: Int -> WebSocketFeedRequest -> ShowS
$cshowsPrec :: Int -> WebSocketFeedRequest -> ShowS
Show)


instance ToJSON WebSocketFeedRequest where
    toJSON :: WebSocketFeedRequest -> Value
toJSON (WebSocketFeedRequest RequestMessageType
rmt [ProductId]
rpi [ChannelName]
rc) = [Pair] -> Value
object
        [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show RequestMessageType
rmt
        , Key
"product_ids" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ProductId]
rpi
        , Key
"channels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [ChannelName]
rc
        ]

data AuthenticatedWebSocketFeedRequest =
  AuthenticatedWebSocketFeedRequest WebSocketFeedRequest CBAccessSign CBAccessKey CBAccessPassphrase CBAccessTimeStamp


instance ToJSON AuthenticatedWebSocketFeedRequest where
    toJSON :: AuthenticatedWebSocketFeedRequest -> Value
toJSON (AuthenticatedWebSocketFeedRequest WebSocketFeedRequest
req CBAccessSign
s CBAccessKey
k CBAccessPassphrase
p CBAccessTimeStamp
t) = [Pair] -> Value
object
        [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. Show a => a -> String
show (WebSocketFeedRequest -> RequestMessageType
reqMsgType WebSocketFeedRequest
req)
        , Key
"product_ids" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebSocketFeedRequest -> [ProductId]
reqProductIds WebSocketFeedRequest
req
        , Key
"channels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebSocketFeedRequest -> [ChannelName]
reqChannels WebSocketFeedRequest
req
        , Key
"signature" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CBAccessSign
s
        , Key
"key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CBAccessKey
k
        , Key
"passphrase" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CBAccessPassphrase
p
        , Key
"timestamp" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= CBAccessTimeStamp
t
        ]

authenticatedWebSocketFeedRequest :: WebSocketFeedRequest
                                  -> CoinbaseProCredentials
                                  -> IO AuthenticatedWebSocketFeedRequest
authenticatedWebSocketFeedRequest :: WebSocketFeedRequest
-> CoinbaseProCredentials -> IO AuthenticatedWebSocketFeedRequest
authenticatedWebSocketFeedRequest WebSocketFeedRequest
wsRequest CoinbaseProCredentials
cpc = do
    CBAccessTimeStamp
ts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO CBAccessTimeStamp
mkCBAccessTimeStamp
    let cbs :: CBAccessSign
cbs = CBSecretKey
-> CBAccessTimeStamp -> Method -> Method -> Method -> CBAccessSign
mkCBAccessSign (CoinbaseProCredentials -> CBSecretKey
cbSecretKey CoinbaseProCredentials
cpc) CBAccessTimeStamp
ts Method
methodGet Method
authSubscriptionPath Method
emptyBody
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ WebSocketFeedRequest
-> CBAccessSign
-> CBAccessKey
-> CBAccessPassphrase
-> CBAccessTimeStamp
-> AuthenticatedWebSocketFeedRequest
AuthenticatedWebSocketFeedRequest WebSocketFeedRequest
wsRequest CBAccessSign
cbs (CoinbaseProCredentials -> CBAccessKey
cbAccessKey CoinbaseProCredentials
cpc) (CoinbaseProCredentials -> CBAccessPassphrase
cbAccessPassphrase CoinbaseProCredentials
cpc) CBAccessTimeStamp
ts
  where
    authSubscriptionPath :: Method
authSubscriptionPath = [Text] -> Method
encodeRequestPath [Text
"users", Text
"self", Text
"verify"]