zenith/app/Server.hs

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