Add CQG CMS API client library

cqg-cms-api-client/CHANGELOG.md

@@ -0,0 +1,11 @@
+# Changelog for `cqg-cms-api-client`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD

cqg-cms-api-client/LICENSE

@@ -0,0 +1 @@
+

cqg-cms-api-client/README.md

@@ -0,0 +1 @@
+# cqg-cms-api-client

cqg-cms-api-client/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

cqg-cms-api-client/app/cqg-cms-example/Main.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Main (main) where
+
+import Data.Maybe (fromMaybe)
+import Data.String (IsString, fromString)
+import Data.Text (Text)
+import Lib (Balance (..), logon, getBalancesForAccount, updateBalance)
+import Network.WebSockets (Connection)
+import System.Environment (getEnv, lookupEnv)
+import Text.Read (readMaybe)
+import Wuss (runSecureClient)
+
+
+-- | Get a 'String' environment variable.
+getEnvDef ::
+    -- | Environment variable to lookup
+    String ->
+    -- | Default value to use if the environment variable is not set.
+    String ->
+    IO String
+getEnvDef envVar defVal = fromMaybe defVal <$> lookupEnv envVar
+
+
+-- | Similar to 'getEnvDef', but read in a value with 'read'.
+--
+-- Throws an exception if the environment variable is set, but the value can't be 'read'.
+readEnvDef ::
+    Read a =>
+    -- | Environment variable to lookup
+    String ->
+    -- | Default value to use if the environment variable is not set.
+    a ->
+    IO a
+readEnvDef envVar defVal = do
+    maybeRes <- lookupEnv envVar
+    case maybeRes of
+        Nothing -> pure defVal
+        Just strRes -> do
+            case readMaybe strRes of
+                Nothing ->
+                    error $ "Can't read environment variable " <> envVar <> " value: " <> strRes
+                Just res -> pure res
+
+
+getEnvStr :: IsString s => String -> IO s
+getEnvStr envVar = fromString <$> getEnv envVar
+
+
+main :: IO ()
+main = do
+    cqgHostname <- getEnvDef "CQG_WEBSOCKETS_HOSTNAME" "democmsapi.cqg.com"
+    cqgPort <- readEnvDef "CQG_WEBSOCKETS_PORT" 443
+    cqgPath <- getEnvDef "CQG_WEBSOCKETS_PATH" "/"
+    cqgUsername <- getEnvStr "CQG_USERNAME"
+    cqgPassword <- getEnvStr "CQG_PASSWORD"
+    cqgClientAppId <- getEnvStr "CQG_CLIENT_APP_ID"
+    runSecureClient cqgHostname cqgPort cqgPath (app cqgUsername cqgPassword cqgClientAppId)
+
+app ::
+    -- | CQG Username
+    Text ->
+    -- | CQG Password
+    Text ->
+    -- | CQG Client App ID
+    Text ->
+    Connection ->
+    IO ()
+app cqgUsername cqgPassword cqgClientAppId conn = do
+    putStrLn "DO logon"
+    eitherLogonRes <- logon cqgUsername cqgPassword cqgClientAppId conn
+    print eitherLogonRes
+    case eitherLogonRes of
+      Left err -> error $ "Error when logging on: " <> show err
+      Right () -> do
+        putStrLn "\nDO get balances"
+        let accountId = 17028979 {- TODO: how to find this value -}
+        eitherBalances <- getBalancesForAccount accountId conn
+        print eitherBalances
+        case eitherBalances of
+            Left err -> error $ "Error when getting balances: " <> show err
+            Right [] -> error "No balances returned! Expecting exactly one balance to be returned!"
+            Right (_ : _ : _) -> error "Multiple balances returned! Expecting exactly one balance to be returned!"
+            Right [Balance{balanceId}] -> do
+                putStrLn "\nDO update balance"
+                let newBalance = 1999
+                eitherUpdateBalance <- updateBalance balanceId newBalance conn
+                print eitherUpdateBalance

cqg-cms-api-client/cqg-cms-api-client.cabal

