diff --git a/app/Server.hs b/app/Server.hs index b95527b..95e9458 100644 --- a/app/Server.hs +++ b/app/Server.hs @@ -1,8 +1,23 @@ +{-# LANGUAGE OverloadedStrings #-} + module Server where +import Data.Configurator import Network.Wai.Handler.Warp (run) import Servant -import Zenith.RPC (ZenithRPC(..), zenithServer) +import Zenith.RPC (ZenithRPC(..), authenticate, zenithServer) +import Zenith.Types (Config(..)) 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) diff --git a/src/Zenith/RPC.hs b/src/Zenith/RPC.hs index 7db5337..f2b4bf7 100644 --- a/src/Zenith/RPC.hs +++ b/src/Zenith/RPC.hs @@ -1,22 +1,36 @@ {-# 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 (RpcCall(..), ZenithMethod(..), ZenithParams(..)) +import Zenith.Types + ( Config(..) + , RpcCall(..) + , ZenithMethod(..) + , ZenithParams(..) + ) type ZenithRPC - = "getinfo" :> Get '[ JSON] Value :<|> ReqBody '[ JSON] RpcCall :> Post + = "status" :> Get '[ JSON] Value :<|> ReqBody '[ JSON] RpcCall :> Post '[ JSON] (RpcResponse Value) -zenithServer :: Server ZenithRPC -zenithServer = getinfo :<|> handleRPC +zenithServer :: Config -> Server ZenithRPC +zenithServer config = getinfo :<|> handleRPC where getinfo :: Handler Value getinfo = @@ -28,9 +42,15 @@ zenithServer = getinfo :<|> handleRPC handleRPC :: RpcCall -> Handler (RpcResponse Value) handleRPC req = case method req of + UnknownMethod -> + return $ + MakeRpcResponse + (Just $ RpcError (-32601) "Method not found") + (callId req) + Nothing GetInfo -> case parameters req of - GetInfoParams -> + BlankParams -> return $ MakeRpcResponse Nothing @@ -53,3 +73,11 @@ zenithServer = getinfo :<|> handleRPC (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