Vergara_Tech/zgo-backend
Vergara_Tech/zgo-backend
2
1
Fork 0
Code Issues Pull requests Projects Releases 4 Packages Wiki Activity

Implement TLS for API server

Browse source
This commit is contained in:
Rene Vergara 2022-05-19 09:52:17 -05:00
parent 0d56026183
commit 3574beab58
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
5 changed files with 182 additions and 184 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
app/Main.hs
View file

@ -6,7 +6,9 @@ import Control.Concurrent (forkIO)
import Data.Configurator import Data.Configurator
import Data.SecureMem import Data.SecureMem
import Database.MongoDB import Database.MongoDB
import Network.Wai.Handler.WarpTLS (tlsSettings) import Network.Wai.Handler.Warp (defaultSettings, setPort)
import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
import Web.Scotty
import ZGoBackend import ZGoBackend
main :: IO () main :: IO ()
@ -36,4 +38,9 @@ main = do
_ <- forkIO (setInterval 75 (scanZcash nodeAddress pipe dbName)) _ <- forkIO (setInterval 75 (scanZcash nodeAddress pipe dbName))
_ <- forkIO (setInterval 60 (checkPayments pipe dbName)) _ <- forkIO (setInterval 60 (checkPayments pipe dbName))
_ <- forkIO (setInterval 60 (expireOwners pipe dbName)) _ <- forkIO (setInterval 60 (expireOwners pipe dbName))
app pipe dbName passkey nodeAddress port myTlsSettings let appRoutes = routes pipe dbName passkey nodeAddress
case myTlsSettings of
Nothing -> scotty port appRoutes
Just tls -> do
apiCore <- scottyApp appRoutes
runTLS tls (setPort port defaultSettings) apiCore

1
package.yaml
View file

@ -72,6 +72,7 @@ executables:
- bytestring - bytestring
- configurator - configurator
- warp-tls - warp-tls
- warp
tests: tests:
zgo-backend-test: zgo-backend-test:

351
src/ZGoBackend.hs
View file