@@ -0,0 +1,52 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.36.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:           cqg-cms-api-client
+version:        0.1.0.0
+synopsis:       CQG CMS API websocket client
+description:    Please see the README on GitHub at <https://github.com/bitnomial/cqg-api-client/cqg-cms-api-client#readme>
+category:       Web
+author:         Bitnomial
+maintainer:     Bitnomial <[email protected]>
+copyright:      2024 Bitnomial, Inc
+license:        AllRightsReserved
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+library
+  exposed-modules:
+      Lib
+  other-modules:
+      Paths_cqg_cms_api_client
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wno-unused-do-bind -Wunused-packages -funbox-strict-fields -fwrite-ide-info
+  build-depends:
+      base
+    , cqg-cms-api-proto
+    , microlens
+    , proto-lens
+    , text
+    , websockets
+  default-language: Haskell2010
+
+executable cqg-cms-example
+  main-is: Main.hs
+  other-modules:
+      Paths_cqg_cms_api_client
+  hs-source-dirs:
+      app/cqg-cms-example
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wno-unused-do-bind -Wunused-packages -funbox-strict-fields -fwrite-ide-info -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      base
+    , cqg-cms-api-client
+    , text
+    , websockets
+    , wuss
+  default-language: Haskell2010

cqg-cms-api-client/package.yaml

@@ -0,0 +1,58 @@
+name: "cqg-cms-api-client"
+version: "0.1.0.0"
+maintainer: "Bitnomial <[email protected]>"
+license: "AllRightsReserved"
+author: "Bitnomial"
+copyright: "2024 Bitnomial, Inc"
+
+extra-source-files:
+  - README.md
+  - CHANGELOG.md
+
+synopsis: "CQG CMS API websocket client"
+category: "Web"
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description: "Please see the README on GitHub at <https://github.com/bitnomial/cqg-api-client/cqg-cms-api-client#readme>"
+
+ghc-options:
+  - "-Wall"
+  - "-Wcompat"
+  - "-Widentities"
+  - "-Wincomplete-record-updates"
+  - "-Wincomplete-uni-patterns"
+  - "-Wmissing-export-lists"
+  - "-Wmissing-home-modules"
+  - "-Wpartial-fields"
+  - "-Wredundant-constraints"
+  - "-Wno-unused-do-bind"
+  - "-Wunused-packages"
+  - "-funbox-strict-fields"
+  - "-fwrite-ide-info"
+
+library:
+  source-dirs: src
+  dependencies:
+    - base
+    - cqg-cms-api-proto
+    - microlens
+    - proto-lens
+    - text
+    - websockets
+
+executables:
+  cqg-cms-example:
+    main: "Main.hs"
+    source-dirs: "app/cqg-cms-example"
+    ghc-options:
+      - "-threaded"
+      - "-rtsopts"
+      - "-with-rtsopts=-N"
+    dependencies:
+      - base
+      - cqg-cms-api-client
+      - text
+      - websockets
+      - wuss

cqg-cms-api-client/src/Lib.hs

