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