From aa81880c654c31c0f046881c56b831780980e26d Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Tue, 12 Jul 2022 16:08:27 -0500
Subject: [PATCH] Implement Config type and refactor

---
 app/Main.hs       | 50 +++++++++++++++++-------------------------
 package.yaml      |  1 +
 src/Config.hs     | 55 +++++++++++++++++++++++++++++++++++++++++++++++
 src/ZGoBackend.hs | 41 ++++++++++++++++++-----------------
 zgo-backend.cabal |  2 ++
 5 files changed, 99 insertions(+), 50 deletions(-)
 create mode 100644 src/Config.hs

diff --git a/app/Main.hs b/app/Main.hs
index 84fd1f6..fd54e45 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -2,9 +2,8 @@
 
 module Main where
 
+import Config
 import Control.Concurrent (forkIO)
-import Data.Configurator
-import Data.SecureMem
 import Database.MongoDB
 import Network.Wai.Handler.Warp (defaultSettings, setPort)
 import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
@@ -14,40 +13,31 @@ import ZGoBackend
 main :: IO ()
 main = do
   putStrLn "Reading config..."
-  config <- load ["zgo.cfg"]
-  dbHost <- require config "dbHost"
-  dbName <- require config "dbName"
-  dbUser <- require config "dbUser"
-  dbPassword <- require config "dbPassword"
-  nodeAddress <- require config "nodeAddress"
-  nodeUser <- require config "nodeUser"
-  nodePwd <- require config "nodePassword"
-  passkey <- secureMemFromByteString <$> require config "passkey"
-  port <- require config "port"
-  useTls <- require config "tls"
-  cert <- require config "certificate"
-  key <- require config "key"
+  loadedConfig <- loadZGoConfig "zgo.cfg"
   let myTlsSettings =
-        if useTls
-          then Just $ tlsSettings cert key
+        if c_useTls loadedConfig
+          then Just $
+               tlsSettings (c_certificate loadedConfig) (c_key loadedConfig)
           else Nothing
   putStrLn "Starting Server..."
-  pipe <- connect $ host dbHost
-  j <- access pipe master dbName (auth dbUser dbPassword)
+  pipe <- connect $ host (c_dbHost loadedConfig)
+  j <-
+    access
+      pipe
+      master
+      (c_dbName loadedConfig)
+      (auth (c_dbUser loadedConfig) (c_dbPassword loadedConfig))
   if j
     then putStrLn "Connected to MongoDB!"
     else fail "MongoDB connection failed!"
-  _ <- forkIO (setInterval 60 (checkZcashPrices pipe dbName))
-  _ <-
-    forkIO (setInterval 75 (scanZcash nodeAddress pipe dbName nodeUser nodePwd))
-  _ <- forkIO (setInterval 60 (checkPayments pipe dbName))
-  _ <- forkIO (setInterval 60 (expireOwners pipe dbName))
-  _ <-
-    forkIO
-      (setInterval 60 (updateLogins nodeUser nodePwd nodeAddress pipe dbName))
-  let appRoutes = routes pipe dbName passkey nodeAddress nodeUser nodePwd
+  _ <- forkIO (setInterval 60 (checkZcashPrices pipe (c_dbName loadedConfig)))
+  _ <- forkIO (setInterval 75 (scanZcash loadedConfig pipe))
+  _ <- forkIO (setInterval 60 (checkPayments pipe (c_dbName loadedConfig)))
+  _ <- forkIO (setInterval 60 (expireOwners pipe (c_dbName loadedConfig)))
+  _ <- forkIO (setInterval 60 (updateLogins pipe loadedConfig))
+  let appRoutes = routes pipe loadedConfig
   case myTlsSettings of
-    Nothing -> scotty port appRoutes
+    Nothing -> scotty (c_port loadedConfig) appRoutes
     Just tls -> do
       apiCore <- scottyApp appRoutes
-      runTLS tls (setPort port defaultSettings) apiCore
+      runTLS tls (setPort (c_port loadedConfig) defaultSettings) apiCore
diff --git a/package.yaml b/package.yaml
index 50c79f8..656aacd 100644
--- a/package.yaml
+++ b/package.yaml
@@ -49,6 +49,7 @@ library:
   - wai-cors
   - warp-tls
   - hexstring
+  - configurator
 
 executables:
   zgo-backend-exe:
