{-# 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 (RequestMessageType -> RequestMessageType -> Bool) -> (RequestMessageType -> RequestMessageType -> Bool) -> Eq RequestMessageType 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 Eq RequestMessageType -> (RequestMessageType -> RequestMessageType -> Ordering) -> (RequestMessageType -> RequestMessageType -> Bool) -> (RequestMessageType -> RequestMessageType -> Bool) -> (RequestMessageType -> RequestMessageType -> Bool) -> (RequestMessageType -> RequestMessageType -> Bool) -> (RequestMessageType -> RequestMessageType -> RequestMessageType) -> (RequestMessageType -> RequestMessageType -> RequestMessageType) -> Ord 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 $cp1Ord :: Eq RequestMessageType 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 (ChannelName -> ChannelName -> Bool) -> (ChannelName -> ChannelName -> Bool) -> Eq ChannelName 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 Eq ChannelName -> (ChannelName -> ChannelName -> Ordering) -> (ChannelName -> ChannelName -> Bool) -> (ChannelName -> ChannelName -> Bool) -> (ChannelName -> ChannelName -> Bool) -> (ChannelName -> ChannelName -> Bool) -> (ChannelName -> ChannelName -> ChannelName) -> (ChannelName -> ChannelName -> ChannelName) -> Ord 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 $cp1Ord :: Eq ChannelName 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 = String -> Value forall a. ToJSON a => a -> Value toJSON (String -> Value) -> String -> Value forall a b. (a -> b) -> a -> b $ ChannelName -> String forall a. Show a => a -> String show ChannelName Heartbeat toJSON ChannelName Status = String -> Value forall a. ToJSON a => a -> Value toJSON (String -> Value) -> String -> Value forall a b. (a -> b) -> a -> b $ ChannelName -> String forall a. Show a => a -> String show ChannelName Status toJSON ChannelName Ticker = String -> Value forall a. ToJSON a => a -> Value toJSON (String -> Value) -> String -> Value forall a b. (a -> b) -> a -> b $ ChannelName -> String forall a. Show a => a -> String show ChannelName Ticker toJSON ChannelName Level2 = String -> Value forall a. ToJSON a => a -> Value toJSON (String -> Value) -> String -> Value forall a b. (a -> b) -> a -> b $ ChannelName -> String forall a. Show a => a -> String show ChannelName Level2 toJSON ChannelName Matches = String -> Value forall a. ToJSON a => a -> Value toJSON (String -> Value) -> String -> Value forall a b. (a -> b) -> a -> b $ ChannelName -> String forall a. Show a => a -> String show ChannelName Matches toJSON ChannelName Full = String -> Value forall a. ToJSON a => a -> Value toJSON (String -> Value) -> String -> Value forall a b. (a -> b) -> a -> b $ ChannelName -> String forall a. Show a => a -> String show ChannelName Full instance FromJSON ChannelName where parseJSON :: Value -> Parser ChannelName parseJSON = String -> (Text -> Parser ChannelName) -> Value -> Parser ChannelName forall a. String -> (Text -> Parser a) -> Value -> Parser a withText String "channel name" ((Text -> Parser ChannelName) -> Value -> Parser ChannelName) -> (Text -> Parser ChannelName) -> Value -> Parser ChannelName forall a b. (a -> b) -> a -> b $ \case Text "heartbeat" -> ChannelName -> Parser ChannelName forall (m :: * -> *) a. Monad m => a -> m a return ChannelName Heartbeat Text "status" -> ChannelName -> Parser ChannelName forall (m :: * -> *) a. Monad m => a -> m a return ChannelName Status Text "ticker" -> ChannelName -> Parser ChannelName forall (m :: * -> *) a. Monad m => a -> m a return ChannelName Ticker Text "level2" -> ChannelName -> Parser ChannelName forall (m :: * -> *) a. Monad m => a -> m a return ChannelName Level2 Text "matches" -> ChannelName -> Parser ChannelName forall (m :: * -> *) a. Monad m => a -> m a return ChannelName Matches Text "full" -> ChannelName -> Parser ChannelName forall (m :: * -> *) a. Monad m => a -> m a return ChannelName Full Text _ -> String -> Parser ChannelName 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 (WebSocketFeedRequest -> WebSocketFeedRequest -> Bool) -> (WebSocketFeedRequest -> WebSocketFeedRequest -> Bool) -> Eq WebSocketFeedRequest 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 Eq WebSocketFeedRequest -> (WebSocketFeedRequest -> WebSocketFeedRequest -> Ordering) -> (WebSocketFeedRequest -> WebSocketFeedRequest -> Bool) -> (WebSocketFeedRequest -> WebSocketFeedRequest -> Bool) -> (WebSocketFeedRequest -> WebSocketFeedRequest -> Bool) -> (WebSocketFeedRequest -> WebSocketFeedRequest -> Bool) -> (WebSocketFeedRequest -> WebSocketFeedRequest -> WebSocketFeedRequest) -> (WebSocketFeedRequest -> WebSocketFeedRequest -> WebSocketFeedRequest) -> Ord 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 $cp1Ord :: Eq WebSocketFeedRequest Ord, Int -> WebSocketFeedRequest -> ShowS [WebSocketFeedRequest] -> ShowS WebSocketFeedRequest -> String (Int -> WebSocketFeedRequest -> ShowS) -> (WebSocketFeedRequest -> String) -> ([WebSocketFeedRequest] -> ShowS) -> Show WebSocketFeedRequest 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 [ Text "type" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= RequestMessageType -> String forall a. Show a => a -> String show RequestMessageType rmt , Text "product_ids" Text -> [ProductId] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= [ProductId] rpi , Text "channels" Text -> [ChannelName] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 [ Text "type" Text -> String -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= RequestMessageType -> String forall a. Show a => a -> String show (WebSocketFeedRequest -> RequestMessageType reqMsgType WebSocketFeedRequest req) , Text "product_ids" Text -> [ProductId] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= WebSocketFeedRequest -> [ProductId] reqProductIds WebSocketFeedRequest req , Text "channels" Text -> [ChannelName] -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= WebSocketFeedRequest -> [ChannelName] reqChannels WebSocketFeedRequest req , Text "signature" Text -> CBAccessSign -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= CBAccessSign s , Text "key" Text -> CBAccessKey -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= CBAccessKey k , Text "passphrase" Text -> CBAccessPassphrase -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= CBAccessPassphrase p , Text "timestamp" Text -> CBAccessTimeStamp -> Pair forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv .= CBAccessTimeStamp t ] authenticatedWebSocketFeedRequest :: WebSocketFeedRequest -> CoinbaseProCredentials -> IO AuthenticatedWebSocketFeedRequest authenticatedWebSocketFeedRequest :: WebSocketFeedRequest -> CoinbaseProCredentials -> IO AuthenticatedWebSocketFeedRequest authenticatedWebSocketFeedRequest WebSocketFeedRequest wsRequest CoinbaseProCredentials cpc = do CBAccessTimeStamp ts <- IO CBAccessTimeStamp -> IO 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 (CoinbaseProCredentials -> CBSecretKey cbSecretKey CoinbaseProCredentials cpc) CBAccessTimeStamp ts Method methodGet Method authSubscriptionPath Method emptyBody AuthenticatedWebSocketFeedRequest -> IO AuthenticatedWebSocketFeedRequest forall (m :: * -> *) a. Monad m => a -> m a return (AuthenticatedWebSocketFeedRequest -> IO AuthenticatedWebSocketFeedRequest) -> AuthenticatedWebSocketFeedRequest -> IO AuthenticatedWebSocketFeedRequest 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"]