@@ -0,0 +1,170 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Lib (logon, getBalancesForAccount, updateBalance, Balance(..)) where
+
+import Data.Function ((&))
+import Data.ProtoLens (defMessage, encodeMessage, decodeMessage)
+import Data.ProtoLens.Field (field)
+import Data.Text (Text)
+import Lens.Micro ((.~), (^?), (^.))
+import Network.WebSockets (Connection, sendBinaryData, receiveData)
+import Proto.CMS.Cmsapi1 (ServerMessage, ClientMessage, ProtocolVersion (..))
+import Proto.CMS.Common1 (Logon, OperationStatus (SUCCESS))
+import Proto.CMS.Traderouting1 (TradeRoutingRequest, AccountScopeRequest, BalanceRecordsRequest, BalanceRecord, UpdateBalanceRecord)
+
+
+data CMSError = UnexpectedResponseType | UnexpectedNumOfResponses | OperationStatusFailure | ResponseNotDecodable String | UnexpectedResponseId
+    deriving Show
+
+
+fromProtoEnum :: (Enum m, Num n) => m -> n
+fromProtoEnum protoEnumVal = fromIntegral $ fromEnum protoEnumVal
+
+
+logon ::
+    -- | CQG Username
+    Text ->
+    -- | CQG Password
+    Text ->
+    -- | CQG Client App ID
+    Text ->
+    Connection ->
+    IO (Either CMSError ())
+logon cqgUsername cqgPassword cqgClientAppId conn = do
+    -- print logonMsg
+    sendBinaryData conn rawClientMsg
+    rawResp <- receiveData conn
+    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
+
+    rawClientMsg = encodeMessage clientMsg
+
+    logonMsg =
+        defMessage @Logon &
+            field @"userName" .~ cqgUsername &
+            field @"password" .~ cqgPassword &
+            field @"clientAppId" .~ cqgClientAppId &
+            field @"protocolVersionMajor" .~ fromProtoEnum PROTOCOL_VERSION_MAJOR &
+            field @"protocolVersionMinor" .~ fromProtoEnum PROTOCOL_VERSION_MINOR
+
+
+data Balance = Balance
+    { balanceId :: Int
+    , balanceCurrency :: Text
+    , balanceEndCashBalance :: Double
+    }
+    deriving Show
+
+getBalancesForAccount ::
+    -- | CQG Account ID
+    Int ->
+    Connection ->
+    IO (Either CMSError [Balance])
+getBalancesForAccount cqgAccountId conn = do
+    print clientMsg
+    sendBinaryData conn rawClientMsg
+    rawResp <- receiveData conn
+    let eitherServerMsg = decodeMessage rawResp :: Either String ServerMessage
+    print eitherServerMsg
+    case eitherServerMsg of
+        Left err -> pure . Left $ ResponseNotDecodable err
+        Right serverMsg ->
+            case serverMsg ^. field @"tradeRoutingResult" of
+                [] -> pure $ Left UnexpectedNumOfResponses
+                _ : _ : _ -> pure $ Left UnexpectedNumOfResponses
+                [tradingRouteRes] -> do
+                    if (tradingRouteRes ^. field @"operationStatus") /= fromProtoEnum SUCCESS
+                        then pure $ Left OperationStatusFailure
+                        else
+                            if (tradingRouteRes ^. field @"requestId") /= requestId
+                                then pure $ Left UnexpectedResponseId
+                                else do
+                                    let balanceRecords = tradingRouteRes ^. field @"accountScopeResult" . field @"balanceRecordsResult" . field @"balanceRecord"
+                                    pure . Right $ fmap toBalance balanceRecords
+  where
+    requestId = 1234 -- TODO: don't hardcode this
+
+    clientMsg = defMessage @ClientMessage & field @"tradeRoutingRequest" .~ [tradeRoutingRequestMsg]
+
+    rawClientMsg = encodeMessage clientMsg
+
+    tradeRoutingRequestMsg =
+        defMessage @TradeRoutingRequest &
+            field @"id" .~ requestId &
+            field @"accountScopeRequest" .~ accountScopeRequestMsg
+
+    accountScopeRequestMsg =
+        defMessage @AccountScopeRequest &
+            field @"balanceRecordsRequest" .~ balanceRecordsRequestMsg
+
+    balanceRecordsRequestMsg =
+        defMessage @BalanceRecordsRequest &
+            field @"accountId" .~ fromIntegral cqgAccountId
+
+    toBalance :: BalanceRecord -> Balance
+    toBalance br =
+        Balance
+            { balanceId = fromIntegral $ br ^. field @"balanceRecordId"
+            , balanceCurrency = br ^. field @"currency"
+            , balanceEndCashBalance = br ^. field @"endCashBalance"
+            }
+
+
+updateBalance ::
+    -- | CQG Balance ID
+    Int ->
+    -- | new balance amount
+    Double ->
+    Connection ->
+    IO (Either CMSError ())
+updateBalance cqgBalanceId newEndCashBalance conn = do
+    print clientMsg
+    sendBinaryData conn rawClientMsg
+    rawResp <- receiveData conn
+    let eitherServerMsg = decodeMessage rawResp :: Either String ServerMessage
+    print eitherServerMsg
+    case eitherServerMsg of
+        Left err -> pure . Left $ ResponseNotDecodable err
+        Right serverMsg ->
+            case serverMsg ^. field @"tradeRoutingResult" of
+                [] -> pure $ Left UnexpectedNumOfResponses
+                _ : _ : _ -> pure $ Left UnexpectedNumOfResponses
+                [tradingRouteRes] -> do
+                    if (tradingRouteRes ^. field @"operationStatus") /= fromProtoEnum SUCCESS
+                        then pure $ Left OperationStatusFailure
+                        else
+                            if (tradingRouteRes ^. field @"requestId") /= requestId
+                                then pure $ Left UnexpectedResponseId
+                                else pure $ Right ()
+  where
+    requestId = 1235 -- TODO: don't hardcode this
+
+    clientMsg = defMessage @ClientMessage & field @"tradeRoutingRequest" .~ [tradeRoutingRequestMsg]
+
+    rawClientMsg = encodeMessage clientMsg
+
+    tradeRoutingRequestMsg =
+        defMessage @TradeRoutingRequest &
+            field @"id" .~ requestId &
+            field @"accountScopeRequest" .~ accountScopeRequestMsg
+
+    accountScopeRequestMsg =
+        defMessage @AccountScopeRequest &
+            field @"updateBalanceRecord" .~ updateBalanceRecordMsg
+
+    updateBalanceRecordMsg =
+        defMessage @UpdateBalanceRecord &
+            field @"balanceId" .~ fromIntegral cqgBalanceId &
+            field @"endCashBalance" .~ newEndCashBalance