Implement config file

This commit is contained in:
Rene Vergara 2022-05-19 08:24:52 -05:00
parent 8bb94b824a
commit 0d56026183
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
7 changed files with 68 additions and 52 deletions

View file

@ -2,33 +2,38 @@
module Main where
import Control.Concurrent (forkIO, threadDelay)
import Control.Concurrent (forkIO)
import Data.Configurator
import Data.SecureMem
import qualified Data.Text as T
import Database.MongoDB
import Network.Wai.Handler.WarpTLS (tlsSettings)
import ZGoBackend
passkey :: SecureMem
passkey = secureMemFromByteString "superSecret"
nodeAddress :: T.Text
nodeAddress =
"zs1xnpqd2tae9d95f8fhe4l0q7j44a5vf993m0pcnnvr56uqr4lgqlamesk5v4c5rhtvywc6lvlduy"
dbUser :: T.Text
dbUser = "zgo"
dbPassword :: T.Text
dbPassword = "zcashrules"
main :: IO ()
main = do
putStrLn "Reading config..."
config <- load ["zgo.cfg"]
dbName <- require config "dbName"
dbUser <- require config "dbUser"
dbPassword <- require config "dbPassword"
nodeAddress <- require config "nodeAddress"
passkey <- secureMemFromByteString <$> require config "passkey"
port <- require config "port"
useTls <- require config "tls"
cert <- require config "certificate"
key <- require config "key"
let myTlsSettings =
if useTls
then Just $ tlsSettings cert key
else Nothing
putStrLn "Starting Server..."
pipe <- connect $ host "127.0.0.1"
j <- access pipe master "zgo" (auth dbUser dbPassword)
_ <- forkIO (setInterval 60 (checkZcashPrices pipe "zgo"))
_ <- forkIO (setInterval 75 (scanZcash nodeAddress pipe "zgo"))
j <- access pipe master dbName (auth dbUser dbPassword)
if j
then putStrLn "Connected to MongoDB!"
else fail "MongoDB connection failed!"
app pipe "zgo" passkey nodeAddress
_ <- forkIO (setInterval 60 (checkZcashPrices pipe dbName))
_ <- forkIO (setInterval 75 (scanZcash nodeAddress pipe dbName))
_ <- forkIO (setInterval 60 (checkPayments pipe dbName))
_ <- forkIO (setInterval 60 (expireOwners pipe dbName))
app pipe dbName passkey nodeAddress port myTlsSettings

View file

@ -46,6 +46,7 @@ library:
- random
- vector
- wai-cors
- warp-tls
executables:
zgo-backend-exe:
@ -69,6 +70,8 @@ executables:
- http-conduit
- time
- bytestring
- configurator
- warp-tls
tests:
zgo-backend-test:

View file

@ -90,7 +90,10 @@ upsertItem :: Item -> Action IO ()
upsertItem i = do
let item = val i
case item of
Doc d -> upsert (select ["_id" =: i_id i] "items") d
Doc d ->
if isJust (i_id i)
then upsert (select ["_id" =: i_id i] "items") d
else insert_ "items" d
_ -> return ()
deleteItem :: String -> Action IO ()

View file

