zgo-backend/app/Main.hs

{-# 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"