Parametrize fullnode credentials

This commit is contained in:
Rene Vergara 2022-05-19 12:56:56 -05:00
parent 3574beab58
commit bde11cc9a0
Signed by: pitmutt
GPG Key ID: 65122AD495A7F5B2
3 changed files with 61 additions and 23 deletions

View File

@ -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

View File

@ -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

View File

@ -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"