{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}

module Zenith.RPC where

import Control.Concurrent (forkIO)
import Control.Exception (SomeException(..), try)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT)
import Data.Aeson
import qualified Data.HexString as H
import Data.Int
import Data.Scientific (Scientific(..), floatingOrInteger)
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Data.Time.Clock (getCurrentTime)
import qualified Data.UUID as U
import Data.UUID.V4 (nextRandom)
import qualified Data.Vector as V
import Database.Esqueleto.Experimental
  ( ConnectionPool
  , entityKey
  , entityVal
  , fromSqlKey
  , toSqlKey
  )
import Servant
import Text.Read (readMaybe)
import ZcashHaskell.Keys
  ( deriveUfvk
  , deriveUivk
  , encodeVK
  , generateWalletSeedPhrase
  )
import ZcashHaskell.Orchard (parseAddress)
import ZcashHaskell.Types
  ( BlockResponse(..)
  , RpcError(..)
  , Scope(..)
  , ValidVk(..)
  , ZcashNet(..)
  , ZebraGetBlockChainInfo(..)
  )
import ZcashHaskell.Utils (getBlockTime, makeZebraCall)
import Zenith.Core
  ( checkBlockChain
  , createCustomWalletAddress
  , createZcashAccount
  , deshieldNotes
  , importViewingKey
  , parseVK
  , prepareTxV2
  , shieldTransparentNotes
  , syncWallet
  , updateCommitmentTrees
  )
import Zenith.DB
  ( Operation(..)
  , ZcashAccount(..)
  , ZcashBlock(..)
  , ZcashWallet(..)
  , completeSync
  , finalizeOperation
  , findNotesByAddress
  , getAccountById
  , getAccounts
  , getAddressById
  , getAddresses
  , getExternalAddresses
  , getLastSyncBlock
  , getMaxAccount
  , getMaxAddress
  , getMaxBlock
  , getMinBirthdayHeight
  , getOperation
  , getPoolBalance
  , getUnconfPoolBalance
  , getWalletNotes
  , getWallets
  , initPool
  , isSyncing
  , rewindWalletData
  , saveAccount
  , saveAddress
  , saveBlock
  , saveOperation
  , saveWallet
  , startSync
  , toZcashAccountAPI
  , toZcashAddressAPI
  , toZcashWalletAPI
  , walletExists
  )
import Zenith.Scanner (checkIntegrity, processTx, updateConfs)
import Zenith.Types
  ( AccountBalance(..)
  , AccountType(..)
  , Config(..)
  , HexStringDB(..)
  , PhraseDB(..)
  , PrivacyPolicy(..)
  , ProposedNote(..)
  , UnifiedFvkDB(..)
  , UnifiedIvkDB(..)
  , ZcashAccountAPI(..)
  , ZcashAddressAPI(..)
  , ZcashNetDB(..)
  , ZcashNoteAPI(..)
  , ZcashWalletAPI(..)
  , ZenithStatus(..)
  , ZenithUuid(..)
  )
import Zenith.Utils (jsonNumber)

data ZenithMethod
  = GetInfo
  | ListWallets
  | ListAccounts
  | ListAddresses
  | ListReceived
  | GetBalance
  | GetNewWallet
  | GetNewAccount
  | GetNewAddress
  | GetOperationStatus
  | SendMany
  | ShieldNotes
  | DeshieldFunds
  | GetFVK
  | GetIVK
  | ImportVK
  | UnknownMethod
  deriving (Eq, Prelude.Show)

instance ToJSON ZenithMethod where
  toJSON GetInfo = Data.Aeson.String "getinfo"
  toJSON ListWallets = Data.Aeson.String "listwallets"
  toJSON ListAccounts = Data.Aeson.String "listaccounts"
  toJSON ListAddresses = Data.Aeson.String "listaddresses"
  toJSON ListReceived = Data.Aeson.String "listreceived"
  toJSON GetBalance = Data.Aeson.String "getbalance"
  toJSON GetNewWallet = Data.Aeson.String "getnewwallet"
  toJSON GetNewAccount = Data.Aeson.String "getnewaccount"
  toJSON GetNewAddress = Data.Aeson.String "getnewaddress"
  toJSON GetOperationStatus = Data.Aeson.String "getoperationstatus"
  toJSON SendMany = Data.Aeson.String "sendmany"
  toJSON ShieldNotes = Data.Aeson.String "shieldnotes"
  toJSON DeshieldFunds = Data.Aeson.String "deshieldfunds"
  toJSON GetFVK = Data.Aeson.String "getfullvk"
  toJSON GetIVK = Data.Aeson.String "getincomingvk"
  toJSON ImportVK = Data.Aeson.String "importvk"
  toJSON UnknownMethod = Data.Aeson.Null

