zenith/src/Zenith/RPC.hs

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

module Zenith.RPC where

import Control.Exception (try)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson
import qualified Data.Text as T
import Servant
import ZcashHaskell.Types (ZebraGetBlockChainInfo(..), ZebraGetInfo(..))
import Zenith.Core (checkBlockChain, checkZebra)
import Zenith.Types
  ( Config(..)
  , RpcCall(..)
  , ZenithInfo(..)
  , ZenithMethod(..)
  , ZenithParams(..)
  , ZenithResponse(..)
  )

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

zenithServer :: Config -> Server ZenithRPC
zenithServer config = getinfo :<|> handleRPC
  where
    getinfo :: Handler Value
    getinfo =
      return $
      object
        [ "version" .= ("0.7.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"
        GetInfo ->
          case parameters req of
            BlankParams -> do
              let host = c_zebraHost config
              let port = c_zebraPort config
              zInfo <-
                liftIO $ try $ checkZebra host port :: Handler
                  (Either IOError ZebraGetInfo)
              case zInfo of
                Left e ->
                  return $
                  ErrorResponse (callId req) (-32000) "Zebra not available"
                Right zI -> do
                  bInfo <-
                    liftIO $ try $ checkBlockChain host port :: Handler
                      (Either IOError ZebraGetBlockChainInfo)
                  case bInfo of
                    Left e1 ->
                      return $
                      ErrorResponse (callId req) (-32000) "Zebra not available"
                    Right bI ->
                      return $
                      InfoResponse
                        (callId req)
                        (ZenithInfo "0.7.0.0-beta" (zgb_net bI) (zgi_build zI))
            _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