From 6328a4f63cce4c2e70033d3e150d757e136b1faa Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Sun, 26 Sep 2021 12:04:42 +0700 Subject: [PATCH] Initial commit --- LICENSE | 0 README.md | 0 broker-server-test.cabal | 27 +++++++++++++++ src/Main.hs | 71 ++++++++++++++++++++++++++++++++++++++++ stack.yaml | 68 ++++++++++++++++++++++++++++++++++++++ 5 files changed, 166 insertions(+) create mode 100644 LICENSE create mode 100644 README.md create mode 100644 broker-server-test.cabal create mode 100644 src/Main.hs create mode 100644 stack.yaml diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..e69de29 diff --git a/README.md b/README.md new file mode 100644 index 0000000..e69de29 diff --git a/broker-server-test.cabal b/broker-server-test.cabal new file mode 100644 index 0000000..70cffbe --- /dev/null +++ b/broker-server-test.cabal @@ -0,0 +1,27 @@ +name: broker-server-test +version: 0.1.0.0 +-- synopsis: +-- description: +homepage: https://github.com/githubuser/broker-server-test#readme +license: BSD3 +license-file: LICENSE +author: Author name here +maintainer: example@example.com +copyright: 2017 Author name here +category: Web +build-type: Simple +cabal-version: >=1.10 +extra-source-files: README.md + +executable broker-server-test + hs-source-dirs: src + main-is: Main.hs + default-language: Haskell2010 + ghc-options: -threaded -Wall + build-depends: base >= 4.7 && < 5 + , libatrade + , time + , hslogger + , zeromq4-haskell-zap + , zeromq4-haskell + , containers diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..074deec --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import ATrade.Broker.Server +import ATrade.Types + +import Control.Concurrent +import Data.IORef +import qualified Data.Map.Strict as M + +import ATrade.Broker.Backend (BrokerBackendNotification (BackendOrderNotification)) +import Control.Monad (forever, void) +import System.IO +import System.Log.Formatter +import System.Log.Handler (setFormatter) +import System.Log.Handler.Simple +import System.Log.Logger +import System.ZMQ4 +import System.ZMQ4.ZAP + +makeTestBackend :: IO BrokerBackend +makeTestBackend = do + notificationCallback <- newIORef Nothing + orders <- newIORef M.empty + return BrokerBackend + { + accounts = ["test"], + setNotificationCallback = writeIORef notificationCallback, + submitOrder = tbSubmitOrder orders notificationCallback, + cancelOrder = tbCancelOrder orders notificationCallback, + stop = return () + } + where + tbSubmitOrder orders notificationCallback order = do + infoM "Order" $ "Submit order: " <> show order + atomicModifyIORef' orders (\s -> (M.insert (orderId order) order s, ())) + maybeCb <- readIORef notificationCallback + case maybeCb of + Just cb -> cb (BackendOrderNotification (orderId order) Submitted) + _ -> return () + + tbCancelOrder orders notificationCallback oid = do + infoM "Order" $ "Cancel order: " <> show oid + atomicModifyIORef' orders (\s -> (setOrderState oid Cancelled s, ())) + maybeCb <- readIORef notificationCallback + case maybeCb of + Just cb -> cb (BackendOrderNotification oid Cancelled) + _ -> return () + setOrderState oid newState = M.adjust (\order -> order { orderState = newState }) oid + +initLogging :: [Char] -> IO () +initLogging inst = do + handler <- streamHandler stderr DEBUG >>= + (\x -> return $ + setFormatter x (simpleLogFormatter $ + "$utcTime\t[" ++ inst ++ "]\t\t{$loggername}\t\t<$prio> -> $msg")) + + hSetBuffering stderr LineBuffering + updateGlobalLogger rootLoggerName (setLevel DEBUG) + updateGlobalLogger rootLoggerName (setHandlers [handler]) + +main :: IO () +main = do + initLogging "test" + backend <- makeTestBackend + withContext (\ctx -> do + bro <- startBrokerServer [backend] ctx "tcp://*:5530" "tcp://*:5531" [] defaultServerSecurityParams + + void $ forever $ threadDelay 10000000 + stopBrokerServer bro) diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..84e66fe --- /dev/null +++ b/stack.yaml @@ -0,0 +1,68 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-17.14 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +- '../libatrade' +- '../zeromq4-haskell-zap' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: [ 'datetime-0.3.1' ] + +# Override default flag values for local packages and extra-deps +flags: {} + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.3" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor