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 module Main where
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO)
import Data.Configurator
import Data.SecureMem import Data.SecureMem
import qualified Data.Text as T
import Database.MongoDB import Database.MongoDB
import Network.Wai.Handler.WarpTLS (tlsSettings)
import ZGoBackend 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 :: IO ()
main = do 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..." putStrLn "Starting Server..."
pipe <- connect $ host "127.0.0.1" pipe <- connect $ host "127.0.0.1"
j <- access pipe master "zgo" (auth dbUser dbPassword) j <- access pipe master dbName (auth dbUser dbPassword)
_ <- forkIO (setInterval 60 (checkZcashPrices pipe "zgo"))
_ <- forkIO (setInterval 75 (scanZcash nodeAddress pipe "zgo"))
if j if j
then putStrLn "Connected to MongoDB!" then putStrLn "Connected to MongoDB!"
else fail "MongoDB connection failed!" 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 - random
- vector - vector
- wai-cors - wai-cors
- warp-tls
executables: executables:
zgo-backend-exe: zgo-backend-exe:
@ -69,6 +70,8 @@ executables:
- http-conduit - http-conduit
- time - time
- bytestring - bytestring
- configurator
- warp-tls
tests: tests:
zgo-backend-test: zgo-backend-test:

View file

@ -90,7 +90,10 @@ upsertItem :: Item -> Action IO ()
upsertItem i = do upsertItem i = do
let item = val i let item = val i
case item of 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 () _ -> return ()
deleteItem :: String -> Action IO () deleteItem :: String -> Action IO ()

View file

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

View file

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

View file

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