diff --git a/app/Main.hs b/app/Main.hs index e7ede57..6f570e0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -15,10 +15,13 @@ main :: IO () main = do putStrLn "Reading config..." config <- load ["zgo.cfg"] + dbHost <- require config "dbHost" dbName <- require config "dbName" dbUser <- require config "dbUser" dbPassword <- require config "dbPassword" nodeAddress <- require config "nodeAddress" + nodeUser <- require config "nodeUser" + nodePwd <- require config "nodePassword" passkey <- secureMemFromByteString <$> require config "passkey" port <- require config "port" useTls <- require config "tls" @@ -29,16 +32,17 @@ main = do then Just $ tlsSettings cert key else Nothing putStrLn "Starting Server..." - pipe <- connect $ host "127.0.0.1" + pipe <- connect $ host dbHost j <- access pipe master dbName (auth dbUser dbPassword) if j then putStrLn "Connected to MongoDB!" else fail "MongoDB connection failed!" _ <- forkIO (setInterval 60 (checkZcashPrices pipe dbName)) - _ <- forkIO (setInterval 75 (scanZcash nodeAddress pipe dbName)) + _ <- + forkIO (setInterval 75 (scanZcash nodeAddress pipe dbName nodeUser nodePwd)) _ <- forkIO (setInterval 60 (checkPayments pipe dbName)) _ <- forkIO (setInterval 60 (expireOwners pipe dbName)) - let appRoutes = routes pipe dbName passkey nodeAddress + let appRoutes = routes pipe dbName passkey nodeAddress nodeUser nodePwd case myTlsSettings of Nothing -> scotty port appRoutes Just tls -> do diff --git a/src/ZGoBackend.hs b/src/ZGoBackend.hs index 08600e4..9ab70c0 100644 --- a/src/ZGoBackend.hs +++ b/src/ZGoBackend.hs @@ -247,8 +247,14 @@ instance FromJSON CoinGeckoPrices where listCountries :: Action IO [Document] listCountries = rest =<< find (select [] "countries") -sendPin :: T.Text -> T.Text -> T.Text -> Action IO String -sendPin nodeAddress addr pin = do +sendPin :: + BS.ByteString + -> BS.ByteString + -> T.Text + -> T.Text + -> T.Text + -> Action IO String +sendPin nodeUser nodePwd nodeAddress addr pin = do let payload = [ Data.Aeson.String nodeAddress , Data.Aeson.Array @@ -260,20 +266,27 @@ sendPin nodeAddress addr pin = do ] ]) ] - r <- makeZcashCall "z_sendmany" payload + r <- makeZcashCall nodeUser nodePwd "z_sendmany" payload let sCode = getResponseStatus (r :: Response Object) if sCode == ok200 then return "Pin sent!" else return "Pin sending failed :(" -- | Function to create user from ZGoTx -addUser :: Pipe -> T.Text -> T.Text -> Maybe ZGoTx -> Action IO () -addUser _ _ _ Nothing = return () --`debug` "addUser got Nothing" -addUser p db node (Just tx) = do +addUser :: + BS.ByteString + -> BS.ByteString + -> Pipe + -> T.Text + -> T.Text + -> Maybe ZGoTx + -> Action IO () +addUser _ _ _ _ _ Nothing = return () --`debug` "addUser got Nothing" +addUser nodeUser nodePwd p db node (Just tx) = do isNew <- liftIO $ isUserNew p db tx when isNew $ do let newPin = unsafePerformIO generatePin - _ <- sendPin node (address tx) newPin + _ <- sendPin nodeUser nodePwd node (address tx) newPin insert_ "users" [ "address" =: address tx @@ -314,8 +327,15 @@ upsertZGoTx coll t = do upsert (select ["txid" =: txid t] coll) (encodeZGoTxBson t) -- | Main API routes -routes :: Pipe -> T.Text -> SecureMem -> T.Text -> ScottyM () -routes pipe db passkey nodeAddress = do +routes :: + Pipe + -> T.Text + -> SecureMem + -> T.Text + -> BS.ByteString + -> BS.ByteString + -> ScottyM () +routes pipe db passkey nodeAddress nodeUser nodePwd = do let run = access pipe master db middleware $ cors $ @@ -392,7 +412,7 @@ routes pipe db passkey nodeAddress = do {-])-} --Get current blockheight from Zcash node get "/api/blockheight" $ do - blockInfo <- makeZcashCall "getblock" ["-1"] + blockInfo <- makeZcashCall nodeUser nodePwd "getblock" ["-1"] Web.Scotty.json (result (getResponseBody blockInfo :: RpcResponse Block)) --Get transactions associated with ZGo node --get "/api/txs" $ do @@ -522,10 +542,13 @@ routes pipe db passkey nodeAddress = do -- |Make a Zcash RPC call makeZcashCall :: - (MonadIO m, FromJSON a) => T.Text -> [Data.Aeson.Value] -> m (Response a) -makeZcashCall m p = do - let username = "zecwallet" - let password = "rdsxlun6v4a" + (MonadIO m, FromJSON a) + => BS.ByteString + -> BS.ByteString + -> T.Text + -> [Data.Aeson.Value] + -> m (Response a) +makeZcashCall username password m p = do let payload = RpcCall {jsonrpc = "1.0", callId = "test", method = m, parameters = p} let myRequest = @@ -559,9 +582,14 @@ checkZcashPrices p db = do mapM_ (access p master db) (updatePrices (getResponseBody q)) -- | Function to check the ZGo full node for new txs -scanZcash :: T.Text -> Pipe -> T.Text -> IO () -scanZcash addr pipe db = do - res <- makeZcashCall "z_listreceivedbyaddress" [Data.Aeson.String addr] +scanZcash :: T.Text -> Pipe -> T.Text -> BS.ByteString -> BS.ByteString -> IO () +scanZcash addr pipe db nodeUser nodePwd = do + res <- + makeZcashCall + nodeUser + nodePwd + "z_listreceivedbyaddress" + [Data.Aeson.String addr] let txs = filter (not . zchange) $ result (getResponseBody res :: RpcResponse [ZcashTx]) @@ -577,8 +605,9 @@ scanZcash addr pipe db = do mapM_ (access pipe master db . upsertPayment) j -- | Function to generate users from login txs -updateLogins :: T.Text -> Pipe -> T.Text -> IO () -updateLogins addr pipe db = do +updateLogins :: + BS.ByteString -> BS.ByteString -> T.Text -> Pipe -> T.Text -> IO () +updateLogins nodeUser nodePwd addr pipe db = do results <- access pipe @@ -587,7 +616,9 @@ updateLogins addr pipe db = do (rest =<< find (select ["confirmations" =: ["$lt" =: (100 :: Integer)]] "txs")) let parsed = map (cast' . Doc) results - mapM_ (access pipe master db . ZGoBackend.addUser pipe db addr) parsed + mapM_ + (access pipe master db . ZGoBackend.addUser nodeUser nodePwd pipe db addr) + parsed putStrLn "Updated logins!" -- | Function to mark owners as paid diff --git a/zgo.cfg b/zgo.cfg index adbe4dc..eec2397 100644 --- a/zgo.cfg +++ b/zgo.cfg @@ -1,8 +1,11 @@ passkey = "superSecret" nodeAddress = "zs1xnpqd2tae9d95f8fhe4l0q7j44a5vf993m0pcnnvr56uqr4lgqlamesk5v4c5rhtvywc6lvlduy" +dbHost = "127.0.0.1" dbName = "zgo" dbUser = "zgo" dbPassword = "zcashrules" +nodeUser = "zecwallet" +nodePassword = "rdsxlun6v4a" port = 3000 tls = false certificate = "/path/to/cert.pem"