add support for jwt authorization (close #186)

server/graphql-engine.cabal

@@ -51,6 +51,7 @@ library
                      , wai-extra
                      , containers
                      , monad-control
+                     , monad-time
                      , wai-logger
                      , fast-logger
                      , wai
@@ -67,6 +68,12 @@ library
 
                      -- hashing for logging
                      , cryptonite
+                     -- for jwt verification
+                     , jose
+                     , pem
+                     , x509
+                     , asn1-encoding
+                     , asn1-types
 
                      -- Server related
                      , warp
@@ -123,6 +130,7 @@ library
 
   exposed-modules:     Hasura.Server.App
                      , Hasura.Server.Auth
+                     , Hasura.Server.Auth.JWT
                      , Hasura.Server.Init
                      , Hasura.Server.Middleware
                      , Hasura.Server.Logging

server/src-exec/Main.hs

@@ -16,6 +16,7 @@ import qualified Data.ByteString.Char8      as BC
 import qualified Data.ByteString.Lazy       as BL
 import qualified Data.ByteString.Lazy.Char8 as BLC
 import qualified Data.Text                  as T
+import qualified Data.Text.Encoding         as TE
 import qualified Data.Yaml                  as Y
 import qualified Network.HTTP.Client        as HTTP
 import qualified Network.HTTP.Client.TLS    as HTTP
@@ -25,7 +26,8 @@ import           Hasura.Logging             (defaultLoggerSettings, mkLoggerCtx)
 import           Hasura.Prelude
 import           Hasura.RQL.DDL.Metadata    (fetchMetadata)
 import           Hasura.Server.App          (mkWaiApp)
-import           Hasura.Server.Auth         (AuthMode (..))
+import           Hasura.Server.Auth         (AccessKey (..), AuthMode (..),
+                                             Webhook (..))
 import           Hasura.Server.CheckUpdates (checkForUpdates)
 import           Hasura.Server.Init
 
@@ -45,7 +47,8 @@ data ServeOptions
   , soRootDir       :: !(Maybe String)
   , soAccessKey     :: !(Maybe AccessKey)
   , soCorsConfig    :: !CorsConfigFlags
-  , soWebHook       :: !(Maybe T.Text)
+  , soWebHook       :: !(Maybe Webhook)
+  , soJwtSecret     :: !(Maybe Text)
   , soEnableConsole :: !Bool
   } deriving (Show, Eq)
 
@@ -77,6 +80,7 @@ parseRavenMode = subparser
                 <*> parseAccessKey
                 <*> parseCorsConfig
                 <*> parseWebHook
+                <*> parseJwtSecret
                 <*> parseEnableConsole
 
 parseArgs :: IO RavenOptions
@@ -93,15 +97,27 @@ printJSON = BLC.putStrLn . A.encode
 printYaml :: (A.ToJSON a) => a -> IO ()
 printYaml = BC.putStrLn . Y.encode
 
-mkAuthMode :: Maybe AccessKey -> Maybe T.Text -> Either String AuthMode
-mkAuthMode mAccessKey mWebHook =
-  case (mAccessKey, mWebHook) of
-    (Nothing, Nothing)    -> return AMNoAuth
-    (Just key, Nothing)   -> return $ AMAccessKey key
-    (Nothing, Just _)     -> throwError $
+mkAuthMode :: Maybe AccessKey -> Maybe Webhook -> Maybe T.Text -> Either String AuthMode
+mkAuthMode mAccessKey mWebHook mJwtSecret =
+  case (mAccessKey, mWebHook, mJwtSecret) of
+    (Nothing,  Nothing,   Nothing)     -> return AMNoAuth
+    (Just key, Nothing,   Nothing)     -> return $ AMAccessKey key
+    (Just key, Just hook, Nothing)     -> return $ AMAccessKeyAndHook key hook
+    (Just key, Nothing,   Just jwtConf) -> do
+      -- the JWT Conf as JSON string; try to parse it
+      config <- A.eitherDecodeStrict $ TE.encodeUtf8 jwtConf
+      return $ AMAccessKeyAndJWT key config
+
+    (Nothing, Just _, Nothing)     -> throwError $
       "Fatal Error : --auth-hook (HASURA_GRAPHQL_AUTH_HOOK)"
       ++ " requires --access-key (HASURA_GRAPHQL_ACCESS_KEY) to be set"
-    (Just key, Just hook) -> return $ AMAccessKeyAndHook key hook
+    (Nothing, Nothing, Just _)     -> throwError $
+      "Fatal Error : --jwt-secret (HASURA_GRAPHQL_JWT_SECRET)"
+      ++ " requires --access-key (HASURA_GRAPHQL_ACCESS_KEY) to be set"
+    (Nothing, Just _, Just _)     -> throwError
+      "Fatal Error: Both webhook and JWT mode cannot be enabled at the same time"
+    (Just _, Just _, Just _)     -> throwError
+      "Fatal Error: Both webhook and JWT mode cannot be enabled at the same time"
 
 main :: IO ()
 main =  do