instance FromJSON ZenithMethod where
  parseJSON =
    withText "ZenithMethod" $ \case
      "getinfo" -> pure GetInfo
      "listwallets" -> pure ListWallets
      "listaccounts" -> pure ListAccounts
      "listaddresses" -> pure ListAddresses
      "listreceived" -> pure ListReceived
      "getbalance" -> pure GetBalance
      "getnewwallet" -> pure GetNewWallet
      "getnewaccount" -> pure GetNewAccount
      "getnewaddress" -> pure GetNewAddress
      "getoperationstatus" -> pure GetOperationStatus
      "sendmany" -> pure SendMany
      "shieldnotes" -> pure ShieldNotes
      "deshieldfunds" -> pure DeshieldFunds
      "getfullvk" -> pure GetFVK
      "getincomingvk" -> pure GetIVK
      "importvk" -> pure ImportVK
      _ -> pure UnknownMethod

data ZenithParams
  = BlankParams
  | BadParams
  | AccountsParams !Int
  | AddressesParams !Int
  | NotesParams !T.Text
  | BalanceParams !Int64
  | NameParams !T.Text
  | NameIdParams !T.Text !Int
  | NewAddrParams !Int !T.Text !Bool !Bool
  | OpParams !ZenithUuid
  | SendParams !Int ![ProposedNote] !PrivacyPolicy
  | TestParams !T.Text
  | ShieldNotesParams !Int
  | DeshieldParams !Int !Scientific
  | ViewingKeyParams !Int
  | ImportVkParams !T.Text !T.Text !Int
  deriving (Eq, Prelude.Show)

