Milestone 3: RPC server, ZIP-320 #104
2 changed files with 50 additions and 7 deletions
|
@ -1,8 +1,23 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module Server where
|
module Server where
|
||||||
|
|
||||||
|
import Data.Configurator
|
||||||
import Network.Wai.Handler.Warp (run)
|
import Network.Wai.Handler.Warp (run)
|
||||||
import Servant
|
import Servant
|
||||||
import Zenith.RPC (ZenithRPC(..), zenithServer)
|
import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer)
|
||||||
|
import Zenith.Types (Config(..))
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = run 8081 (serve (Proxy :: Proxy ZenithRPC) zenithServer)
|
main = do
|
||||||
|
config <- load ["$(HOME)/Zenith/zenith.cfg"]
|
||||||
|
dbFilePath <- require config "dbFilePath"
|
||||||
|
nodeUser <- require config "nodeUser"
|
||||||
|
nodePwd <- require config "nodePwd"
|
||||||
|
zebraPort <- require config "zebraPort"
|
||||||
|
zebraHost <- require config "zebraHost"
|
||||||
|
nodePort <- require config "nodePort"
|
||||||
|
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
|
||||||
|
let ctx = authenticate myConfig :. EmptyContext
|
||||||
|
run 8081 $
|
||||||
|
serveWithContext (Proxy :: Proxy ZenithRPC) ctx (zenithServer myConfig)
|
||||||
|
|
|
@ -1,22 +1,36 @@
|
||||||
{-# LANGUAGE TypeOperators #-}
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DataKinds #-}
|
{-# LANGUAGE DataKinds #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
|
||||||
module Zenith.RPC where
|
module Zenith.RPC where
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
import Data.Typeable
|
||||||
|
import GHC.Generics (Generic)
|
||||||
import Servant
|
import Servant
|
||||||
import ZcashHaskell.Types (RpcError(..), RpcResponse(..))
|
import ZcashHaskell.Types (RpcError(..), RpcResponse(..))
|
||||||
import Zenith.Types (RpcCall(..), ZenithMethod(..), ZenithParams(..))
|
import Zenith.Types
|
||||||
|
( Config(..)
|
||||||
|
, RpcCall(..)
|
||||||
|
, ZenithMethod(..)
|
||||||
|
, ZenithParams(..)
|
||||||
|
)
|
||||||
|
|
||||||
type ZenithRPC
|
type ZenithRPC
|
||||||
= "getinfo" :> Get '[ JSON] Value :<|> ReqBody '[ JSON] RpcCall :> Post
|
= "status" :> Get '[ JSON] Value :<|> ReqBody '[ JSON] RpcCall :> Post
|
||||||
'[ JSON]
|
'[ JSON]
|
||||||
(RpcResponse Value)
|
(RpcResponse Value)
|
||||||
|
|
||||||
zenithServer :: Server ZenithRPC
|
zenithServer :: Config -> Server ZenithRPC
|
||||||
zenithServer = getinfo :<|> handleRPC
|
zenithServer config = getinfo :<|> handleRPC
|
||||||
where
|
where
|
||||||
getinfo :: Handler Value
|
getinfo :: Handler Value
|
||||||
getinfo =
|
getinfo =
|
||||||
|
@ -28,9 +42,15 @@ zenithServer = getinfo :<|> handleRPC
|
||||||
handleRPC :: RpcCall -> Handler (RpcResponse Value)
|
handleRPC :: RpcCall -> Handler (RpcResponse Value)
|
||||||
handleRPC req =
|
handleRPC req =
|
||||||
case method req of
|
case method req of
|
||||||
|
UnknownMethod ->
|
||||||
|
return $
|
||||||
|
MakeRpcResponse
|
||||||
|
(Just $ RpcError (-32601) "Method not found")
|
||||||
|
(callId req)
|
||||||
|
Nothing
|
||||||
GetInfo ->
|
GetInfo ->
|
||||||
case parameters req of
|
case parameters req of
|
||||||
GetInfoParams ->
|
BlankParams ->
|
||||||
return $
|
return $
|
||||||
MakeRpcResponse
|
MakeRpcResponse
|
||||||
Nothing
|
Nothing
|
||||||
|
@ -53,3 +73,11 @@ zenithServer = getinfo :<|> handleRPC
|
||||||
(Just $ RpcError (-32602) "Invalid params")
|
(Just $ RpcError (-32602) "Invalid params")
|
||||||
(callId req)
|
(callId req)
|
||||||
Nothing
|
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
|
||||||
|
|
Loading…
Reference in a new issue