diff --git a/src/Config.hs b/src/Config.hs
new file mode 100644
index 0000000..1abfcef
--- /dev/null
+++ b/src/Config.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Config where
+
+import qualified Data.ByteString as BS
+import Data.Configurator
+import Data.SecureMem
+import qualified Data.Text as T
+
+data Config =
+  Config
+    { c_dbHost :: String
+    , c_dbName :: T.Text
+    , c_dbUser :: T.Text
+    , c_dbPassword :: T.Text
+    , c_passkey :: SecureMem
+    , c_nodeAddress :: T.Text
+    , c_nodeUser :: BS.ByteString
+    , c_nodePwd :: BS.ByteString
+    , c_port :: Int
+    , c_useTls :: Bool
+    , c_certificate :: String
+    , c_key :: String
+    }
+  deriving (Eq, Show)
+
+loadZGoConfig :: Worth FilePath -> IO Config
+loadZGoConfig path = do
+  config <- load [path]
+  dbHost <- require config "dbHost"
+  dbName <- require config "dbName"
+  dbUser <- require config "dbUser"
+  dbPassword <- require config "dbPassword"
+  nodeAddress <- require config "nodeAddress"
+  nodeUser <- require config "nodeUser"
+  nodePwd <- require config "nodePassword"
+  passkey <- secureMemFromByteString <$> require config "passkey"
+  port <- require config "port"
+  useTls <- require config "tls"
+  cert <- require config "certificate"
+  key <- require config "key"
+  return $
+    Config
+      dbHost
+      dbName
+      dbUser
+      dbPassword
+      passkey
+      nodeAddress
+      nodeUser
+      nodePwd
+      port
+      useTls
+      cert
+      key
diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs
index 77fec2e..13dbb3f 100644
--- a/src/ZGoBackend.hs
+++ b/src/ZGoBackend.hs
@@ -5,6 +5,7 @@
 
 module ZGoBackend where
 
+import Config
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Monad
 import Control.Monad.IO.Class
@@ -319,16 +320,13 @@ upsertZGoTx coll t = do
   upsert (select ["txid" =: txid t] coll) (encodeZGoTxBson t)
 
 -- | Main API routes
-routes ::
-     Pipe
-  -> T.Text
-  -> SecureMem
-  -> T.Text
-  -> BS.ByteString
-  -> BS.ByteString
-  -> ScottyM ()
-routes pipe db passkey nodeAddress nodeUser nodePwd = do
-  let run = access pipe master db
+routes :: Pipe -> Config -> ScottyM ()
+routes pipe config = do
+  let run = access pipe master (c_dbName config)
+  let passkey = c_passkey config
+  let nodeUser = c_nodeUser config
+  let nodePwd = c_nodePwd config
+  let nodeAddress = c_nodeAddress config
   middleware $
     cors $
     const $
@@ -568,14 +566,14 @@ checkZcashPrices p db = do
   mapM_ (access p master db) (updatePrices (getResponseBody q))
 
 -- | Function to check the ZGo full node for new txs
-scanZcash :: T.Text -> Pipe -> T.Text -> BS.ByteString -> BS.ByteString -> IO ()
-scanZcash addr pipe db nodeUser nodePwd = do
+scanZcash :: Config -> Pipe -> IO ()
+scanZcash config pipe = do
   res <-
     makeZcashCall
-      nodeUser
-      nodePwd
+      (c_nodeUser config)
+      (c_nodePwd config)
       "z_listreceivedbyaddress"
-      [Data.Aeson.String addr]
+      [Data.Aeson.String (c_nodeAddress config)]
   let txs =
         filter (not . zchange) $
         result (getResponseBody res :: RpcResponse [ZcashTx])
@@ -586,14 +584,17 @@ scanZcash addr pipe db nodeUser nodePwd = do
         mkRegex
           ".*ZGOp::([0-9a-fA-F]{8}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{4}\\b-[0-9a-fA-F]{12}).*"
   let k = map zToZGoTx (filter (matchTest r . T.unpack . zmemo) txs)
-  mapM_ (access pipe master db . upsertZGoTx "txs") k
+  mapM_ (access pipe master (c_dbName config) . upsertZGoTx "txs") k
   let j = map zToZGoTx (filter (matchTest p . T.unpack . zmemo) txs)
-  mapM_ (access pipe master db . upsertPayment) j
+  mapM_ (access pipe master (c_dbName config) . upsertPayment) j
 
 -- | Function to generate users from login txs
-updateLogins ::
-     BS.ByteString -> BS.ByteString -> T.Text -> Pipe -> T.Text -> IO ()
-updateLogins nodeUser nodePwd addr pipe db = do
+updateLogins :: Pipe -> Config -> IO ()
+updateLogins pipe config = do
+  let db = c_dbName config
+  let nodeUser = c_nodeUser config
+  let nodePwd = c_nodePwd config
+  let addr = c_nodeAddress config
   results <-
     access
       pipe
diff --git a/zgo-backend.cabal b/zgo-backend.cabal
index f7ee298..1d00706 100644
--- a/zgo-backend.cabal
+++ b/zgo-backend.cabal
@@ -26,6 +26,7 @@ source-repository head
 
 library
   exposed-modules:
+      Config
       Item
       Order
       Owner
@@ -44,6 +45,7 @@ library
     , base >=4.7 && <5
     , bson
     , bytestring
+    , configurator
     , hexstring
     , http-conduit
     , http-types