error handling for logon

bitnomial · Jun 7, 2024 · dc7e9eb · dc7e9eb
1 parent 96ae9a9
commit dc7e9eb
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 8 deletions.
diff --git a/cqg-cms-api-client/app/cqg-cms-example/Main.hs b/cqg-cms-api-client/app/cqg-cms-example/Main.hs
@@ -66,4 +66,5 @@ app ::
     Connection ->
     IO ()
 app cqgUsername cqgPassword cqgClientAppId conn = do
-    logon cqgUsername cqgPassword cqgClientAppId conn
+    x <- logon cqgUsername cqgPassword cqgClientAppId conn
+    print x
diff --git a/cqg-cms-api-client/src/Lib.hs b/cqg-cms-api-client/src/Lib.hs
@@ -1,17 +1,25 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE LambdaCase #-}
 
 module Lib (logon) where
 
 import Data.Function ((&))
 import Data.ProtoLens (defMessage, encodeMessage, decodeMessage)
 import Data.ProtoLens.Field (field)
 import Data.Text (Text)
-import Lens.Micro ((.~))
+import Lens.Micro ((.~), (^?), (^.))
 import Network.WebSockets (Connection, sendBinaryData, receiveData)
 import Proto.CMS.Cmsapi1 (ServerMessage, ClientMessage, ProtocolVersion (..))
-import Proto.CMS.Common1 (Logon)
+import Proto.CMS.Common1 (Logon, OperationStatus (SUCCESS))
+
+
+data CMSError = UnexpectedResponseType | OperationStatusFailure | ResponseNotDecodable String
+    deriving Show
+
+
+fromProtoEnum :: (Enum m, Num n) => m -> n
+fromProtoEnum protoEnumVal = fromIntegral $ fromEnum protoEnumVal
+
 
 logon ::
     -- | CQG Username
@@ -21,12 +29,22 @@ logon ::
     -- | CQG Client App ID
     Text ->
     Connection ->
-    IO ()
+    IO (Either CMSError ())
 logon cqgUsername cqgPassword cqgClientAppId conn = do
     print logonMsg
     sendBinaryData conn rawClientMsg
     rawResp <- receiveData conn
-    print (decodeMessage rawResp :: Either String ServerMessage)
+    let eitherServerMsg = decodeMessage rawResp :: Either String ServerMessage
+    print eitherServerMsg
+    case eitherServerMsg of
+        Left err -> pure . Left $ ResponseNotDecodable err
+        Right serverMsg ->
+            case serverMsg ^? field @"maybe'logonResult" . traverse of
+                Nothing -> pure $ Left UnexpectedResponseType
+                Just logonRes ->
+                    if (logonRes ^. field @"operationStatus") /= fromProtoEnum SUCCESS
+                        then pure $ Left OperationStatusFailure
+                        else pure $ Right ()
     where
       clientMsg = defMessage @ClientMessage & field @"logon" .~ logonMsg
 
@@ -37,8 +55,8 @@ logon cqgUsername cqgPassword cqgClientAppId conn = do
               field @"userName" .~ cqgUsername &
               field @"password" .~ cqgPassword &
               field @"clientAppId" .~ cqgClientAppId &
-              field @"protocolVersionMajor" .~ fromIntegral (fromEnum PROTOCOL_VERSION_MAJOR) &
-              field @"protocolVersionMinor" .~ fromIntegral (fromEnum PROTOCOL_VERSION_MINOR)
+              field @"protocolVersionMajor" .~ fromProtoEnum PROTOCOL_VERSION_MAJOR &
+              field @"protocolVersionMinor" .~ fromProtoEnum PROTOCOL_VERSION_MINOR
 
       -- handleRawResp :: Message -> IO ()
       -- handleRawResp = \case