{-# LANGUAGE OverloadedStrings #-}

module CoinbasePro.WebSocketFeed
    ( subscribeToFeed
    ) where

import           Control.Concurrent                 (forkIO)
import           Control.Exception                  (Exception, throwIO)
import           Control.Monad                      (forever)
import           Control.Monad.IO.Class             (liftIO)
import           Data.Aeson                         (decode', encode)
import           Network.HTTP.Types                 (methodGet)
import qualified Network.WebSockets                 as WS
import qualified System.IO.Streams                  as Streams
import           System.IO.Streams.Concurrent.Unagi (makeChanPipe)
import qualified Wuss                               as WU

import           CoinbasePro.Authenticated.Request  (CoinbaseProCredentials (..),
                                                     mkCBAccessSign,
                                                     mkCBAccessTimeStamp)
import           CoinbasePro.Environment            (Environment,
                                                     WSConnection (..),
                                                     wsEndpoint)
import           CoinbasePro.Request                (emptyBody)
import           CoinbasePro.Types                  (ProductId)
import           CoinbasePro.WebSocketFeed.Channel  (ChannelMessage (..))
import           CoinbasePro.WebSocketFeed.Request  (AuthenticatedWebSocketFeedRequest (..),
                                                     ChannelName (..),
                                                     RequestMessageType (..),
                                                     WebSocketFeedRequest (..))


data ParseException = ParseException deriving Int -> ParseException -> ShowS
[ParseException] -> ShowS
ParseException -> String
(Int -> ParseException -> ShowS)
-> (ParseException -> String)
-> ([ParseException] -> ShowS)
-> Show ParseException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseException] -> ShowS
$cshowList :: [ParseException] -> ShowS
show :: ParseException -> String
$cshow :: ParseException -> String
showsPrec :: Int -> ParseException -> ShowS
$cshowsPrec :: Int -> ParseException -> ShowS
Show
instance Exception ParseException


subscribeToFeed :: [ProductId] -> [ChannelName] -> Environment -> Maybe CoinbaseProCredentials -> IO (Streams.InputStream ChannelMessage)
subscribeToFeed :: [ProductId]
-> [ChannelName]
-> Environment
-> Maybe CoinbaseProCredentials
-> IO (InputStream ChannelMessage)
subscribeToFeed [ProductId]
prds [ChannelName]
channels Environment
env = WSConnection
-> [ProductId]
-> [ChannelName]
-> Maybe CoinbaseProCredentials
-> IO (InputStream ChannelMessage)
subscribe (Environment -> WSConnection
wsEndpoint Environment
env) [ProductId]
prds [ChannelName]
channels


subscribe :: WSConnection -> [ProductId] -> [ChannelName] -> Maybe CoinbaseProCredentials -> IO (Streams.InputStream ChannelMessage)
subscribe :: WSConnection
-> [ProductId]
-> [ChannelName]
-> Maybe CoinbaseProCredentials
-> IO (InputStream ChannelMessage)
subscribe WSConnection
wsConn [ProductId]
prids [ChannelName]
channels Maybe CoinbaseProCredentials
cpc = do
    (InputStream ChannelMessage
is, OutputStream ChannelMessage
os) <- IO (InputStream ChannelMessage, OutputStream ChannelMessage)
forall a. IO (InputStream a, OutputStream a)
makeChanPipe
    ByteString
req      <- Maybe CoinbaseProCredentials -> IO ByteString
mkWsRequest Maybe CoinbaseProCredentials
cpc

    ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId)
-> (ClientApp () -> IO ()) -> ClientApp () -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PortNumber -> String -> ClientApp () -> IO ()
forall a. String -> PortNumber -> String -> ClientApp a -> IO a
WU.runSecureClient String
wsHost PortNumber
wsPort String
"/" (ClientApp () -> IO ThreadId) -> ClientApp () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
        Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
conn ByteString
req
        IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ChannelMessage
parseFeed Connection
conn IO ChannelMessage -> (ChannelMessage -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= OutputStream ChannelMessage -> Maybe ChannelMessage -> IO ()
forall a. OutputStream a -> Maybe a -> IO ()
Streams.writeTo OutputStream ChannelMessage
os (Maybe ChannelMessage -> IO ())
-> (ChannelMessage -> Maybe ChannelMessage)
-> ChannelMessage
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChannelMessage -> Maybe ChannelMessage
forall a. a -> Maybe a
Just

    InputStream ChannelMessage -> IO (InputStream ChannelMessage)
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream ChannelMessage
is
  where
    wsHost :: String
wsHost = WSConnection -> String
host WSConnection
wsConn
    wsPort :: PortNumber
wsPort = WSConnection -> PortNumber
port WSConnection
wsConn

    mkWsRequest :: Maybe CoinbaseProCredentials -> IO ByteString
mkWsRequest = IO ByteString
-> (CoinbaseProCredentials -> IO ByteString)
-> Maybe CoinbaseProCredentials
-> IO ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ WebSocketFeedRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode WebSocketFeedRequest
wsRequest) ((AuthenticatedWebSocketFeedRequest -> ByteString)
-> IO AuthenticatedWebSocketFeedRequest -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuthenticatedWebSocketFeedRequest -> ByteString
forall a. ToJSON a => a -> ByteString
encode (IO AuthenticatedWebSocketFeedRequest -> IO ByteString)
-> (CoinbaseProCredentials -> IO AuthenticatedWebSocketFeedRequest)
-> CoinbaseProCredentials
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoinbaseProCredentials -> IO AuthenticatedWebSocketFeedRequest
forall (m :: * -> *).
MonadIO m =>
CoinbaseProCredentials -> m AuthenticatedWebSocketFeedRequest
authWsRequest)

    wsRequest :: WebSocketFeedRequest
wsRequest = RequestMessageType
-> [ProductId] -> [ChannelName] -> WebSocketFeedRequest
WebSocketFeedRequest RequestMessageType
Subscribe [ProductId]
prids [ChannelName]
channels

    authWsRequest :: CoinbaseProCredentials -> m AuthenticatedWebSocketFeedRequest
authWsRequest CoinbaseProCredentials
cpc' = do
        CBAccessTimeStamp
ts <- IO CBAccessTimeStamp -> m 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
-> m AuthenticatedWebSocketFeedRequest
forall (m :: * -> *) a. Monad m => a -> m a
return (AuthenticatedWebSocketFeedRequest
 -> m AuthenticatedWebSocketFeedRequest)
-> AuthenticatedWebSocketFeedRequest
-> m 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

    authSubscriptionPath :: Method
authSubscriptionPath = Method
"/users/self/verify"


parseFeed :: WS.Connection -> IO ChannelMessage
parseFeed :: Connection -> IO ChannelMessage
parseFeed Connection
conn = IO ChannelMessage
-> (ChannelMessage -> IO ChannelMessage)
-> Maybe ChannelMessage
-> IO ChannelMessage
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ChannelMessage
forall a. IO a
err ChannelMessage -> IO ChannelMessage
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ChannelMessage -> IO ChannelMessage)
-> IO (Maybe ChannelMessage) -> IO ChannelMessage
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (ByteString -> Maybe ChannelMessage
forall a. FromJSON a => ByteString -> Maybe a
decode' (ByteString -> Maybe ChannelMessage)
-> IO ByteString -> IO (Maybe ChannelMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO ByteString
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
conn)
  where err :: IO a
err = ParseException -> IO a
forall e a. Exception e => e -> IO a
throwIO ParseException
ParseException