@@ -113,12 +129,12 @@ main =  do
   loggerCtx <- mkLoggerCtx defaultLoggerSettings
   httpManager <- HTTP.newManager HTTP.tlsManagerSettings
   case ravenMode of
-    ROServe (ServeOptions port cp isoL mRootDir mAccessKey corsCfg mWebHook enableConsole) -> do
-
-      mFinalAccessKey <- considerEnv "HASURA_GRAPHQL_ACCESS_KEY" mAccessKey
-      mFinalWebHook <- considerEnv "HASURA_GRAPHQL_AUTH_HOOK" mWebHook
+    ROServe (ServeOptions port cp isoL mRootDir mAccessKey corsCfg mWebHook mJwtSecret enableConsole) -> do
+      mFinalAccessKey <- considerEnv "HASURA_GRAPHQL_ACCESS_KEY" $ getAccessKey <$> mAccessKey
+      mFinalWebHook   <- considerEnv "HASURA_GRAPHQL_AUTH_HOOK" $ getWebhook <$> mWebHook
+      mFinalJwtSecret <- considerEnv "HASURA_GRAPHQL_JWT_SECRET" mJwtSecret
       am <- either ((>> exitFailure) . putStrLn) return $
-        mkAuthMode mFinalAccessKey mFinalWebHook
+        mkAuthMode (AccessKey <$> mFinalAccessKey) (Webhook <$> mFinalWebHook) mFinalJwtSecret
       finalCorsDomain <- fromMaybe "*" <$> considerEnv "HASURA_GRAPHQL_CORS_DOMAIN" (ccDomain corsCfg)
       let finalCorsCfg =
             CorsConfigG finalCorsDomain $ ccDisabled corsCfg

server/src-lib/Hasura/RQL/Types/Error.hs

@@ -72,6 +72,11 @@ data Code
   -- Graphql error
   | NoTables
   | ValidationFailed
+  -- JWT Auth errors
+  | JWTRoleClaimMissing
+  | JWTInvalidClaims
+  | JWTInvalid
+  | JWTInvalidKey
   deriving (Eq)
 
 instance Show Code where
@@ -100,6 +105,10 @@ instance Show Code where
   show AlreadyInit         = "already-initialised"
   show NoTables            = "no-tables"
   show ValidationFailed    = "validation-failed"
+  show JWTRoleClaimMissing = "jwt-missing-role-claims"
+  show JWTInvalidClaims    = "jwt-invalid-claims"
+  show JWTInvalid          = "invalid-jwt"
+  show JWTInvalidKey       = "invalid-jwt-key"
 
 data QErr
   = QErr

server/src-lib/Hasura/Server/App.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
+
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TemplateHaskell       #-}
@@ -32,6 +33,7 @@ import qualified Hasura.GraphQL.Schema                  as GS
 import qualified Hasura.GraphQL.Transport.HTTP          as GH
 import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
 import qualified Hasura.GraphQL.Transport.WebSocket     as WS
+import qualified Hasura.Logging                         as L
 import qualified Network.Wai                            as Wai
 import qualified Network.Wai.Handler.WebSockets         as WS
 import qualified Network.WebSockets                     as WS
@@ -41,6 +43,7 @@ import           Hasura.RQL.DDL.Schema.Table
 --import           Hasura.RQL.DML.Explain
 import           Hasura.RQL.DML.QueryTemplate
 import           Hasura.RQL.Types