@ -130,48 +130,30 @@ instance Val ZGoOrder where
-- Type to represent an order line item
data LineItem =
LineItem
{ l_id :: Maybe ObjectId
, lqty :: Double
{ lqty :: Double
, lname :: T.Text
, lcost :: Double
}
deriving (Eq, Show)
instance ToJSON LineItem where
toJSON (LineItem i q n c) =
case i of
Just oid ->
object ["_id" .= show oid, "qty" .= q, "name" .= n, "cost" .= c]
Nothing ->
object ["_id" .= ("" :: String), "qty" .= q, "name" .= n, "cost" .= c]
toJSON (LineItem q n c) = object ["qty" .= q, "name" .= n, "cost" .= c]
instance FromJSON LineItem where
parseJSON =
withObject "LineItem" $ \obj -> do
i <- obj .: "_id"
q <- obj .: "qty"
n <- obj .: "name"
c <- obj .: "cost"
pure $
LineItem
(if not (null i)
then Just (read i)
else Nothing)
q
n
c
pure $ LineItem q n c
instance Val LineItem where
val (LineItem i q n c) =
case i of
Just oid -> Doc ["_id" =: oid, "qty" =: q, "name" =: n, "cost" =: c]
Nothing -> Doc ["qty" =: q, "name" =: n, "cost" =: c]
val (LineItem q n c) = Doc ["qty" =: q, "name" =: n, "cost" =: c]
cast' (Doc d) = do
i <- B.lookup "_id" d
q <- B.lookup "qty" d
n <- B.lookup "name" d
c <- B.lookup "cost" d
Just (LineItem i q n c)
Just (LineItem q n c)
cast' _ = Nothing
-- Database actions
@ -179,11 +161,14 @@ upsertOrder :: ZGoOrder -> Action IO ()
upsertOrder o = do
let order = val o
case order of
Doc d -> upsert (select ["_id" =: q_id o] "orders") d
Doc d ->
if isJust (q_id o)
then upsert (select ["_id" =: q_id o] "orders") d
else insert_ "orders" d
_ -> return ()
findOrder :: T.Text -> Action IO (Maybe Document)
findOrder s = findOne (select ["session" =: s] "orders")
findOrder s = findOne (select ["session" =: s, "closed" =: False] "orders")
findOrderById :: String -> Action IO (Maybe Document)
findOrderById i = findOne (select ["_id" =: (read i :: B.ObjectId)] "orders")

View file

@ -29,6 +29,7 @@ import GHC.Generics
import Item
import Network.HTTP.Simple
import Network.HTTP.Types.Status
import Network.Wai.Handler.WarpTLS (TLSSettings, runTLS)
import Network.Wai.Middleware.Cors
import Network.Wai.Middleware.HttpAuth
import Numeric
@ -314,8 +315,15 @@ upsertZGoTx coll t = do
upsert (select ["txid" =: txid t] coll) (encodeZGoTxBson t)
-- | Main API function
app :: Pipe -> T.Text -> SecureMem -> T.Text -> IO ()
app pipe db passkey nodeAddress = do
app ::
Pipe
-> T.Text
-> SecureMem
-> T.Text
-> Integer
-> Maybe TLSSettings
-> IO ()
app pipe db passkey nodeAddress port tls = do
let run = access pipe master db
scotty 3000 $ do
middleware $
@ -372,9 +380,7 @@ app pipe db passkey nodeAddress = do
then do
liftIO $ run (validateUser sess)
status accepted202
else status noContent204 `debug`
("Pins didn't match: " ++
providedPin ++ " " ++ T.unpack (upin pUser))
else status noContent204 --`debug` ("Pins didn't match: " ++ providedPin ++ " " ++ T.unpack (upin pUser))
--Delete user
Web.Scotty.delete "/api/user/:id" $ do
userId <- param "id"
@ -443,7 +449,8 @@ app pipe db passkey nodeAddress = do
--Upsert item
post "/api/item" $ do
i <- jsonData
_ <- liftIO $ run (upsertItem i)
let q = payload (i :: Payload Item)
_ <- liftIO $ run (upsertItem q)
status created201
--Delete item
Web.Scotty.delete "/api/item/:id" $ do
@ -515,7 +522,8 @@ app pipe db passkey nodeAddress = do
--Upsert order
post "/api/order" $ do
newOrder <- jsonData
_ <- liftIO $ run (upsertOrder newOrder)
let q = payload (newOrder :: Payload ZGoOrder)
_ <- liftIO $ run (upsertOrder q)
status created201
--Delete order
Web.Scotty.delete "/api/order/:id" $ do

View file

@ -58,6 +58,7 @@ library
, vector
, wai-cors
, wai-extra
, warp-tls
default-language: Haskell2010
executable zgo-backend-exe
@ -71,6 +72,7 @@ executable zgo-backend-exe
aeson
, base
, bytestring
, configurator
, http-conduit
, http-types
, mongoDB
@ -79,6 +81,7 @@ executable zgo-backend-exe
, text
, time
, wai-extra
, warp-tls
, zgo-backend
default-language: Haskell2010

9
zgo.cfg Normal file
View file

@ -0,0 +1,9 @@
passkey = "superSecret"
nodeAddress = "zs1xnpqd2tae9d95f8fhe4l0q7j44a5vf993m0pcnnvr56uqr4lgqlamesk5v4c5rhtvywc6lvlduy"
dbName = "zgo"
dbUser = "zgo"
dbPassword = "zcashrules"
port = 3000
tls = false
cert = "/path/to/cert.pem"
key = "/path/to/key.pem"