Implement basic auth on server

This commit is contained in:
Rene Vergara 2024-07-24 16:03:49 -05:00
parent b66d0d9563
commit cbcf7c9c8c
Signed by: pitmutt
GPG key ID: 65122AD495A7F5B2
2 changed files with 50 additions and 7 deletions

View file

@ -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)

View file

@ -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