Implement basic auth on server

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)

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