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