Parametrize fullnode credentials
This commit is contained in:
parent
3574beab58
commit
bde11cc9a0
3 changed files with 61 additions and 23 deletions
10
app/Main.hs
10
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
|
||||
|
|
|
@ -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
|
||||
|
|
3
zgo.cfg
3
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"
|
||||
|
|
Loading…
Reference in a new issue