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