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 Data.Aeson
import qualified Data.Text as T
import Data.Typeable
import GHC.Generics (Generic)
import Servant
import ZcashHaskell.Types (RpcError(..), RpcResponse(..))
import Zenith.Types
  ( Config(..)
  , RpcCall(..)
  , ZenithMethod(..)
  , ZenithParams(..)
  )

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

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 (RpcResponse Value)
    handleRPC isAuth req =
      case method req of
        UnknownMethod ->
          return $
          MakeRpcResponse
            (Just $ RpcError (-32601) "Method not found")
            (callId req)
            Nothing
        GetInfo ->
          case parameters req of
            BlankParams ->
              return $
              MakeRpcResponse
                Nothing
                (callId req)
                (Just $ object ["data" .= ("Here's your info" :: String)])
            _anyOtherParams ->
              return $
              MakeRpcResponse
                (Just $ RpcError (-32602) "Invalid params")
                (callId req)
                Nothing
        Test ->
          case parameters req of
            TestParams x ->
              return $
              MakeRpcResponse Nothing (callId req) (Just $ object ["data" .= x])
            _anyOtherParams ->
              return $
              MakeRpcResponse
                (Just $ RpcError (-32602) "Invalid params")
                (callId req)
                Nothing

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