diff --git a/cqg-cms-api-client/CHANGELOG.md b/cqg-cms-api-client/CHANGELOG.md new file mode 100644 index 0000000..0f69729 --- /dev/null +++ b/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 diff --git a/cqg-cms-api-client/LICENSE b/cqg-cms-api-client/LICENSE new file mode 100644 index 0000000..8b13789 --- /dev/null +++ b/cqg-cms-api-client/LICENSE @@ -0,0 +1 @@ + diff --git a/cqg-cms-api-client/README.md b/cqg-cms-api-client/README.md new file mode 100644 index 0000000..20b78e8 --- /dev/null +++ b/cqg-cms-api-client/README.md @@ -0,0 +1 @@ +# cqg-cms-api-client diff --git a/cqg-cms-api-client/Setup.hs b/cqg-cms-api-client/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/cqg-cms-api-client/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cqg-cms-api-client/app/cqg-cms-example/Main.hs b/cqg-cms-api-client/app/cqg-cms-example/Main.hs new file mode 100644 index 0000000..76638d1 --- /dev/null +++ b/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 diff --git a/cqg-cms-api-client/cqg-cms-api-client.cabal b/cqg-cms-api-client/cqg-cms-api-client.cabal new file mode 100644 index 0000000..70b5b74 --- /dev/null +++ b/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 +category: Web +author: Bitnomial +maintainer: Bitnomial +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 diff --git a/cqg-cms-api-client/package.yaml b/cqg-cms-api-client/package.yaml new file mode 100644 index 0000000..ffcf728 --- /dev/null +++ b/cqg-cms-api-client/package.yaml @@ -0,0 +1,58 @@ +name: "cqg-cms-api-client" +version: "0.1.0.0" +maintainer: "Bitnomial " +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 " + +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 diff --git a/cqg-cms-api-client/src/Lib.hs b/cqg-cms-api-client/src/Lib.hs new file mode 100644 index 0000000..6052ba4 --- /dev/null +++ b/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 diff --git a/fourmolu.yaml b/fourmolu.yaml new file mode 100644 index 0000000..f43fae7 --- /dev/null +++ b/fourmolu.yaml @@ -0,0 +1,24 @@ +indentation: 4 +comma-style: leading # for lists, tuples etc. - can also be 'trailing' +record-brace-space: false # rec {x = 1} vs. rec{x = 1} +indent-wheres: false # 'false' means save space by only half-indenting the 'where' keyword +import-export-style: diff-friendly # choices: leading, trailing, diff-friendly +respectful: true # don't be too opinionated about newlines etc. +haddock-style: single-line # '--' vs. '{-' +newlines-between-decls: 2 +single-constraint-parens: never # defaults to 'always', could also be 'auto' (ignore), and 'never' +single-deriving-parens: never # choices: auto, always, never +column-limit: 120 # limit columns to 120 characters, as per our style guide +let-style: inline # choices: auto, inline, newline, mixed +fixities: + - infixr 0 $, $! + - infixl 1 >>, >>=, & + - infixr 1 =<< + - infixl 3 , @?= + - infixl 4 <*>, <*, *>, <**>, <$ + - infixr 4 ?~ + - infixr 5 ++ + - infixr 5 :| + - infixr 6 <> + - infixl 8 .:, .:?, .=, .=? + - infixr 9 . diff --git a/hie.yaml b/hie.yaml new file mode 100644 index 0000000..d6e4632 --- /dev/null +++ b/hie.yaml @@ -0,0 +1,11 @@ +--- +cradle: + stack: + - component: "cqg-cms-api-client:exe:cqg-cms-example" + path: "./cqg-cms-api-client/app/cqg-cms-example" + + - component: "cqg-cms-api-client:lib" + path: "./cqg-cms-api-client/src" + + - component: "cqg-cms-api-proto:lib" + path: "./cqg-cms-api-proto/src" diff --git a/stack.yaml b/stack.yaml index 0119dfa..447f4e4 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,6 +15,7 @@ ghc-options: "$everything": -haddock packages: + - cqg-cms-api-client - cqg-cms-api-proto extra-deps: []