From b703c77a627f9b025255afd03bbfa2a48088eb2d Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Fri, 27 Jan 2017 15:52:14 +0700
Subject: [PATCH] Load certificates

---
 app/Main.hs          | 57 +++++++++++++++++++++++++++++++++++---------
 quik-connector.cabal |  3 +++
 2 files changed, 49 insertions(+), 11 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 5651b36..d1dfcf2 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -7,6 +7,7 @@ import QuoteSource.DataImport
 import Control.Concurrent hiding (readChan, writeChan)
 import Control.Monad
 import Control.Exception
+import Control.Error.Util
 import Control.Monad.IO.Class
 import Data.IORef
 import Graphics.UI.Gtk hiding (Action, backspace)
@@ -21,6 +22,7 @@ import ATrade.Broker.Protocol
 import Broker.PaperBroker
 import Broker.QuikBroker
 
+import System.Directory
 import System.Log.Logger
 import System.Log.Handler.Simple
 import System.Log.Handler (setFormatter)
@@ -34,6 +36,7 @@ import qualified Data.ByteString.Lazy as BL
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Vector as V
 import qualified Data.Text as T
+import Data.Maybe
 
 import Control.Monad.Trans.Except
 import Broker.QuikBroker.Trans2QuikApi
@@ -54,6 +57,8 @@ data Config = Config {
   brokerserverEndpoint :: String,
   whitelist :: [T.Text],
   blacklist :: [T.Text],
+  brokerServerCertPath :: Maybe FilePath,
+  brokerClientCertificateDir :: Maybe FilePath,
   tables :: [TableConfig],
   quikPath :: String,
   dllPath :: String,
@@ -76,6 +81,8 @@ parseConfig = withObject "object" $ \obj -> do
   bse <- obj .: "brokerserver-endpoint"
   whitelist' <- obj .:? "whitelist" .!= []
   blacklist' <- obj .:? "blacklist" .!= []
+  serverCert <- obj .:? "broker_server_certificate"
+  clientCerts <- obj .:? "broker_client_certificates"
   rt <- case HM.lookup "tables" obj of
     Just v -> parseTables v
     Nothing -> fail "Expected tables array"
@@ -89,6 +96,8 @@ parseConfig = withObject "object" $ \obj -> do
     brokerserverEndpoint = bse,
     whitelist = whitelist',
     blacklist = blacklist',
+    brokerServerCertPath = serverCert,
+    brokerClientCertificateDir = clientCerts,
     tables = rt,
     quikPath = qp,
     dllPath = dp,
@@ -156,17 +165,43 @@ main = do
     Left errmsg -> warningM "main" $ "Can't load quik broker: " ++ T.unpack errmsg
     Right brokerQ ->
       withContext (\ctx ->
-        bracket (startQuoteSourceServer c2 ctx (T.pack $ quotesourceEndpoint config)) stopQuoteSourceServer (\qsServer -> do
-          bracket (startBrokerServer [broker, brokerQ] ctx (T.pack $ brokerserverEndpoint config) (tradeSink config)) stopBrokerServer (\broServer -> do
-            void initGUI
-            window <- windowNew
-            window `on` deleteEvent $ do
-              liftIO mainQuit
-              return False
-            widgetShowAll window
-            mainGUI)
-          infoM "main" "BRS down")
-        )
+        withZapHandler ctx (\zap -> do
+          zapSetWhitelist zap $ whitelist config
+          zapSetBlacklist zap $ blacklist config
+
+          case brokerClientCertificateDir config of
+            Just path -> do
+              certs <- loadCertificatesFromDirectory path
+              forM_ certs (\cert -> zapAddClientCertificate zap cert)
+            Nothing -> return ()
+
+          serverCert <- case brokerServerCertPath config of
+            Just certFile -> do
+              eitherCert <- loadCertificateFromFile certFile
+              case eitherCert of
+                Left err -> do
+                  warningM "main" $ "Unable to load server certificate: " ++ err
+                  return Nothing
+                Right cert -> return $ Just cert
+            Nothing -> return Nothing
+          let serverParams = defaultServerSecurityParams { sspDomain = Just "global",
+            sspCertificate = serverCert }
+
+          bracket (startQuoteSourceServer c2 ctx (T.pack $ quotesourceEndpoint config)) stopQuoteSourceServer (\qsServer -> do
+            bracket (startBrokerServer [broker, brokerQ] ctx (T.pack $ brokerserverEndpoint config) (tradeSink config) serverParams) stopBrokerServer (\broServer -> do
+              void initGUI
+              window <- windowNew
+              window `on` deleteEvent $ do
+                liftIO mainQuit
+                return False
+              widgetShowAll window
+              mainGUI)
+            infoM "main" "BRS down")
+        ))
   killThread forkId
   infoM "main" "Main thread done"
 
+loadCertificatesFromDirectory path = do
+  files <- listDirectory path
+  catMaybes <$> forM files (\file -> hush <$> loadCertificateFromFile file)
+
diff --git a/quik-connector.cabal b/quik-connector.cabal
index 9f5f015..c251b97 100644
--- a/quik-connector.cabal
+++ b/quik-connector.cabal
@@ -82,6 +82,7 @@ executable quik-connector-exe
                      , vector
                      , text
                      , zeromq4-haskell
+                     , zeromq4-haskell-zap
                      , libatrade
                      , transformers
                      , stm
@@ -89,6 +90,8 @@ executable quik-connector-exe
                      , http-client-tls
                      , utf8-string
                      , connection
+                     , directory
+                     , errors
   default-language:    Haskell2010
   extra-libraries:     "user32"