92 lines
3.2 KiB
Haskell
92 lines
3.2 KiB
Haskell
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
|
||
|
|
module Server where
|
||
|
|
|
||
|
|
import Control.Concurrent (forkIO, threadDelay)
|
||
|
|
import Control.Exception (throwIO, throwTo, try)
|
||
|
|
import Control.Monad (forever, when)
|
||
|
|
import Control.Monad.Logger (runNoLoggingT)
|
||
|
|
import Data.Configurator
|
||
|
|
import qualified Data.Text as T
|
||
|
|
import Network.Wai.Handler.Warp (run)
|
||
|
|
import Servant
|
||
|
|
import System.Exit
|
||
|
|
import System.Posix.Signals
|
||
|
|
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
|
||
|
|
import Zenith.Core (checkBlockChain, checkZebra)
|
||
|
|
import Zenith.DB (getWallets, initDb, initPool)
|
||
|
|
import Zenith.RPC
|
||
|
|
( State(..)
|
||
|
|
, ZenithRPC(..)
|
||
|
|
, authenticate
|
||
|
|
, scanZebra
|
||
|
|
, zenithServer
|
||
|
|
)
|
||
|
|
import Zenith.Scanner (rescanZebra)
|
||
|
|
import Zenith.Types (Config(..))
|
||
|
|
import Zenith.Utils (getZenithPath)
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
main = do
|
||
|
|
config <- load ["$(HOME)/Zenith/zenith.cfg"]
|
||
|
|
dbFileName <- require config "dbFileName"
|
||
|
|
nodeUser <- require config "nodeUser"
|
||
|
|
nodePwd <- require config "nodePwd"
|
||
|
|
zebraPort <- require config "zebraPort"
|
||
|
|
zebraHost <- require config "zebraHost"
|
||
|
|
nodePort <- require config "nodePort"
|
||
|
|
dbFP <- getZenithPath
|
||
|
|
let dbFilePath = T.pack $ dbFP ++ dbFileName
|
||
|
|
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||
|
|
let ctx = authenticate myConfig :. EmptyContext
|
||
|
|
w <- try $ checkZebra zebraHost zebraPort :: IO (Either IOError ZebraGetInfo)
|
||
|
|
case w of
|
||
|
|
Right zebra -> do
|
||
|
|
bc <-
|
||
|
|
try $ checkBlockChain zebraHost zebraPort :: IO
|
||
|
|
(Either IOError ZebraGetBlockChainInfo)
|
||
|
|
case bc of
|
||
|
|
Left e1 -> throwIO e1
|
||
|
|
Right chainInfo -> do
|
||
|
|
x <- initDb dbFilePath
|
||
|
|
case x of
|
||
|
|
Left e2 -> throwIO $ userError e2
|
||
|
|
Right x' -> do
|
||
|
|
when x' $ rescanZebra zebraHost zebraPort dbFilePath
|
||
|
|
pool <- runNoLoggingT $ initPool dbFilePath
|
||
|
|
walList <- getWallets pool $ zgb_net chainInfo
|
||
|
|
if not (null walList)
|
||
|
|
then do
|
||
|
|
scanThread <-
|
||
|
|
forkIO $
|
||
|
|
forever $ do
|
||
|
|
_ <-
|
||
|
|
scanZebra
|
||
|
|
dbFilePath
|
||
|
|
zebraHost
|
||
|
|
zebraPort
|
||
|
|
(zgb_net chainInfo)
|
||
|
|
threadDelay 90000000
|
||
|
|
putStrLn "Zenith RPC Server 0.7.0.0-beta"
|
||
|
|
putStrLn "------------------------------"
|
||
|
|
putStrLn $
|
||
|
|
"Connected to " ++
|
||
|
|
show (zgb_net chainInfo) ++
|
||
|
|
" Zebra " ++
|
||
|
|
T.unpack (zgi_build zebra) ++ " on port " ++ show zebraPort
|
||
|
|
let myState =
|
||
|
|
State
|
||
|
|
(zgb_net chainInfo)
|
||
|
|
zebraHost
|
||
|
|
zebraPort
|
||
|
|
dbFilePath
|
||
|
|
(zgi_build zebra)
|
||
|
|
(zgb_blocks chainInfo)
|
||
|
|
run nodePort $
|
||
|
|
serveWithContext
|
||
|
|
(Proxy :: Proxy ZenithRPC)
|
||
|
|
ctx
|
||
|
|
(zenithServer myState)
|
||
|
|
else putStrLn
|
||
|
|
"No wallets available. Please start Zenith interactively to create a wallet"
|