@ -29,7 +29,6 @@ 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,78 +313,70 @@ upsertZGoTx :: T.Text -> ZGoTx -> Action IO ()
upsertZGoTx coll t = do 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 routes
app :: routes :: Pipe -> T.Text -> SecureMem -> T.Text -> ScottyM ()
Pipe routes pipe db passkey nodeAddress = do
-> 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 middleware $
middleware $ cors $
cors $ const $
const $ Just
Just simpleCorsResourcePolicy
simpleCorsResourcePolicy { corsRequestHeaders = ["Authorization", "Content-Type"]
{ corsRequestHeaders = ["Authorization", "Content-Type"] , corsMethods = "DELETE" : simpleMethods
, corsMethods = "DELETE" : simpleMethods , corsOrigins = Nothing
, corsOrigins = Nothing }
} middleware $
middleware $ basicAuth
basicAuth (\u p -> return $ u == "user" && secureMemFromByteString p == passkey)
(\u p -> return $ u == "user" && secureMemFromByteString p == passkey) "ZGo Backend"
"ZGo Backend"
--Get list of countries for UI --Get list of countries for UI
get "/api/countries" $ do get "/api/countries" $ do
countries <- liftIO $ run listCountries countries <- liftIO $ run listCountries
case countries of case countries of
[] -> do [] -> do
status noContent204 status noContent204
_ -> do _ -> do
Web.Scotty.json Web.Scotty.json
(object (object
[ "message" .= ("Country data found" :: String) [ "message" .= ("Country data found" :: String)
, "countries" .= toJSON (map parseCountryBson countries) , "countries" .= toJSON (map parseCountryBson countries)
]) ])
--Get user associated with session --Get user associated with session
get "/api/user" $ do get "/api/user" $ do
sess <- param "session" sess <- param "session"
user <- liftIO $ run (findUser sess) user <- liftIO $ run (findUser sess)
case user of case user of
Nothing -> status noContent204 Nothing -> status noContent204
Just u -> Just u ->
Web.Scotty.json Web.Scotty.json
(object (object
[ "message" .= ("User found" :: String) [ "message" .= ("User found" :: String)
, "user" .= toJSON (parseUserBson u) , "user" .= toJSON (parseUserBson u)
]) ])
--Validate user, updating record --Validate user, updating record
post "/api/validateuser" $ do post "/api/validateuser" $ do
providedPin <- param "pin" providedPin <- param "pin"
sess <- param "session" sess <- param "session"
user <- liftIO $ run (findUser sess) user <- liftIO $ run (findUser sess)
case user of case user of
Nothing -> status noContent204 --`debug` "No user match" Nothing -> status noContent204 --`debug` "No user match"
Just u -> do Just u -> do
let parsedUser = parseUserBson u let parsedUser = parseUserBson u
case parsedUser of case parsedUser of
Nothing -> status noContent204 --`debug` "Couldn't parse user" Nothing -> status noContent204 --`debug` "Couldn't parse user"
Just pUser -> do Just pUser -> do
let ans = upin pUser == T.pack providedPin let ans = upin pUser == T.pack providedPin
if ans if ans
then do then do
liftIO $ run (validateUser sess) liftIO $ run (validateUser sess)
status accepted202 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 --Delete user
Web.Scotty.delete "/api/user/:id" $ do Web.Scotty.delete "/api/user/:id" $ do
userId <- param "id" userId <- param "id"
liftIO $ run (deleteUser userId) liftIO $ run (deleteUser userId)
status ok200 status ok200
--Get txs from DB that have less than 10 confirmations --Get txs from DB that have less than 10 confirmations
{-get "/api/pending" $ do-} {-get "/api/pending" $ do-}
{-sess <- param "session"-} {-sess <- param "session"-}
@ -400,136 +391,134 @@ app pipe db passkey nodeAddress port tls = do
{-, "txs" .= toJSON (map parseZGoTxBson pending)-} {-, "txs" .= toJSON (map parseZGoTxBson pending)-}
{-])-} {-])-}
--Get current blockheight from Zcash node --Get current blockheight from Zcash node
get "/api/blockheight" $ do get "/api/blockheight" $ do
blockInfo <- makeZcashCall "getblock" ["-1"] blockInfo <- makeZcashCall "getblock" ["-1"]
Web.Scotty.json (result (getResponseBody blockInfo :: RpcResponse Block)) Web.Scotty.json (result (getResponseBody blockInfo :: RpcResponse Block))
--Get transactions associated with ZGo node --Get transactions associated with ZGo node
--get "/api/txs" $ do --get "/api/txs" $ do
--txs <- makeZcashCall "z_listreceivedbyaddress" [nodeAddress] --txs <- makeZcashCall "z_listreceivedbyaddress" [nodeAddress]
--Web.Scotty.json (result (getResponseBody txs :: RpcResponse [ZcashTx])) --Web.Scotty.json (result (getResponseBody txs :: RpcResponse [ZcashTx]))
--Get the ZGo node's shielded address --Get the ZGo node's shielded address
get "/api/getaddr" $ do Web.Scotty.json (object ["addr" .= nodeAddress]) get "/api/getaddr" $ do Web.Scotty.json (object ["addr" .= nodeAddress])
--Get owner by address --Get owner by address
get "/api/owner" $ do get "/api/owner" $ do
addr <- param "address" addr <- param "address"
owner <- liftIO $ run (findOwner addr) owner <- liftIO $ run (findOwner addr)
case owner of case owner of
Nothing -> status noContent204 Nothing -> status noContent204
Just o -> do Just o -> do
let pOwner = cast' (Doc o) let pOwner = cast' (Doc o)
case pOwner of case pOwner of
Nothing -> status internalServerError500 Nothing -> status internalServerError500
Just q -> do Just q -> do
status ok200 status ok200
Web.Scotty.json Web.Scotty.json
(object (object
[ "message" .= ("Owner found!" :: String) [ "message" .= ("Owner found!" :: String)
, "owner" .= toJSON (q :: Owner) , "owner" .= toJSON (q :: Owner)
]) ])
--Upsert owner to DB --Upsert owner to DB
post "/api/owner" $ do post "/api/owner" $ do
o <- jsonData o <- jsonData
let q = payload (o :: Payload Owner) let q = payload (o :: Payload Owner)
_ <- liftIO $ run (upsertOwner q) _ <- liftIO $ run (upsertOwner q)
status created201 status created201
--Get items associated with the given address --Get items associated with the given address
get "/api/items" $ do get "/api/items" $ do
addr <- param "address" addr <- param "address"
items <- liftIO $ run (findItems addr) items <- liftIO $ run (findItems addr)
case items of case items of
[] -> status noContent204 [] -> status noContent204
_ -> do _ -> do
let pItems = map (cast' . Doc) items :: [Maybe Item] let pItems = map (cast' . Doc) items :: [Maybe Item]
status ok200 status ok200
Web.Scotty.json Web.Scotty.json
(object (object
[ "message" .= ("Items found!" :: String) ["message" .= ("Items found!" :: String), "items" .= toJSON pItems])
, "items" .= toJSON pItems
])
--Upsert item --Upsert item
post "/api/item" $ do post "/api/item" $ do
i <- jsonData i <- jsonData
let q = payload (i :: Payload Item) let q = payload (i :: Payload Item)
_ <- liftIO $ run (upsertItem q) _ <- 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
oId <- param "id" oId <- param "id"
liftIO $ run (deleteItem oId) liftIO $ run (deleteItem oId)
status ok200 status ok200
--Get price for Zcash --Get price for Zcash
get "/api/price" $ do get "/api/price" $ do
curr <- param "currency" curr <- param "currency"
pr <- liftIO $ run (findPrice curr) pr <- liftIO $ run (findPrice curr)
case pr of case pr of
Nothing -> do Nothing -> do
status noContent204 status noContent204
--Web.Scotty.json (object ["message" .= ("No price" :: T.Text)]) --Web.Scotty.json (object ["message" .= ("No price" :: T.Text)])
Just p -> do Just p -> do
Web.Scotty.json Web.Scotty.json
(object (object
[ "message" .= ("Price found!" :: String) [ "message" .= ("Price found!" :: String)
, "price" .= toJSON (parseZGoPrice p) , "price" .= toJSON (parseZGoPrice p)
]) ])
--Get all closed orders for the address --Get all closed orders for the address
get "/api/allorders" $ do get "/api/allorders" $ do
addr <- param "address" addr <- param "address"
myOrders <- liftIO $ run (findAllOrders addr) myOrders <- liftIO $ run (findAllOrders addr)
case myOrders of case myOrders of
[] -> status noContent204 [] -> status noContent204
_ -> do _ -> do
let pOrders = map (cast' . Doc) myOrders :: [Maybe ZGoOrder] let pOrders = map (cast' . Doc) myOrders :: [Maybe ZGoOrder]
status ok200 status ok200
Web.Scotty.json Web.Scotty.json
(object (object
[ "message" .= ("Orders found!" :: String) [ "message" .= ("Orders found!" :: String)
, "orders" .= toJSON pOrders , "orders" .= toJSON pOrders
]) ])
--Get order by id for receipts --Get order by id for receipts
get "/api/order/:id" $ do get "/api/order/:id" $ do
oId <- param "id" oId <- param "id"
myOrder <- liftIO $ run (findOrderById oId) myOrder <- liftIO $ run (findOrderById oId)
case myOrder of case myOrder of
Nothing -> status noContent204 Nothing -> status noContent204
Just o -> do Just o -> do
let o' = cast' (Doc o) let o' = cast' (Doc o)
case o' of case o' of
Nothing -> status internalServerError500 Nothing -> status internalServerError500
Just pOrder -> do Just pOrder -> do
status ok200 status ok200
Web.Scotty.json Web.Scotty.json
(object (object
[ "message" .= ("Order found!" :: String) [ "message" .= ("Order found!" :: String)
, "order" .= toJSON (pOrder :: ZGoOrder) , "order" .= toJSON (pOrder :: ZGoOrder)
]) ])
--Get order by session --Get order by session
get "/api/order" $ do get "/api/order" $ do
sess <- param "session" sess <- param "session"
myOrder <- liftIO $ run (findOrder sess) myOrder <- liftIO $ run (findOrder sess)
case myOrder of case myOrder of
Nothing -> status noContent204 Nothing -> status noContent204
Just o -> do Just o -> do
let o' = cast' (Doc o) let o' = cast' (Doc o)
case o' of case o' of
Nothing -> status internalServerError500 Nothing -> status internalServerError500
Just pOrder -> do Just pOrder -> do
status ok200 status ok200
Web.Scotty.json Web.Scotty.json
(object (object
[ "message" .= ("Order found!" :: String) [ "message" .= ("Order found!" :: String)
, "order" .= toJSON (pOrder :: ZGoOrder) , "order" .= toJSON (pOrder :: ZGoOrder)
]) ])
--Upsert order --Upsert order
post "/api/order" $ do post "/api/order" $ do
newOrder <- jsonData newOrder <- jsonData
let q = payload (newOrder :: Payload ZGoOrder) let q = payload (newOrder :: Payload ZGoOrder)
_ <- liftIO $ run (upsertOrder q) _ <- 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
oId <- param "id" oId <- param "id"
liftIO $ run (deleteOrder oId) liftIO $ run (deleteOrder oId)
status ok200 status ok200
-- |Make a Zcash RPC call -- |Make a Zcash RPC call
makeZcashCall :: makeZcashCall ::

1
zgo-backend.cabal
View file

@ -81,6 +81,7 @@ executable zgo-backend-exe
, text , text
, time , time
, wai-extra , wai-extra
, warp
, warp-tls , warp-tls
, zgo-backend , zgo-backend
default-language: Haskell2010 default-language: Haskell2010

2
zgo.cfg
View file

@ -5,5 +5,5 @@ dbUser = "zgo"
dbPassword = "zcashrules" dbPassword = "zcashrules"
port = 3000 port = 3000
tls = false tls = false
cert = "/path/to/cert.pem" certificate = "/path/to/cert.pem"
key = "/path/to/key.pem" key = "/path/to/key.pem"