Broker Protocol definitions

src/ATrade/Broker/Protocol.hs

@@ -0,0 +1,40 @@
+
+module ATrade.Broker.Protocol (
+) where
+
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Text as T
+import Data.Aeson
+import Data.Int
+import ATrade.Types
+
+type RequestSqnum = Int64
+
+data BrokerServerRequest = RequestSubmitOrder Order
+  | RequestCancelOrder OrderId
+  | RequestNotifications
+
+data BrokerServerResponse = ResponseOrderSubmitted OrderId
+  | ResponseOrderCancelled
+  | ResponseNotifications [Notification]
+
+data Notification = OrderNotification OrderId OrderState | TradeNotification Trade
+  deriving (Eq, Show)
+
+instance FromJSON Notification where
+  parseJSON n = withObject "notification" (\obj ->
+    case HM.lookup "trade" obj of
+      Just v -> parseTrade v
+      Nothing -> parseOrder n) n
+    where
+      parseTrade v = TradeNotification <$> parseJSON v
+      parseOrder (Object o) = case HM.lookup "order-state" o of
+        Just v -> withObject "object" (\os -> do
+          oid <- os .: "order-id"
+          ns <- os .: "new-state"
+          return $ OrderNotification oid ns) v
+        Nothing -> fail "Should be order-state"
+
+instance ToJSON Notification where
+  toJSON (OrderNotification oid newState) = object ["order-state" .= object [ "order-id" .= oid, "new-state" .= newState] ]
+  toJSON (TradeNotification trade) = object ["trade" .= toJSON trade]

test/Spec.hs

@@ -1,5 +1,6 @@
 
 import qualified TestTypes
+import qualified TestBrokerProtocol
 import qualified TestQuoteSourceServer
 
 import Test.Tasty
@@ -8,7 +9,7 @@ main :: IO ()
 main = defaultMain $ testGroup "Tests" [properties, unitTests]
 
 properties :: TestTree
-properties = testGroup "Properties" [TestTypes.properties]
+properties = testGroup "Properties" [TestTypes.properties, TestBrokerProtocol.properties]
 
 unitTests :: TestTree
 unitTests = testGroup "Unit-tests" [TestQuoteSourceServer.unitTests]

test/TestBrokerProtocol.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances #-}
+{-# LANGUAGE MultiWayIf #-}
+
+module TestBrokerProtocol (
+  properties
+) where
+
+import Test.Tasty
+import Test.Tasty.SmallCheck as SC
+import Test.Tasty.QuickCheck as QC
+import Test.Tasty.HUnit
+import Test.QuickCheck.Instances hiding (Text)
+
+import ATrade.Types
+import ATrade.Broker.Protocol
+
+properties = testGroup "Broker.Protocol" []
+