zgo-backend/app/Main.hs

180 lines
6 KiB
Haskell
Raw Normal View History

2022-04-22 16:15:23 +00:00
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Concurrent (forkIO, threadDelay)
import Control.Monad
import Control.Monad.IO.Class
import Data.Aeson
import Data.SecureMem
import qualified Data.Text as T
import qualified Data.Text.Lazy as L
import Database.MongoDB
import GHC.Generics
import Network.HTTP.Simple
import Network.HTTP.Types.Status
import Network.Wai.Middleware.HttpAuth
import Web.Scotty
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 "Starting Server..."
pipe <- connect $ host "127.0.0.1"
let run = access pipe master "zgo"
j <- run (auth dbUser dbPassword)
_ <- forkIO (setInterval 60 (checkZcashPrices pipe))
if j
then putStrLn "Connected to MongoDB!"
else fail "MongoDB connection failed!"
scotty 4000 $ do
middleware $
basicAuth
(\u p -> return $ u == "user" && secureMemFromByteString p == passkey)
"ZGo Backend"
--Get list of countries for UI
get "/api/countries" $ do
countries <- liftIO $ run listCountries
case countries of
[] -> do
status noContent204
Web.Scotty.json
(object ["message" .= ("No countries available" :: String)])
_ -> do
Web.Scotty.json
(object
[ "message" .= ("Country data found" :: String)
, "countries" .= toJSON (map parseCountryBson countries)
])
--Get user associated with session
get "/api/user" $ do
session <- param "session"
user <- liftIO $ run (findUser session)
case user of
Nothing -> status noContent204
Just u ->
Web.Scotty.json
(object
[ "message" .= ("User found" :: String)
, "user" .= toJSON (parseUserBson u)
])
--Delete user
Web.Scotty.delete "/api/user/:id" $ do text "Deleted that guy!"
--Get txs from DB that have less than 10 confirmations
get "/api/pending" $ do
session <- param "session"
pending <- liftIO $ run (findPending session)
case pending of
[] -> do
status noContent204
Web.Scotty.json
(object ["message" .= ("No pending transactions" :: String)])
_ -> do
Web.Scotty.json
(object
[ "message" .= ("Found pending transactions" :: String)
, "txs" .= toJSON (map parseZGoTxBson pending)
])
--Get current blockheight from Zcash node
get "/api/blockheight" $ do
blockInfo <- makeZcashCall "getblock" ["-1"]
Web.Scotty.json (result (getResponseBody blockInfo :: RpcResponse Block))
--Get transactions associated with ZGo node
get "/api/txs" $ do
txs <- makeZcashCall "z_listreceivedbyaddress" [nodeAddress]
Web.Scotty.json (result (getResponseBody txs :: RpcResponse [ZcashTx]))
--Get the ZGo node's shielded address
get "/api/getaddr" $ do Web.Scotty.json (object ["addr" .= nodeAddress])
--Get owner by address
get "/api/owner" $ do text "Here's an owner for you"
--Upsert owner to DB
post "/api/owner" $ do text "I added an owner for you"
--Validate user, updating record
post "/api/validateuser" $ do text "Marked user as validated"
--Get items associated with the given address
get "/api/items" $ do text "Here are your items"
--Upsert item
post "/api/item" $ do text "I upserted the item for you"
--Delete item
Web.Scotty.delete "/api/item/:id" $ do text "Deleted that pesky item"
--Get price for Zcash
get "/api/price" $ do
currency <- param "currency"
price <- liftIO $ run (findPrice currency)
case price of
Nothing -> do
status noContent204
Web.Scotty.json (object ["message" .= ("No price" :: String)])
Just p -> do
Web.Scotty.json
(object
[ "message" .= ("Price found!" :: String)
, "price" .= toJSON (parseZGoPrice p)
])
--Get all closed orders for the address
get "/api/allorders" $ do text "Here are the orders"
--Get order by id for receipts
get "/api/order/:id" $ do
oId <- param "id"
text (L.pack ("Here's the order" <> oId))
--Get order by session
get "/api/order" $ do
diff <- param "diff"
text (L.pack ("This is a diff order" <> diff))
--Upsert order
post "/api/order" $ do text "Upserted your order"
get "/api/test" $ do
q <- liftIO getZcashPrices
a <- liftIO $ mapM_ run (updatePrices (getResponseBody q))
text "Updated the DB!"
-- |Make a Zcash RPC call
makeZcashCall :: (MonadIO m, FromJSON a) => T.Text -> [T.Text] -> m (Response a)
makeZcashCall m p = do
let username = "zecwallet"
let password = "rdsxlun6v4a"
let payload =
RpcCall {jsonrpc = "1.0", callId = "test", method = m, parameters = p}
let myRequest =
setRequestBodyJSON payload $
setRequestPort 8232 $
setRequestBasicAuth username password $
setRequestMethod "POST" defaultRequest
httpJSON myRequest
-- |Timer for repeating actions
setInterval :: Int -> IO () -> IO ()
setInterval secs func = do
forever $ threadDelay (secs * 1000000) >> func
-- |Function to query the CoinGecko API for the price of Zcash
getZcashPrices :: IO (Response CoinGeckoPrices)
getZcashPrices = do
let priceRequest =
setRequestQueryString
[("ids", Just "zcash"), ("vs_currencies", Just "usd,gbp,eur,cad,aud")] $
setRequestPort 443 $
setRequestSecure True $
setRequestHost "api.coingecko.com" $
setRequestPath "/api/v3/simple/price" defaultRequest
httpJSON priceRequest
checkZcashPrices :: Pipe -> IO ()
checkZcashPrices p = do
q <- getZcashPrices
mapM_ (access p master "zgo") (updatePrices (getResponseBody q))
putStrLn "Got new prices"