{-# LANGUAGE OverloadedStrings #-}

module CoinbasePro.WebSocketFeed
    ( subscribeToFeed
    ) where

import           Control.Concurrent                 (forkIO)
import           Control.Exception                  (Exception, throwIO)
import           Control.Monad                      (forever)
import           Data.Aeson                         (decode', encode)
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 (..))
import           CoinbasePro.Environment            (Environment,
                                                     WSConnection (..),
                                                     wsEndpoint)
import           CoinbasePro.Types                  (ProductId)
import           CoinbasePro.WebSocketFeed.Channel  (ChannelMessage (..))
import           CoinbasePro.WebSocketFeed.Request  (ChannelName (..),
                                                     RequestMessageType (..),
                                                     WebSocketFeedRequest (..),
                                                     authenticatedWebSocketFeedRequest)


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
authWsRequest)
    wsRequest :: WebSocketFeedRequest
wsRequest     = RequestMessageType
-> [ProductId] -> [ChannelName] -> WebSocketFeedRequest
WebSocketFeedRequest RequestMessageType
Subscribe [ProductId]
prids [ChannelName]
channels
    authWsRequest :: CoinbaseProCredentials -> IO AuthenticatedWebSocketFeedRequest
authWsRequest = WebSocketFeedRequest
-> CoinbaseProCredentials -> IO AuthenticatedWebSocketFeedRequest
authenticatedWebSocketFeedRequest WebSocketFeedRequest
wsRequest


parseFeed :: WS.Connection -> IO ChannelMessage
parseFeed :: Connection -> IO ChannelMessage
parseFeed Connection
conn = Connection -> IO ByteString
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
conn IO ByteString
-> (ByteString -> IO ChannelMessage) -> IO ChannelMessage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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)
-> (ByteString -> Maybe ChannelMessage)
-> ByteString
-> IO ChannelMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ChannelMessage
forall a. FromJSON a => ByteString -> Maybe a
decode'
  where err :: IO a
err = ParseException -> IO a
forall e a. Exception e => e -> IO a
throwIO ParseException
ParseException