instance ToJSON ZenithParams where
  toJSON BlankParams = Data.Aeson.Array V.empty
  toJSON BadParams = Data.Aeson.Null
  toJSON (AccountsParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
  toJSON (AddressesParams n) = Data.Aeson.Array $ V.fromList [jsonNumber n]
  toJSON (TestParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
  toJSON (NotesParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
  toJSON (NameParams t) = Data.Aeson.Array $ V.fromList [Data.Aeson.String t]
  toJSON (NameIdParams t i) =
    Data.Aeson.Array $ V.fromList [Data.Aeson.String t, jsonNumber i]
  toJSON (BalanceParams n) =
    Data.Aeson.Array $ V.fromList [jsonNumber $ fromIntegral n]
  toJSON (NewAddrParams a n s t) =
    Data.Aeson.Array $
    V.fromList $
    [jsonNumber a, Data.Aeson.String n] <>
    [Data.Aeson.String "ExcludeSapling" | s] <>
    [Data.Aeson.String "ExcludeTransparent" | t]
  toJSON (OpParams i) =
    Data.Aeson.Array $ V.fromList [Data.Aeson.String $ U.toText $ getUuid i]
  toJSON (SendParams i ns p) =
    Data.Aeson.Array $ V.fromList [jsonNumber i, toJSON ns, toJSON p]
  toJSON (ShieldNotesParams i) = Data.Aeson.Array $ V.fromList [jsonNumber i]
  toJSON (DeshieldParams i s) =
    Data.Aeson.Array $ V.fromList [jsonNumber i, Data.Aeson.Number s]
  toJSON (ViewingKeyParams i) = Data.Aeson.Array $ V.fromList [jsonNumber i]
  toJSON (ImportVkParams n k b) =
    Data.Aeson.Array $
    V.fromList [Data.Aeson.String n, Data.Aeson.String k, jsonNumber b]

data ZenithResponse
  = InfoResponse !T.Text !ZenithInfo
  | WalletListResponse !T.Text ![ZcashWalletAPI]
  | AccountListResponse !T.Text ![ZcashAccountAPI]
  | AddressListResponse !T.Text ![ZcashAddressAPI]
  | NoteListResponse !T.Text ![ZcashNoteAPI]
  | BalanceResponse !T.Text !AccountBalance !AccountBalance
  | NewItemResponse !T.Text !Int64
  | NewAddrResponse !T.Text !ZcashAddressAPI
  | OpResponse !T.Text !Operation
  | SendResponse !T.Text !U.UUID
  | MultiOpResponse !T.Text ![T.Text]
  | ViewingKeyResponse !T.Text !T.Text
  | ErrorResponse !T.Text !Double !T.Text
  deriving (Eq, Prelude.Show)

instance ToJSON ZenithResponse where
  toJSON (InfoResponse t i) = packRpcResponse t i
  toJSON (WalletListResponse i w) = packRpcResponse i w
  toJSON (AccountListResponse i a) = packRpcResponse i a
  toJSON (AddressListResponse i a) = packRpcResponse i a
  toJSON (NoteListResponse i n) = packRpcResponse i n
  toJSON (ErrorResponse i c m) =
    object
      [ "jsonrpc" .= ("2.0" :: String)
      , "id" .= i
      , "error" .= object ["code" .= c, "message" .= m]
      ]
  toJSON (BalanceResponse i c u) =
    packRpcResponse i $ object ["confirmed" .= c, "unconfirmed" .= u]
  toJSON (NewItemResponse i ix) = packRpcResponse i ix
  toJSON (NewAddrResponse i a) = packRpcResponse i a
  toJSON (OpResponse i u) = packRpcResponse i u
  toJSON (SendResponse i o) = packRpcResponse i o
  toJSON (MultiOpResponse i o) = packRpcResponse i o
  toJSON (ViewingKeyResponse i k) = packRpcResponse i k

instance FromJSON ZenithResponse where
  parseJSON =
    withObject "ZenithResponse" $ \obj -> do
      jr <- obj .: "jsonrpc"
      i <- obj .: "id"
      e <- obj .:? "error"
      r <- obj .:? "result"
      if jr /= ("2.0" :: String)
        then fail "Malformed JSON"
        else do
          case e of
            Nothing -> do
              case r of
                Nothing -> fail "Malformed JSON"
                Just r1 ->
                  case r1 of
                    Object k -> do
                      v <- k .:? "version"
                      v5 <- k .:? "unconfirmed"
                      v6 <- k .:? "ua"
                      v7 <- k .:? "uuid"
                      case (v :: Maybe String) of
                        Just _v' -> do
                          k1 <- parseJSON r1
                          pure $ InfoResponse i k1
                        Nothing ->
                          case (v5 :: Maybe AccountBalance) of
                            Just _v5' -> do
                              k6 <- parseJSON r1
                              j1 <- k6 .: "confirmed"
                              j2 <- k6 .: "unconfirmed"
                              pure $ BalanceResponse i j1 j2
                            Nothing ->
                              case (v6 :: Maybe String) of
                                Just _v6' -> do
                                  k7 <- parseJSON r1
                                  pure $ NewAddrResponse i k7
                                Nothing ->
                                  case (v7 :: Maybe U.UUID) of
                                    Just _v7' -> do
                                      k8 <- parseJSON r1
                                      pure $ OpResponse i k8
                                    Nothing -> fail "Unknown object"
                    Array n -> do
                      if V.null n
                        then fail "Malformed JSON"
                        else do
                          case V.head n of
                            Object n' -> do
                              v1 <- n' .:? "lastSync"
                              v2 <- n' .:? "wallet"
                              v3 <- n' .:? "ua"
                              v4 <- n' .:? "amountZats"
                              case (v1 :: Maybe Int) of
                                Just _v1' -> do
                                  k2 <- parseJSON r1
                                  pure $ WalletListResponse i k2
                                Nothing ->
                                  case (v2 :: Maybe Int) of
                                    Just _v2' -> do
                                      k3 <- parseJSON r1
                                      pure $ AccountListResponse i k3
                                    Nothing ->
                                      case (v3 :: Maybe String) of
                                        Just _v3' -> do
                                          k4 <- parseJSON r1
                                          pure $ AddressListResponse i k4
                                        Nothing ->
                                          case (v4 :: Maybe Int) of
                                            Just _v4' -> do
                                              k5 <- parseJSON r1
                                              pure $ NoteListResponse i k5
                                            Nothing -> fail "Unknown object"
                            String s -> do
                              k7 <- parseJSON r1
                              pure $ MultiOpResponse i k7
                            _anyOther -> fail "Malformed JSON"
                    Number k -> do
                      case floatingOrInteger k of
                        Left _e -> fail "Unknown value"
                        Right k' -> pure $ NewItemResponse i k'
                    String s -> do
                      case U.fromText s of
                        Nothing -> pure $ ViewingKeyResponse i s
                        Just u -> pure $ SendResponse i u
                    _anyOther -> fail "Malformed JSON"
            Just e1 -> pure $ ErrorResponse i (ecode e1) (emessage e1)

data ZenithInfo = ZenithInfo
  { zi_version :: !T.Text
  , zi_network :: !ZcashNet
  , zi_zebra :: !T.Text
  } deriving (Eq, Prelude.Show)

instance ToJSON ZenithInfo where
  toJSON (ZenithInfo v n z) =
    object ["version" .= v, "network" .= n, "zebraVersion" .= z]

instance FromJSON ZenithInfo where
  parseJSON =
    withObject "ZenithInfo" $ \obj -> do
      v <- obj .: "version"
      n <- obj .: "network"
      z <- obj .: "zebraVersion"
      pure $ ZenithInfo v n z

-- | A type to model Zenith RPC calls
data RpcCall = RpcCall
  { jsonrpc :: !T.Text
  , callId :: !T.Text
  , method :: !ZenithMethod
  , parameters :: !ZenithParams
  } deriving (Eq, Prelude.Show)

instance ToJSON RpcCall where
  toJSON (RpcCall jr i m p) =
    object ["jsonrpc" .= jr, "id" .= i, "method" .= m, "params" .= p]

instance FromJSON RpcCall where
  parseJSON =
    withObject "RpcCall" $ \obj -> do
      v <- obj .: "jsonrpc"
      i <- obj .: "id"
      m <- obj .: "method"
      case m of
        UnknownMethod -> pure $ RpcCall v i UnknownMethod BlankParams
        ListWallets -> do
          p <- obj .: "params"
          if null (p :: [Value])
            then pure $ RpcCall v i ListWallets BlankParams
            else pure $ RpcCall v i ListWallets BadParams
        GetInfo -> do
          p <- obj .: "params"
          if null (p :: [Value])
            then pure $ RpcCall v i GetInfo BlankParams
            else pure $ RpcCall v i GetInfo BadParams
        ListAccounts -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  w <- parseJSON $ V.head a
                  pure $ RpcCall v i ListAccounts (AccountsParams w)
                else pure $ RpcCall v i ListAccounts BadParams
            _anyOther -> pure $ RpcCall v i ListAccounts BadParams
        ListAddresses -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  x <- parseJSON $ V.head a
                  pure $ RpcCall v i ListAddresses (AddressesParams x)
                else pure $ RpcCall v i ListAddresses BadParams
            _anyOther -> pure $ RpcCall v i ListAddresses BadParams
        ListReceived -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  x <- parseJSON $ V.head a
                  pure $ RpcCall v i ListReceived (NotesParams x)
                else pure $ RpcCall v i ListReceived BadParams
            _anyOther -> pure $ RpcCall v i ListReceived BadParams
        GetBalance -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  x <- parseJSON $ V.head a
                  pure $ RpcCall v i GetBalance (BalanceParams x)
                else pure $ RpcCall v i GetBalance BadParams
            _anyOther -> pure $ RpcCall v i GetBalance BadParams
        GetNewWallet -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  x <- parseJSON $ V.head a
                  pure $ RpcCall v i GetNewWallet (NameParams x)
                else pure $ RpcCall v i GetNewWallet BadParams
            _anyOther -> pure $ RpcCall v i GetNewWallet BadParams
        GetNewAccount -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 2
                then do
                  x <- parseJSON $ a V.! 0
                  y <- parseJSON $ a V.! 1
                  pure $ RpcCall v i GetNewAccount (NameIdParams x y)
                else pure $ RpcCall v i GetNewAccount BadParams
            _anyOther -> pure $ RpcCall v i GetNewAccount BadParams
        GetNewAddress -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a >= 2
                then do
                  x <- parseJSON $ a V.! 0
                  y <- parseJSON $ a V.! 1
                  (sap, tr) <-
                    case a V.!? 2 of
                      Nothing -> return (False, False)
                      Just s -> do
                        s' <- parseJSON s
                        case s' of
                          ("ExcludeSapling" :: String) -> do
                            case a V.!? 3 of
                              Nothing -> return (True, False)
                              Just t -> do
                                t' <- parseJSON t
                                return
                                  (True, t' == ("ExcludeTransparent" :: String))
                          ("ExcludeTransparent" :: String) -> do
                            case a V.!? 3 of
                              Nothing -> return (False, True)
                              Just t -> do
                                t' <- parseJSON t
                                return
                                  (t' == ("ExcludeSapling" :: String), True)
                          _anyOther -> return (False, False)
                  pure $ RpcCall v i GetNewAddress (NewAddrParams x y sap tr)
                else pure $ RpcCall v i GetNewAddress BadParams
            _anyOther -> pure $ RpcCall v i GetNewAddress BadParams
        GetOperationStatus -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  x <- parseJSON $ a V.! 0
                  case U.fromText x of
                    Just u -> do
                      pure $
                        RpcCall v i GetOperationStatus (OpParams $ ZenithUuid u)
                    Nothing -> pure $ RpcCall v i GetOperationStatus BadParams
                else pure $ RpcCall v i GetOperationStatus BadParams
            _anyOther -> pure $ RpcCall v i GetOperationStatus BadParams
        SendMany -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a >= 2
                then do
                  acc <- parseJSON $ a V.! 0
                  x <- parseJSON $ a V.! 1
                  case x of
                    String _ -> do
                      x' <- parseJSON $ a V.! 1
                      y <- parseJSON $ a V.! 2
                      if not (null y)
                        then pure $ RpcCall v i SendMany (SendParams acc y x')
                        else pure $ RpcCall v i SendMany BadParams
                    Array _ -> do
                      x' <- parseJSON $ a V.! 1
                      if not (null x')
                        then pure $
                             RpcCall v i SendMany (SendParams acc x' Full)
                        else pure $ RpcCall v i SendMany BadParams
                    _anyOther -> pure $ RpcCall v i SendMany BadParams
                else pure $ RpcCall v i SendMany BadParams
            _anyOther -> pure $ RpcCall v i SendMany BadParams
        ShieldNotes -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  x <- parseJSON $ a V.! 0
                  pure $ RpcCall v i ShieldNotes (ShieldNotesParams x)
                else pure $ RpcCall v i ShieldNotes BadParams
            _anyOther -> pure $ RpcCall v i ShieldNotes BadParams
        DeshieldFunds -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 2
                then do
                  x <- parseJSON $ a V.! 0
                  y <- parseJSON $ a V.! 1
                  pure $ RpcCall v i DeshieldFunds (DeshieldParams x y)
                else pure $ RpcCall v i DeshieldFunds BadParams
            _anyOther -> pure $ RpcCall v i DeshieldFunds BadParams
        GetFVK -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  x <- parseJSON $ a V.! 0
                  pure $ RpcCall v i GetFVK (ViewingKeyParams x)
                else pure $ RpcCall v i GetFVK BadParams
            _anyOther -> pure $ RpcCall v i GetFVK BadParams
        GetIVK -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 1
                then do
                  x <- parseJSON $ a V.! 0
                  pure $ RpcCall v i GetIVK (ViewingKeyParams x)
                else pure $ RpcCall v i GetIVK BadParams
            _anyOther -> pure $ RpcCall v i GetIVK BadParams
        ImportVK -> do
          p <- obj .: "params"
          case p of
            Array a ->
              if V.length a == 3
                then do
                  x <- parseJSON $ a V.! 0
                  y <- parseJSON $ a V.! 1
                  z <- parseJSON $ a V.! 2
                  pure $ RpcCall v i ImportVK (ImportVkParams x y z)
                else pure $ RpcCall v i ImportVK BadParams
            _anyOther -> pure $ RpcCall v i ImportVK BadParams

type ZenithRPC
  = "status" :> Get '[ JSON] Value :<|> BasicAuth "zenith-realm" Bool :> ReqBody
      '[ JSON]
      RpcCall :> Post '[ JSON] ZenithResponse

data State = State
  { w_network :: !ZcashNet
  , w_host :: !T.Text
  , w_port :: !Int
  , w_dbPath :: !T.Text
  , w_build :: !T.Text
  , w_startBlock :: !Int
  }

zenithServer :: State -> Server ZenithRPC
zenithServer state = getinfo :<|> handleRPC
  where
    getinfo :: Handler Value
    getinfo =
      return $
      object
        [ "version" .= ("0.9.0.0-beta" :: String)
        , "network" .= ("testnet" :: String)
        ]
    handleRPC :: Bool -> RpcCall -> Handler ZenithResponse
    handleRPC isAuth req =
      case method req of
        UnknownMethod ->
          return $ ErrorResponse (callId req) (-32601) "Method not found"
        ListWallets ->
          case parameters req of
            BlankParams -> do
              pool <- liftIO $ runNoLoggingT $ initPool $ w_dbPath state
              walList <- liftIO $ getWallets pool $ w_network state
              if not (null walList)
                then return $
                     WalletListResponse
                       (callId req)
                       (map toZcashWalletAPI walList)
                else return $
                     ErrorResponse
                       (callId req)
                       (-32001)
                       "No wallets available. Please create one first"
            _anyOther ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        ListAccounts ->
          case parameters req of
            AccountsParams w -> do
              let dbPath = w_dbPath state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              wl <- liftIO $ walletExists pool w
              case wl of
                Just wl' -> do
                  accList <-
                    liftIO $ runNoLoggingT $ getAccounts pool (entityKey wl')
                  if not (null accList)
                    then return $
                         AccountListResponse
                           (callId req)
                           (map toZcashAccountAPI accList)
                    else return $
                         ErrorResponse
                           (callId req)
                           (-32002)
                           "No accounts available for this wallet. Please create one first"
                Nothing ->
                  return $
                  ErrorResponse (callId req) (-32008) "Wallet does not exist."
            _anyOther ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        ListAddresses ->
          case parameters req of
            AddressesParams a -> do
              let dbPath = w_dbPath state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              addrList <-
                liftIO $
                runNoLoggingT $ getAddresses pool (toSqlKey $ fromIntegral a)
              if not (null addrList)
                then return $
                     AddressListResponse
                       (callId req)
                       (map toZcashAddressAPI addrList)
                else return $
                     ErrorResponse
                       (callId req)
                       (-32003)
                       "No addresses available for this account. Please create one first"
            _anyOther ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        GetInfo ->
          case parameters req of
            BlankParams ->
              return $
              InfoResponse
                (callId req)
                (ZenithInfo "0.9.0.0-beta" (w_network state) (w_build state))
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        ListReceived ->
          case parameters req of
            NotesParams x -> do
              case (readMaybe (T.unpack x) :: Maybe Int64) of
                Just x' -> do
                  let dbPath = w_dbPath state
                  pool <- liftIO $ runNoLoggingT $ initPool dbPath
                  a <- liftIO $ getAddressById pool $ toSqlKey x'
                  case a of
                    Just a' -> do
                      nList <- liftIO $ getWalletNotes pool a'
                      return $ NoteListResponse (callId req) nList
                    Nothing ->
                      return $
                      ErrorResponse
                        (callId req)
                        (-32004)
                        "Address does not belong to the wallet"
                Nothing ->
                  case parseAddress (E.encodeUtf8 x) of
                    Nothing ->
                      return $
                      ErrorResponse
                        (callId req)
                        (-32005)
                        "Unable to parse address"
                    Just x' -> do
                      let dbPath = w_dbPath state
                      pool <- liftIO $ runNoLoggingT $ initPool dbPath
                      addrs <- liftIO $ getExternalAddresses pool
                      nList <-
                        liftIO $
                        concat <$> mapM (findNotesByAddress pool x') addrs
                      return $ NoteListResponse (callId req) nList
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        GetBalance ->
          case parameters req of
            BalanceParams i -> do
              let dbPath = w_dbPath state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              acc <- liftIO $ getAccountById pool $ toSqlKey i
              case acc of
                Just acc' -> do
                  if zcashAccountType (entityVal acc') /= IncomingViewKey
                    then do
                      c <- liftIO $ getPoolBalance pool $ entityKey acc'
                      u <- liftIO $ getUnconfPoolBalance pool $ entityKey acc'
                      return $ BalanceResponse (callId req) c u
                    else return $ readOnlyError $ callId req
                Nothing ->
                  return $
                  ErrorResponse (callId req) (-32006) "Account does not exist."
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        GetNewWallet ->
          case parameters req of
            NameParams t -> do
              let dbPath = w_dbPath state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              syncChk <- liftIO $ isSyncing pool
              if syncChk
                then return $
                     ErrorResponse
                       (callId req)
                       (-32012)
                       "The Zenith server is syncing, please try again later."
                else do
                  sP <- liftIO generateWalletSeedPhrase
                  r <-
                    liftIO $
                    saveWallet pool $
                    ZcashWallet
                      t
                      (ZcashNetDB $ w_network state)
                      (PhraseDB sP)
                      (w_startBlock state)
                      0
                      True
                  case r of
                    Nothing ->
                      return $
                      ErrorResponse
                        (callId req)
                        (-32007)
                        "Entity with that name already exists."
                    Just r' ->
                      return $
                      NewItemResponse (callId req) $ fromSqlKey $ entityKey r'
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        GetNewAccount ->
          case parameters req of
            NameIdParams t i -> do
              let dbPath = w_dbPath state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              syncChk <- liftIO $ isSyncing pool
              if syncChk
                then return $
                     ErrorResponse
                       (callId req)
                       (-32012)
                       "The Zenith server is syncing, please try again later."
                else do
                  w <- liftIO $ walletExists pool i
                  case w of
                    Just w' -> do
                      aIdx <- liftIO $ getMaxAccount pool $ entityKey w'
                      if zcashWalletLocal $ entityVal w'
                        then do
                          nAcc <-
                            liftIO
                              (try $
                               createZcashAccount
                                 t
                                 (aIdx + 1)
                                 (getNet $ zcashWalletNetwork $ entityVal w')
                                 w' :: IO (Either IOError ZcashAccount))
                          case nAcc of
                            Left e ->
                              return $
                              ErrorResponse (callId req) (-32010) $
                              T.pack $ show e
                            Right nAcc' -> do
                              r <- liftIO $ saveAccount pool nAcc'
                              case r of
                                Nothing ->
                                  return $
                                  ErrorResponse
                                    (callId req)
                                    (-32007)
                                    "Entity with that name already exists."
                                Just x ->
                                  return $
                                  NewItemResponse (callId req) $
                                  fromSqlKey $ entityKey x
                        else return $ notLocalError $ callId req
                    Nothing ->
                      return $
                      ErrorResponse
                        (callId req)
                        (-32008)
                        "Wallet does not exist."
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        GetNewAddress ->
          case parameters req of
            NewAddrParams i n s t -> do
              let dbPath = w_dbPath state
              let net = w_network state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              syncChk <- liftIO $ isSyncing pool
              if syncChk
                then return $
                     ErrorResponse
                       (callId req)
                       (-32012)
                       "The Zenith server is syncing, please try again later."
                else do
                  acc <-
                    liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
                  case acc of
                    Just acc' -> do
                      maxAddr <-
                        liftIO $ getMaxAddress pool (entityKey acc') External
                      newAddr <-
                        liftIO $
                        createCustomWalletAddress
                          n
                          (maxAddr + 1)
                          net
                          External
                          acc'
                          s
                          t
                      dbAddr <- liftIO $ saveAddress pool newAddr
                      case dbAddr of
                        Just nAddr -> do
                          return $
                            NewAddrResponse
                              (callId req)
                              (toZcashAddressAPI nAddr)
                        Nothing ->
                          return $
                          ErrorResponse
                            (callId req)
                            (-32007)
                            "Entity with that name already exists."
                    Nothing ->
                      return $
                      ErrorResponse
                        (callId req)
                        (-32006)
                        "Account does not exist."
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        GetOperationStatus ->
          case parameters req of
            OpParams u -> do
              let dbPath = w_dbPath state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              op <- liftIO $ getOperation pool $ getUuid u
              case op of
                Just o -> do
                  return $ OpResponse (callId req) $ entityVal o
                Nothing ->
                  return $
                  ErrorResponse (callId req) (-32009) "Operation ID not found"
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        SendMany ->
          case parameters req of
            SendParams a ns p -> do
              let dbPath = w_dbPath state
              let zHost = w_host state
              let zPort = w_port state
              let znet = w_network state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              syncChk <- liftIO $ isSyncing pool
              if syncChk
                then return $
                     ErrorResponse
                       (callId req)
                       (-32012)
                       "The Zenith server is syncing, please try again later."
                else do
                  opid <- liftIO nextRandom
                  startTime <- liftIO getCurrentTime
                  opkey <-
                    liftIO $
                    saveOperation pool $
                    Operation
                      (ZenithUuid opid)
                      startTime
                      Nothing
                      Processing
                      Nothing
                  case opkey of
                    Nothing ->
                      return $
                      ErrorResponse (callId req) (-32010) "Internal Error"
                    Just opkey' -> do
                      acc <-
                        liftIO $ getAccountById pool $ toSqlKey $ fromIntegral a
                      case acc of
                        Just acc' -> do
                          if zcashAccountType (entityVal acc') == Local
                            then do
                              bl <-
                                liftIO $
                                getLastSyncBlock
                                  pool
                                  (zcashAccountWalletId $ entityVal acc')
                              _ <-
                                liftIO $
                                forkIO $ do
                                  res <-
                                    liftIO $
                                    runNoLoggingT $
                                    prepareTxV2
                                      pool
                                      zHost
                                      zPort
                                      znet
                                      (entityKey acc')
                                      bl
                                      ns
                                      p
                                  case res of
                                    Left e ->
                                      finalizeOperation pool opkey' Failed $
                                      T.pack $ show e
                                    Right rawTx -> do
                                      zebraRes <-
                                        makeZebraCall
                                          zHost
                                          zPort
                                          "sendrawtransaction"
                                          [Data.Aeson.String $ H.toText rawTx]
                                      case zebraRes of
                                        Left e1 ->
                                          finalizeOperation pool opkey' Failed $
                                          T.pack $ show e1
                                        Right txId ->
                                          finalizeOperation
                                            pool
                                            opkey'
                                            Successful $
                                          "Tx ID: " <> H.toText txId
                              return $ SendResponse (callId req) opid
                            else return $ readOnlyError $ callId req
                        Nothing ->
                          return $
                          ErrorResponse
                            (callId req)
                            (-32006)
                            "Account does not exist."
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        ShieldNotes -> do
          case parameters req of
            ShieldNotesParams i -> do
              let dbPath = w_dbPath state
              let net = w_network state
              let zHost = w_host state
              let zPort = w_port state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              syncChk <- liftIO $ isSyncing pool
              if syncChk
                then return $
                     ErrorResponse
                       (callId req)
                       (-32012)
                       "The Zenith server is syncing, please try again later."
                else do
                  acc <-
                    liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
                  case acc of
                    Just acc' -> do
                      bl <-
                        liftIO $
                        getLastSyncBlock
                          pool
                          (zcashAccountWalletId $ entityVal acc')
                      opids <-
                        liftIO $
                        runNoLoggingT $
                        shieldTransparentNotes
                          pool
                          zHost
                          zPort
                          net
                          (entityKey acc')
                          bl
                      let ops =
                            map
                              (\case
                                 Left e -> T.pack $ show e
                                 Right op -> U.toText op)
                              opids
                      return $ MultiOpResponse (callId req) ops
                    Nothing ->
                      return $
                      ErrorResponse
                        (callId req)
                        (-32006)
                        "Account does not exist."
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        DeshieldFunds -> do
          case parameters req of
            DeshieldParams i k -> do
              let dbPath = w_dbPath state
              let net = w_network state
              let zHost = w_host state
              let zPort = w_port state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              syncChk <- liftIO $ isSyncing pool
              if syncChk
                then return $
                     ErrorResponse
                       (callId req)
                       (-32012)
                       "The Zenith server is syncing, please try again later."
                else do
                  opid <- liftIO nextRandom
                  startTime <- liftIO getCurrentTime
                  opkey <-
                    liftIO $
                    saveOperation pool $
                    Operation
                      (ZenithUuid opid)
                      startTime
                      Nothing
                      Processing
                      Nothing
                  case opkey of
                    Nothing ->
                      return $
                      ErrorResponse (callId req) (-32010) "Internal Error"
                    Just opkey' -> do
                      acc <-
                        liftIO $ getAccountById pool $ toSqlKey $ fromIntegral i
                      case acc of
                        Just acc' -> do
                          bl <-
                            liftIO $
                            getLastSyncBlock
                              pool
                              (zcashAccountWalletId $ entityVal acc')
                          _ <-
                            liftIO $
                            forkIO $ do
                              res <-
                                runNoLoggingT $
                                deshieldNotes
                                  pool
                                  zHost
                                  zPort
                                  net
                                  (entityKey acc')
                                  bl
                                  k
                              case res of
                                Left e ->
                                  finalizeOperation pool opkey' Failed $
                                  T.pack $ show e
                                Right rawTx -> do
                                  zebraRes <-
                                    makeZebraCall
                                      zHost
                                      zPort
                                      "sendrawtransaction"
                                      [Data.Aeson.String $ H.toText rawTx]
                                  case zebraRes of
                                    Left e1 ->
                                      finalizeOperation pool opkey' Failed $
                                      T.pack $ show e1
                                    Right txId ->
                                      finalizeOperation pool opkey' Successful $
                                      "Tx ID: " <> H.toText txId
                          return $ SendResponse (callId req) opid
                        Nothing ->
                          return $
                          ErrorResponse
                            (callId req)
                            (-32006)
                            "Account does not exist."
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        GetFVK -> do
          case parameters req of
            ViewingKeyParams aid -> do
              let dbPath = w_dbPath state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral aid
              case acc of
                Just acc' -> do
                  case zcashAccountFvk (entityVal acc') of
                    Nothing ->
                      return $
                      ErrorResponse (callId req) (-32010) "Internal Error"
                    Just fvk ->
                      return $
                      ViewingKeyResponse
                        (callId req)
                        (encodeVK (FullVk $ getFvk fvk))
                Nothing ->
                  return $
                  ErrorResponse (callId req) (-32006) "Account does not exist."
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        GetIVK -> do
          case parameters req of
            ViewingKeyParams aid -> do
              let dbPath = w_dbPath state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              acc <- liftIO $ getAccountById pool $ toSqlKey $ fromIntegral aid
              case acc of
                Just acc' -> do
                  case zcashAccountIvk (entityVal acc') of
                    Nothing ->
                      return $
                      ErrorResponse (callId req) (-32010) "Internal Error"
                    Just ivk ->
                      return $
                      ViewingKeyResponse
                        (callId req)
                        (encodeVK $ IncomingVk $ getIvk ivk)
                Nothing ->
                  return $
                  ErrorResponse (callId req) (-32006) "Account does not exist."
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"
        ImportVK -> do
          case parameters req of
            ImportVkParams n k b -> do
              let dbPath = w_dbPath state
              let znet = w_network state
              pool <- liftIO $ runNoLoggingT $ initPool dbPath
              case parseVK k of
                Nothing -> return $ invalidVkError $ callId req
                Just vk -> do
                  res <- liftIO $ importViewingKey pool n znet vk b
                  case res of
                    Left e -> return $ ErrorResponse (callId req) (-32010) e
                    Right x -> return $ NewItemResponse (callId req) x
            _anyOtherParams ->
              return $ ErrorResponse (callId req) (-32602) "Invalid params"

authenticate :: Config -> BasicAuthCheck Bool
authenticate config = BasicAuthCheck check
  where
    check (BasicAuthData username password) =
      if username == c_zenithUser config && password == c_zenithPwd config
        then return $ Authorized True
        else return Unauthorized

packRpcResponse :: ToJSON a => T.Text -> a -> Value
packRpcResponse i x =
  object ["jsonrpc" .= ("2.0" :: String), "id" .= i, "result" .= x]

scanZebra :: T.Text -> T.Text -> Int -> ZcashNet -> IO ()
scanZebra dbPath zHost zPort net = do
  bStatus <- checkBlockChain zHost zPort
  pool <- runNoLoggingT $ initPool dbPath
  b <- getMinBirthdayHeight pool $ ZcashNetDB net
  dbBlock <- getMaxBlock pool $ ZcashNetDB net
  chkBlock <- checkIntegrity dbPath zHost zPort net dbBlock 1
  syncChk <- isSyncing pool
  unless syncChk $ do
    let sb =
          if chkBlock == dbBlock
            then max dbBlock b
            else max chkBlock b
    unless (chkBlock == dbBlock || chkBlock == 1) $
      runNoLoggingT $ rewindWalletData pool sb $ ZcashNetDB net
    unless (sb > zgb_blocks bStatus || sb < 1) $ do
      let bList = [(sb + 1) .. (zgb_blocks bStatus)]
      unless (null bList) $ do
        _ <- startSync pool
        mapM_ (processBlock pool) bList
        confUp <- try $ updateConfs zHost zPort pool :: IO (Either IOError ())
        case confUp of
          Left _e0 -> do
            _ <- completeSync pool Failed
            return ()
          Right _ -> do
            wals <- getWallets pool net
            _ <-
              runNoLoggingT $
              updateCommitmentTrees pool zHost zPort $ ZcashNetDB net
            runNoLoggingT $
              mapM_
                (syncWallet (Config dbPath zHost zPort "user" "pwd" 8080 "usd"))
                wals
            _ <- completeSync pool Successful
            return ()
  where
    processBlock :: ConnectionPool -> Int -> IO ()
    processBlock pool bl = do
      r <-
        makeZebraCall
          zHost
          zPort
          "getblock"
          [Data.Aeson.String $ T.pack (show bl), jsonNumber 1]
      case r of
        Left _ -> completeSync pool Failed
        Right blk -> do
          bi <-
            saveBlock pool $
            ZcashBlock
              (fromIntegral $ bl_height blk)
              (HexStringDB $ bl_hash blk)
              (fromIntegral $ bl_confirmations blk)
              (fromIntegral $ bl_time blk)
              (ZcashNetDB net)
          mapM_ (processTx zHost zPort bi pool) $ bl_txs blk

-- * Errors
invalidVkError :: T.Text -> ZenithResponse
invalidVkError i =
  ErrorResponse i (-32013) "The viewing key provided is not valid."

readOnlyError :: T.Text -> ZenithResponse
readOnlyError i =
  ErrorResponse i (-32014) "Read-only account, operation is not valid."

notLocalError :: T.Text -> ZenithResponse
notLocalError i =
  ErrorResponse
    i
    (-32015)
    "The wallet is not local, cannot create new accounts."
