From e21e62b3d17fb929f8ab14887af18b29e0e4e15f Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Tue, 27 Sep 2016 17:15:31 +0700
Subject: [PATCH] Broker Protocol definitions

---
 src/ATrade/Broker/Protocol.hs | 40 +++++++++++++++++++++++++++++++++++
 test/Spec.hs                  |  3 ++-
 test/TestBrokerProtocol.hs    | 18 ++++++++++++++++
 3 files changed, 60 insertions(+), 1 deletion(-)
 create mode 100644 src/ATrade/Broker/Protocol.hs
 create mode 100644 test/TestBrokerProtocol.hs

diff --git a/src/ATrade/Broker/Protocol.hs b/src/ATrade/Broker/Protocol.hs
new file mode 100644
index 0000000..1d075bc
--- /dev/null
+++ b/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]
diff --git a/test/Spec.hs b/test/Spec.hs
index 4cbd795..4c11d9e 100644
--- a/test/Spec.hs
+++ b/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]
diff --git a/test/TestBrokerProtocol.hs b/test/TestBrokerProtocol.hs
new file mode 100644
index 0000000..b64e770
--- /dev/null
+++ b/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" []
+