+import           Hasura.Server.Auth                     (AuthMode, getUserInfo)
 import           Hasura.Server.Init
 import           Hasura.Server.Logging
 import           Hasura.Server.Middleware               (corsMiddleware,
@@ -50,8 +53,6 @@ import           Hasura.Server.Utils
 import           Hasura.Server.Version
 import           Hasura.SQL.Types
 
-import qualified Hasura.Logging                         as L
-import           Hasura.Server.Auth                     (AuthMode, getUserInfo)
 
 
 consoleTmplt :: M.Template

server/src-lib/Hasura/Server/Auth.hs

@@ -9,42 +9,51 @@
 module Hasura.Server.Auth
   ( getUserInfo
   , AuthMode(..)
+  , AccessKey (..)
+  , Webhook (..)
+  , RawJWT
+  , JWTConfig (..)
+  , processJwt
   ) where
 
-import           Control.Exception        (try)
+import           Control.Exception      (try)
 import           Control.Lens
 import           Data.Aeson
-import           Data.CaseInsensitive     (CI (..), original)
-
-import qualified Data.ByteString          as B
-import qualified Data.ByteString.Lazy     as BL
-import qualified Data.HashMap.Strict      as M
-import qualified Data.Text                as T
-import qualified Data.Text.Encoding       as TE
-import qualified Data.Text.Encoding.Error as TE
-import qualified Network.HTTP.Client      as H
-import qualified Network.HTTP.Types       as N
-import qualified Network.Wreq             as Wreq
+import           Data.CaseInsensitive   (CI (..), original)
+
+import qualified Data.ByteString.Lazy   as BL
+import qualified Data.HashMap.Strict    as M
+import qualified Data.Text              as T
+import qualified Network.HTTP.Client    as H
+import qualified Network.HTTP.Types     as N
+import qualified Network.Wreq           as Wreq
 
 import           Hasura.Prelude
 import           Hasura.RQL.Types
+import           Hasura.Server.Auth.JWT
 import           Hasura.Server.Logging
+import           Hasura.Server.Utils
+
+import qualified Hasura.Logging         as L
 
-import qualified Hasura.Logging           as L
 
-bsToTxt :: B.ByteString -> T.Text
-bsToTxt = TE.decodeUtf8With TE.lenientDecode
+newtype AccessKey
+  = AccessKey { getAccessKey :: T.Text }
+  deriving (Show, Eq)
+
+newtype Webhook
+  = Webhook {getWebhook :: T.Text}
+  deriving (Show, Eq)
 
 data AuthMode
   = AMNoAuth
-  | AMAccessKey !T.Text
-  | AMAccessKeyAndHook !T.Text !T.Text
+  | AMAccessKey !AccessKey
+  | AMAccessKeyAndHook !AccessKey !Webhook
+  | AMAccessKeyAndJWT !AccessKey !JWTConfig
   deriving (Show, Eq)
 
 type WebHookLogger = WebHookLog -> IO ()
 
-userRoleHeader :: T.Text
-userRoleHeader = "x-hasura-role"
 
 mkUserInfoFromResp
   :: (MonadIO m, MonadError QErr m)
@@ -90,16 +99,17 @@ userInfoFromWebhook
   :: (MonadIO m, MonadError QErr m)
   => WebHookLogger
   -> H.Manager
-  -> T.Text
+  -> Webhook
   -> [N.Header]
   -> m UserInfo
-userInfoFromWebhook logger manager urlT reqHeaders = do
+userInfoFromWebhook logger manager hook reqHeaders = do
   let options =
         Wreq.defaults
         & Wreq.headers .~ filteredHeaders
         & Wreq.checkResponse ?~ (\_ _ -> return ())
         & Wreq.manager .~ Right manager
 
+      urlT = getWebhook hook
   res <- liftIO $ try $ Wreq.getWith options $ T.unpack urlT
   resp <- either logAndThrow return res
   let status = resp ^. Wreq.responseStatus
@@ -108,6 +118,7 @@ userInfoFromWebhook logger manager urlT reqHeaders = do
   mkUserInfoFromResp logger urlT status respBody
   where
     logAndThrow err = do
+      let urlT = getWebhook hook
       liftIO $ logger $ WebHookLog L.LevelError Nothing urlT (Just err) Nothing
       throw500 "Internal Server Error"
 
@@ -118,8 +129,6 @@ userInfoFromWebhook logger manager urlT reqHeaders = do
                   , "Cache-Control", "Connection", "DNT"
                   ]
 
-accessKeyHeader :: T.Text
-accessKeyHeader = "x-hasura-access-key"
 
 getUserInfo
   :: (MonadIO m, MonadError QErr m)
@@ -135,15 +144,19 @@ getUserInfo logger manager rawHeaders = \case
   AMAccessKey accKey ->
     case getHeader accessKeyHeader of
       Just givenAccKey -> userInfoWhenAccessKey accKey givenAccKey
-      Nothing -> throw401 "x-hasura-access-key required, but not found"
+      Nothing -> throw401 $ accessKeyHeader <> " required, but not found"
 
   AMAccessKeyAndHook accKey hook ->
-    maybe
-      (userInfoFromWebhook logger manager hook rawHeaders)
-      (userInfoWhenAccessKey accKey) $
-      getHeader accessKeyHeader
+    whenAccessKeyAbsent accKey (userInfoFromWebhook logger manager hook rawHeaders)
+
+  AMAccessKeyAndJWT accKey jwtSecret ->
+    whenAccessKeyAbsent accKey (processJwt jwtSecret rawHeaders)
 
   where
+    -- when access key is absent, run the action to retrieve UserInfo, otherwise
+    -- accesskey override
+    whenAccessKeyAbsent ak action =
+      maybe action (userInfoWhenAccessKey ak) $ getHeader accessKeyHeader
 
     headers =
       M.fromList $ filter (T.isPrefixOf "x-hasura-" . fst) $
@@ -154,10 +167,10 @@ getUserInfo logger manager rawHeaders = \case
     getHeader h = M.lookup h headers
 
     userInfoFromHeaders =
-      case M.lookup "x-hasura-role" headers of
+      case M.lookup userRoleHeader headers of
         Just v  -> UserInfo (RoleName v) headers
         Nothing -> UserInfo adminRole M.empty
 
     userInfoWhenAccessKey key reqKey = do
-      when (reqKey /= key) $ throw401 "invalid x-hasura-access-key"
+      when (reqKey /= getAccessKey key) $ throw401 $ "invalid " <> accessKeyHeader
       return userInfoFromHeaders