robocom-zero/src/ATrade/Driver/Junction/BrokerService.hs

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}

module ATrade.Driver.Junction.BrokerService
  (
    BrokerService,
    mkBrokerService,
    submitOrder,
    cancelOrder,
    getNotifications
  ) where

import qualified ATrade.Broker.Client       as Bro
import           ATrade.Broker.Protocol     (Notification (..))
import           ATrade.Logging             (Message, logDebug, logWarning)
import           ATrade.Types               (Order (..), OrderId)
import           Colog                      (WithLog)
import           Control.Monad.IO.Class     (MonadIO (liftIO))
import           Control.Monad.Reader.Class (MonadReader)
import           Data.IORef                 (IORef, atomicModifyIORef',
                                             newIORef)
import qualified Data.Map.Strict            as M
import qualified Data.Text                  as T

data BrokerService =
  BrokerService
  {
    broker         :: Bro.BrokerClientHandle,
    orderMap       :: IORef (M.Map OrderId T.Text),
    orderIdCounter :: IORef OrderId
  }

mkBrokerService :: Bro.BrokerClientHandle -> IORef (M.Map OrderId T.Text) -> IO BrokerService
mkBrokerService h om = BrokerService h om <$> newIORef 1

submitOrder :: (MonadIO m, WithLog env Message m, MonadReader env m) => BrokerService -> T.Text -> Order -> m OrderId
submitOrder service identity order = do
  oid <- nextOrderId service
  logDebug "BrokerService" $ "New order, id: " <> (T.pack . show) oid
  liftIO $ atomicModifyIORef' (orderMap service) (\s -> (M.insert oid identity s, ()))
  r <- liftIO $ Bro.submitOrder (broker service) order { orderId = oid }
  case r of
    Left err -> logWarning "BrokerService" $ "Submit order error: " <> err
    _        -> return ()
  return oid
  where
    nextOrderId srv = liftIO $ atomicModifyIORef' (orderIdCounter srv) (\s -> (s + 1, s))

cancelOrder :: (MonadIO m, WithLog env Message m) => BrokerService -> OrderId -> m ()
cancelOrder service oid = do
  r <- liftIO $ Bro.cancelOrder (broker service) oid
  case r of
    Left err -> logWarning "BrokerServer" $ "Cancel order error: " <> err
    _        -> return ()
  return ()

getNotifications :: (MonadIO m, WithLog env Message m) => BrokerService -> m [Notification]
getNotifications service = do
  v <- liftIO $ Bro.getNotifications (broker service)
  case v of
    Left err  -> do
      logWarning "BrokerServer" $ "Get notifications order error: " <> err
      return []
    Right n -> return n