From c055c2fbc22bccac3619a3e2c10a5388f4b4c862 Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Sun, 14 Nov 2021 15:15:33 +0700
Subject: [PATCH] Cert support

---
 server-cert.json     |  1 +
 server-cert.pub.json |  1 +
 src/Main.hs          | 22 ++++++++++++++++++----
 3 files changed, 20 insertions(+), 4 deletions(-)
 create mode 100644 server-cert.json
 create mode 100644 server-cert.pub.json

diff --git a/server-cert.json b/server-cert.json
new file mode 100644
index 0000000..06a864b
--- /dev/null
+++ b/server-cert.json
@@ -0,0 +1 @@
+{"public_key":"RTGLeEetHkt9wqFRngJAPMK8ao2IY5+hXew1VWyqXlM=","secret_key":"XxwOXSkM9uUBw/+PhjgXlsrlbD+SjKNQ3GpGFQrZo+I="}
\ No newline at end of file
diff --git a/server-cert.pub.json b/server-cert.pub.json
new file mode 100644
index 0000000..a374958
--- /dev/null
+++ b/server-cert.pub.json
@@ -0,0 +1 @@
+{"public_key":"RTGLeEetHkt9wqFRngJAPMK8ao2IY5+hXew1VWyqXlM="}
\ No newline at end of file
diff --git a/src/Main.hs b/src/Main.hs
index 074deec..3030457 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -64,8 +64,22 @@ main :: IO ()
 main = do
   initLogging "test"
   backend <- makeTestBackend
-  withContext (\ctx -> do
-    bro <- startBrokerServer [backend] ctx "tcp://*:5530" "tcp://*:5531" [] defaultServerSecurityParams
+  withContext (\ctx ->
+    withZapHandler ctx $ \zap -> do
+      maybeServerCert <- loadCertificateFromFile "./server-cert.json"
+      case maybeServerCert of
+        Left err -> error $ "Unable to load server certificate: " ++ err
+        Right serverCert -> do
+          let secParams = ServerSecurityParams (Just "default") (Just serverCert)
+          addCertFromFile zap "../broker-client-test/client-cert.pub.json"
+          bro <- startBrokerServer [backend] ctx "tcp://*:5530" "tcp://*:5531" [] secParams
 
-    void $ forever $ threadDelay 10000000
-    stopBrokerServer bro)
+          void $ forever $ threadDelay 10000000
+          stopBrokerServer bro)
+
+addCertFromFile :: Zap -> FilePath  -> IO ()
+addCertFromFile zap fp = do
+  maybeCert <- loadCertificateFromFile fp
+  case maybeCert of
+    Left _     -> return ()
+    Right cert -> zapAddClientCertificate zap "default" cert