mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-14 17:02:49 +03:00
JWT config now takes an optional jwk_url parameter (which points to published JWK Set). This is useful for providers who rotate their JWK Set. Optional jwk_url parameter is taken. The published JWK set under that URL should be in standard JWK format (tools.ietf.org/html/rfc7517#section-4.8). If the response contains an Expires header, the JWK set is automatically refreshed.
This commit is contained in:
Anon Ray
Shahidh K Muhammed
parent
4e2ab8ad79
commit
75090d51b9
@ -37,7 +37,7 @@ TL;DR
|
||||
3. You can send ``x-hasura-role`` as header in the request to indicate a
|
||||
different role.
|
||||
4. Send the JWT via ``Authorization: Bearer <JWT>`` header.
|
||||
|
||||
|
||||
|
||||
The Spec
|
||||
--------
|
||||
@ -113,10 +113,12 @@ The JSON is:
|
||||
|
||||
{
|
||||
"type": "<standard-JWT-algorithms>",
|
||||
"key": "<the-key>",
|
||||
"key": "<optional-key-as-string>",
|
||||
"jwk_url": "<optional-url-to-refresh-jwks>",
|
||||
"claims_namespace": "<optional-key-name-in-claims>"
|
||||
}
|
||||
|
||||
``key`` or ``jwk_url``, either of them has to be present.
|
||||
|
||||
``type``
|
||||
^^^^^^^^
|
||||
@ -130,10 +132,36 @@ public keys are not yet supported.
|
||||
|
||||
``key``
|
||||
^^^^^^^
|
||||
- Incase of symmetric key (i.e HMAC based key), the key as it is. (e.g -
|
||||
"abcdef...")
|
||||
- Incase of asymmetric keys (RSA etc.), only the public key, in a PEM encoded
|
||||
string or as a X509 certificate.
|
||||
|
||||
- Incase of symmetric key, the key as it is. (HMAC based keys).
|
||||
- Incase of asymmetric keys, only the public key, in a PEM encoded string or as
|
||||
a X509 certificate.
|
||||
This is an optional field. You can also provide a URL to fetch JWKs from using
|
||||
the ``jwk_url`` field.
|
||||
|
||||
``jwk_url``
|
||||
^^^^^^^^^^^
|
||||
A URL where a provider publishes their JWKs (which are used for signing the
|
||||
JWTs). The URL **must** publish the JWKs in the standard format as described in
|
||||
https://tools.ietf.org/html/rfc7517
|
||||
|
||||
This is an optional field. You can also provide the key (certificate, PEM
|
||||
encoded public key) as string as well - under the ``key`` field.
|
||||
|
||||
**Rotating JWKs**:
|
||||
|
||||
Some provider rotates their JWKs (like Firebase). If the provider sends an
|
||||
``Expires`` header with the response of JWK, then graphql-engine will refresh
|
||||
the JWKs automatically. If the provider does not send ``Expires`` header, the
|
||||
JWKs are not refreshed.
|
||||
|
||||
**Example**:
|
||||
|
||||
- Auth0 publishes their JWK url at: ``https://<YOUR_AUTH0_DOMAIN>.auth0.com``.
|
||||
But Auth0 has a bug. See known issues: :ref:`auth0-issues`.
|
||||
- Firebase publishes their JWK url at:
|
||||
``https://www.googleapis.com/service_accounts/v1/jwk/securetoken@system.gserviceaccount.com``
|
||||
|
||||
``claims_namespace``
|
||||
^^^^^^^^^^^^^^^^^^^^
|
||||
@ -156,14 +184,15 @@ Your auth server is using HMAC-SHA alogrithms to sign JWTs, and is using a
|
||||
"type":"HS256",
|
||||
"key": "3EK6FD+o0+c7tzBNVfjpMkNDi2yARAAKzQlk8O2IKoxQu4nF7EdAh8s3TwpHwrdWT6R"
|
||||
}
|
||||
|
||||
|
||||
The ``key`` is the actual shared secret. Which is used by your auth server as well.
|
||||
|
||||
RSA based
|
||||
+++++++++
|
||||
Let's say your auth server is using RSA to sign JWTs, and is using a 512-bit
|
||||
key. Then, the JWT config needs to have the only the public key, in PEM format
|
||||
(not OpenSSH format):
|
||||
If your auth server is using RSA to sign JWTs, and is using a 512-bit key. Then,
|
||||
the JWT config needs to have the only the public key.
|
||||
|
||||
**Example 1**: public key in PEM format (not OpenSSH format):
|
||||
|
||||
.. code-block:: json
|
||||
|
||||
@ -172,6 +201,25 @@ key. Then, the JWT config needs to have the only the public key, in PEM format
|
||||
"key": "-----BEGIN PUBLIC KEY-----\nMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQDdlatRjRjogo3WojgGHFHYLugd\nUWAY9iR3fy4arWNA1KoS8kVw33cJibXr8bvwUAUparCwlvdbH6dvEOfou0/gCFQs\nHUfQrSDv+MuSUMAe8jzKE4qW+jK+xQU9a03GUnKHkkle+Q0pX/g6jXZ7r1/xAK5D\no2kQ+X5xK9cipRgEKwIDAQAB\n-----END PUBLIC KEY-----\n"
|
||||
}
|
||||
|
||||
**Example 2**: public key as X509 certificate:
|
||||
|
||||
.. code-block:: json
|
||||
|
||||
{
|
||||
"type":"RS512",
|
||||
"key": "-----BEGIN CERTIFICATE-----\nMIIDHDCCAgSgAwIBAgIINw9gva8BPPIwDQYJKoZIhvcNAQEFBQAwMTEvMC0GA1UE\nAxMmc2VjdXJldG9rZW4uc3lzdGVtLmdzZXJ2aWNlYWNjb3VudC5jb20wHhcNMTgQt7dIsMTIU9k1SUrFviZOGnmHWtIAw\nmtYBcM9I0f9/ka45JIRp5Y1NKpAMFSShs7Wv0m1JS1kXQHdJsPSmjmDKcwnBe3R/\nTU3foRRywR/3AJRM15FNjTqvUm7TeaW16LkkRoECAwEAAaM4MDYwDAYDVR0TAQH/\nBAIwADAOBgNVHQ8BAf8EBAMCB4AwFgYDVR0lAQH/BAwwCgYIKwYBBQUHAwIwDQYJ\nKoZIhvcNAQEFBQADggEBADfY2DEmc2gb8/pqMNWHYq/nTYfJPpK4VA9A0lFTNeoq\nzmnbGwhKj24X+Nw8trsvkrKxHvCI1alDgBaCyzjGGvgOrh8X0wLtymp1yj6PWwee\nR2ZPdUaB62TCzO0iRv7W6o39ey+mU/FyYRtxF0ecxG2a0KNsIyFkciXUAeC5UVDo\nBNp678/SDDx9Ltuxc6h56a/hpBGf9Yzhr0RvYy3DmjBs6eopiGFmjnOKNxQrZ5t2\n339JWR+yiGEAtoHqk/fINMf1An6Rung1xYowrm4guhCIVi5unAvQ89fq0I6mzPg6\nLhTpeP0o+mVYrBmtYVpDpv0e71cfYowSJCCkod/9YbY=\n-----END CERTIFICATE-----"
|
||||
}
|
||||
|
||||
**Example 3**: public key published as JWKs:
|
||||
|
||||
.. code-block:: json
|
||||
|
||||
{
|
||||
"type":"RS512",
|
||||
"jwk_url": "https://www.googleapis.com/service_accounts/v1/jwk/securetoken@system.gserviceaccount.com"
|
||||
}
|
||||
|
||||
|
||||
Running with JWT
|
||||
^^^^^^^^^^^^^^^^
|
||||
Using the flag:
|
||||
@ -197,3 +245,73 @@ Using env vars:
|
||||
graphql-engine \
|
||||
--database-url postgres://username:password@hostname:port/dbname \
|
||||
serve
|
||||
|
||||
|
||||
Well known providers and known issues
|
||||
-------------------------------------
|
||||
|
||||
Firebase
|
||||
^^^^^^^^
|
||||
This page of Firebase `docs <https://firebase.google.com/docs/auth/admin/verify-id-tokens#verify_id_tokens_using_a_third-party_jwt_library>`_
|
||||
mentions that JWKs are published under:
|
||||
|
||||
https://www.googleapis.com/robot/v1/metadata/x509/securetoken@system.gserviceaccount.com .
|
||||
|
||||
But that is a non-standard format. Firebase also publishes the same certificates
|
||||
as proper JWK format under:
|
||||
|
||||
https://www.googleapis.com/service_accounts/v1/jwk/securetoken@system.gserviceaccount.com
|
||||
|
||||
If you are using Firebase and Hasura, use this config:
|
||||
|
||||
.. code-block:: json
|
||||
|
||||
{
|
||||
"type":"RS512",
|
||||
"jwk_url": "https://www.googleapis.com/service_accounts/v1/jwk/securetoken@system.gserviceaccount.com"
|
||||
}
|
||||
|
||||
|
||||
.. _auth0-issues:
|
||||
|
||||
Auth0
|
||||
^^^^^
|
||||
Auth0 publishes their JWK under:
|
||||
|
||||
``https://<your-auth0-domain>.auth0.com/.well-known/jwks.json``
|
||||
|
||||
But they have a `bug where the certificate thumbprint does not match
|
||||
<https://community.auth0.com/t/certificate-thumbprint-is-longer-than-20-bytes/7794/3>`_.
|
||||
Hence, currently this URL does not work with Hasura.
|
||||
|
||||
Current workaround is - download the X590 certificate from:
|
||||
|
||||
``https://<your-auth0-domain>.auth0.com/pem``
|
||||
|
||||
And use it in the ``key`` field:
|
||||
|
||||
.. code-block:: json
|
||||
|
||||
{
|
||||
"type":"RS512",
|
||||
"key": "-----BEGIN CERTIFICATE-----
|
||||
MIIDDTCAfWgAwIBAgIJhNlZ11IDrxbMA0GCSqSIb3DQEBCwUAMCQxIjAgBgNV
|
||||
BAMTGXlc3QtaGdlLWp3C5ldS5hdXRoMC5jb20HhcNMTgwNzMwMTM1MjM1WhcN
|
||||
MzIwND3MTM1MjM1WjAkSIwIAYDVQQDExl0ZXNLWhnZS1qd3QuZXUuYXV0aDAu
|
||||
Y29tMIBIjANBgkqhkiGw0BAQEFAAOCAQ8AMIICgKCAQEA13CivdSkNzRnOnR5
|
||||
ZNiReD+AgbL7BWjRiw3RwjxRp5PYzvAGuj94yR6LRh3QybYtsMFbSg5J7fNq6
|
||||
Ld6yMpMrUu8CBOnYY456b/2jlf+Vp8vEQuKvPOOw8Ev6x7X3blcuXCELSwyL3
|
||||
AGHq9OP2RV6V6CIE863zzuYH5HDLzU35oMZqogJVRJM0+6besH6TnSTNiA7xi
|
||||
BAqFaiRNQRVi1CAUa0bkN1XRp4AFy7d63VldOsM+8QnCNHySdDr1XevVuq6DK
|
||||
LQyGexFy4niALgHV0Q7A+xP1c2G6rJomZmn4j1avnlBpU87E58JMrRHOCj+5m
|
||||
Xj22/QDAQABo0IwQDAPgNVHRMBAf8EBTADAQHMB0GA1UdDgQWBBT6FvNkuUgu
|
||||
tk3OYQi4lo5aOgwazAOgNVHQ8BAf8EBAMCAoQDQYJKoZIhvcNAQELBQADggEB
|
||||
ADCLj+L22pEKyqaIUlhUJh7DAiDSLafy0fw56CntzPhqiZVVRlhxeAKidkCLV
|
||||
r9IEbRuxUoXiQSezPqM//9xHegMp0f2VauVCFg7EpUanYwvqFqjy9LWgH+SBz
|
||||
4uroLSZ5g1EPsHtlArLChA90caTX4e7Z7Xlu8G2kHRJB5nC7ycdbMUvEWBMeI
|
||||
tn/pcbmZ3/vlgj4UTEnURe2UPmSJpxmPwXqBcvwdKHRMgFXhZxojWCi0z4ftf
|
||||
f8t8UJIcbEblnkYe7wzYy8tOXoMMHqGSisCdkp/866029rJsKbwd8rVIyKNC5
|
||||
frGYaw+0cxO6/WvSir0eA=
|
||||
-----END CERTIFICATE-----
|
||||
"
|
||||
}
|
||||
|
||||
@ -210,6 +210,10 @@ library
|
||||
, Ops
|
||||
, TH
|
||||
|
||||
other-modules: Hasura.Server.Auth.JWT.Internal
|
||||
, Hasura.Server.Auth.JWT.Logging
|
||||
|
||||
|
||||
if flag(developer)
|
||||
ghc-prof-options: -rtsopts -fprof-auto -fno-prof-count-entries
|
||||
|
||||
@ -238,6 +242,7 @@ executable graphql-engine
|
||||
, stm
|
||||
, wreq
|
||||
, connection
|
||||
, string-conversions
|
||||
|
||||
other-modules: Ops
|
||||
TH
|
||||
|
||||
@ -1,11 +1,13 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Ops
|
||||
|
||||
import Control.Monad.STM (atomically)
|
||||
import Data.IORef (newIORef)
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import Options.Applicative
|
||||
import System.Environment (lookupEnv)
|
||||
@ -16,20 +18,20 @@ import qualified Data.Aeson as A
|
||||
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.String.Conversions as CS
|
||||
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
|
||||
import qualified Network.Wai.Handler.Warp as Warp
|
||||
|
||||
import Hasura.Events.Lib
|
||||
import Hasura.Logging (defaultLoggerSettings, mkLoggerCtx)
|
||||
import Hasura.Logging (LoggerCtx, defaultLoggerSettings,
|
||||
mkLogger, mkLoggerCtx)
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.DDL.Metadata (fetchMetadata)
|
||||
import Hasura.Server.App (mkWaiApp)
|
||||
import Hasura.Server.Auth (AccessKey (..), AuthMode (..),
|
||||
Webhook (..))
|
||||
import Hasura.Server.Auth
|
||||
import Hasura.Server.CheckUpdates (checkForUpdates)
|
||||
import Hasura.Server.Init
|
||||
|
||||
@ -50,9 +52,9 @@ data ServeOptions
|
||||
, soTxIso :: !Q.TxIsolation
|
||||
, soRootDir :: !(Maybe String)
|
||||
, soAccessKey :: !(Maybe AccessKey)
|
||||
, soCorsConfig :: !CorsConfigFlags
|
||||
, soWebHook :: !(Maybe Webhook)
|
||||
, soJwtSecret :: !(Maybe Text)
|
||||
, soCorsConfig :: !CorsConfigFlags
|
||||
, soEnableConsole :: !Bool
|
||||
} deriving (Show, Eq)
|
||||
|
||||
@ -82,9 +84,9 @@ parseRavenMode = subparser
|
||||
<*> parseTxIsolation
|
||||
<*> parseRootDir
|
||||
<*> parseAccessKey
|
||||
<*> parseCorsConfig
|
||||
<*> parseWebHook
|
||||
<*> parseJwtSecret
|
||||
<*> parseCorsConfig
|
||||
<*> parseEnableConsole
|
||||
|
||||
parseArgs :: IO RavenOptions
|
||||
@ -101,28 +103,61 @@ printJSON = BLC.putStrLn . A.encode
|
||||
printYaml :: (A.ToJSON a) => a -> IO ()
|
||||
printYaml = BC.putStrLn . Y.encode
|
||||
|
||||
mkAuthMode :: Maybe AccessKey -> Maybe Webhook -> Maybe T.Text -> Either String AuthMode
|
||||
mkAuthMode mAccessKey mWebHook mJwtSecret =
|
||||
mkAuthMode
|
||||
:: ( MonadIO m
|
||||
, MonadError T.Text m
|
||||
)
|
||||
=> Maybe AccessKey
|
||||
-> Maybe Webhook
|
||||
-> Maybe T.Text
|
||||
-> HTTP.Manager
|
||||
-> LoggerCtx
|
||||
-> m AuthMode
|
||||
mkAuthMode mAccessKey mWebHook mJwtSecret httpManager lCtx =
|
||||
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, 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) ->
|
||||
AMAccessKeyAndJWT key <$> mkJwtCtx jwtConf httpManager lCtx
|
||||
|
||||
(Nothing, Just _, Nothing) -> throwError $
|
||||
"Fatal Error : --auth-hook (HASURA_GRAPHQL_AUTH_HOOK)"
|
||||
++ " requires --access-key (HASURA_GRAPHQL_ACCESS_KEY) to be set"
|
||||
<> " requires --access-key (HASURA_GRAPHQL_ACCESS_KEY) to be set"
|
||||
(Nothing, Nothing, Just _) -> throwError $
|
||||
"Fatal Error : --jwt-secret (HASURA_GRAPHQL_JWT_SECRET)"
|
||||
++ " requires --access-key (HASURA_GRAPHQL_ACCESS_KEY) to be set"
|
||||
<> " 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"
|
||||
|
||||
mkJwtCtx
|
||||
:: ( MonadIO m
|
||||
, MonadError T.Text m
|
||||
)
|
||||
=> T.Text
|
||||
-> HTTP.Manager
|
||||
-> LoggerCtx
|
||||
-> m JWTCtx
|
||||
mkJwtCtx jwtConf httpManager loggerCtx = do
|
||||
-- the JWT Conf as JSON string; try to parse it
|
||||
conf <- either decodeErr return $ A.eitherDecodeStrict $ CS.cs jwtConf
|
||||
jwkRef <- case jcKeyOrUrl conf of
|
||||
Left jwk -> liftIO $ newIORef (JWKSet [jwk])
|
||||
Right url -> do
|
||||
ref <- liftIO $ newIORef $ JWKSet []
|
||||
let logger = mkLogger loggerCtx
|
||||
mTime <- updateJwkRef logger httpManager url ref
|
||||
case mTime of
|
||||
Nothing -> return ref
|
||||
Just t -> do
|
||||
jwkRefreshCtrl logger httpManager url ref t
|
||||
return ref
|
||||
return $ JWTCtx jwkRef (jcClaimNs conf) (jcAudience conf)
|
||||
where
|
||||
decodeErr e = throwError . T.pack $ "Fatal Error: JWT conf: " <> e
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
(RavenOptions rci ravenMode) <- parseArgs
|
||||
@ -130,19 +165,26 @@ main = do
|
||||
ci <- either ((>> exitFailure) . putStrLn . connInfoErrModifier)
|
||||
return $ mkConnInfo mEnvDbUrl rci
|
||||
printConnInfo ci
|
||||
loggerCtx <- mkLoggerCtx $ defaultLoggerSettings True
|
||||
hloggerCtx <- mkLoggerCtx $ defaultLoggerSettings False
|
||||
loggerCtx <- mkLoggerCtx $ defaultLoggerSettings True
|
||||
hloggerCtx <- mkLoggerCtx $ defaultLoggerSettings False
|
||||
httpManager <- HTTP.newManager HTTP.tlsManagerSettings
|
||||
case ravenMode of
|
||||
ROServe (ServeOptions port cp isoL mRootDir mAccessKey corsCfg mWebHook mJwtSecret enableConsole) -> do
|
||||
ROServe (ServeOptions port cp isoL mRootDir mAccessKey mWebHook mJwtSecret
|
||||
corsCfg enableConsole) -> do
|
||||
|
||||
-- get all auth mode related config
|
||||
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 (AccessKey <$> mFinalAccessKey) (Webhook <$> mFinalWebHook) mFinalJwtSecret
|
||||
-- prepare auth mode
|
||||
authModeRes <- runExceptT $ mkAuthMode (AccessKey <$> mFinalAccessKey)
|
||||
(Webhook <$> mFinalWebHook)
|
||||
mFinalJwtSecret
|
||||
httpManager
|
||||
loggerCtx
|
||||
am <- either ((>> exitFailure) . putStrLn . T.unpack) return authModeRes
|
||||
finalCorsDomain <- fromMaybe "*" <$> considerEnv "HASURA_GRAPHQL_CORS_DOMAIN" (ccDomain corsCfg)
|
||||
let finalCorsCfg =
|
||||
CorsConfigG finalCorsDomain $ ccDisabled corsCfg
|
||||
let finalCorsCfg = CorsConfigG finalCorsDomain $ ccDisabled corsCfg
|
||||
initialise ci
|
||||
migrate ci
|
||||
prepareEvents ci
|
||||
|
||||
@ -126,7 +126,7 @@ data WSServerEnv
|
||||
}
|
||||
|
||||
onConn :: L.Logger -> WS.OnConnH WSConnData
|
||||
onConn logger wsId requestHead = do
|
||||
onConn (L.Logger logger) wsId requestHead = do
|
||||
res <- runExceptT checkPath
|
||||
either reject accept res
|
||||
where
|
||||
@ -196,7 +196,7 @@ onStart serverEnv wsConn msg@(StartMsg opId q) = catchAndSend $ do
|
||||
liftIO $ logger $ WSLog wsId $ EOperation opId ODCompleted
|
||||
|
||||
where
|
||||
(WSServerEnv logger _ runTx lqMap gCtxMapRef _) = serverEnv
|
||||
(WSServerEnv (L.Logger logger) _ runTx lqMap gCtxMapRef _) = serverEnv
|
||||
wsId = WS.getWSId wsConn
|
||||
(WSConnData userInfoR opMap) = WS.getData wsConn
|
||||
|
||||
@ -237,7 +237,7 @@ onMessage authMode serverEnv wsConn msgRaw =
|
||||
CMStop stopMsg -> onStop serverEnv wsConn stopMsg
|
||||
CMConnTerm -> WS.closeConn wsConn "GQL_CONNECTION_TERMINATE received"
|
||||
where
|
||||
logger = _wseLogger serverEnv
|
||||
logger = L.unLogger $ _wseLogger serverEnv
|
||||
|
||||
onStop :: WSServerEnv -> WSConn -> StopMsg -> IO ()
|
||||
onStop serverEnv wsConn (StopMsg opId) = do
|
||||
@ -250,7 +250,7 @@ onStop serverEnv wsConn (StopMsg opId) = do
|
||||
Nothing -> return ()
|
||||
STM.atomically $ STMMap.delete opId opMap
|
||||
where
|
||||
logger = _wseLogger serverEnv
|
||||
logger = L.unLogger $ _wseLogger serverEnv
|
||||
lqMap = _wseLiveQMap serverEnv
|
||||
wsId = WS.getWSId wsConn
|
||||
opMap = _wscOpMap $ WS.getData wsConn
|
||||
@ -258,7 +258,7 @@ onStop serverEnv wsConn (StopMsg opId) = do
|
||||
onConnInit
|
||||
:: (MonadIO m)
|
||||
=> L.Logger -> H.Manager -> WSConn -> AuthMode -> Maybe ConnParams -> m ()
|
||||
onConnInit logger manager wsConn authMode connParamsM = do
|
||||
onConnInit (L.Logger logger) manager wsConn authMode connParamsM = do
|
||||
res <- runExceptT $ getUserInfo logger manager headers authMode
|
||||
case res of
|
||||
Left e ->
|
||||
@ -281,7 +281,7 @@ onClose
|
||||
-> WS.ConnectionException
|
||||
-> WSConn
|
||||
-> IO ()
|
||||
onClose logger lqMap _ wsConn = do
|
||||
onClose (L.Logger logger) lqMap _ wsConn = do
|
||||
logger $ WSLog wsId EClosed
|
||||
operations <- STM.atomically $ ListT.toList $ STMMap.stream opMap
|
||||
void $ A.forConcurrently operations $ \(opId, liveQ) ->
|
||||
|
||||
@ -93,7 +93,7 @@ getWSId = _wcConnId
|
||||
|
||||
closeConn :: WSConn a -> BL.ByteString -> IO ()
|
||||
closeConn wsConn bs = do
|
||||
_wcLogger wsConn $ WSLog (_wcConnId wsConn) $ ECloseSent $ TBS.fromLBS bs
|
||||
(L.unLogger . _wcLogger) wsConn $ WSLog (_wcConnId wsConn) $ ECloseSent $ TBS.fromLBS bs
|
||||
WS.sendClose (_wcConnRaw wsConn) bs
|
||||
|
||||
-- writes to a queue instead of the raw connection
|
||||
@ -114,7 +114,7 @@ createWSServer :: L.Logger -> STM.STM (WSServer a)
|
||||
createWSServer logger = WSServer logger <$> STMMap.new
|
||||
|
||||
closeAll :: WSServer a -> BL.ByteString -> IO ()
|
||||
closeAll (WSServer writeLog connMap) msg = do
|
||||
closeAll (WSServer (L.Logger writeLog) connMap) msg = do
|
||||
writeLog $ L.debugT "closing all connections"
|
||||
conns <- STM.atomically $ do
|
||||
conns <- ListT.toList $ STMMap.stream connMap
|
||||
@ -141,7 +141,7 @@ createServerApp
|
||||
-> WSHandlers a
|
||||
-- aka WS.ServerApp
|
||||
-> WS.PendingConnection -> IO ()
|
||||
createServerApp (WSServer writeLog connMap) wsHandlers pendingConn = do
|
||||
createServerApp (WSServer logger@(L.Logger writeLog) connMap) wsHandlers pendingConn = do
|
||||
wsId <- WSId <$> UUID.nextRandom
|
||||
writeLog $ WSLog wsId EConnectionRequest
|
||||
let reqHead = WS.pendingRequest pendingConn
|
||||
@ -158,7 +158,7 @@ createServerApp (WSServer writeLog connMap) wsHandlers pendingConn = do
|
||||
writeLog $ WSLog wsId EAccepted
|
||||
|
||||
sendQ <- STM.newTQueueIO
|
||||
let wsConn = WSConn wsId writeLog conn sendQ a
|
||||
let wsConn = WSConn wsId logger conn sendQ a
|
||||
STM.atomically $ STMMap.insert wsConn wsId connMap
|
||||
|
||||
rcvRef <- A.async $ forever $ do
|
||||
|
||||
@ -13,7 +13,7 @@ module Hasura.Logging
|
||||
, debugT
|
||||
, debugBS
|
||||
, debugLBS
|
||||
, Logger
|
||||
, Logger (..)
|
||||
, LogLevel(..)
|
||||
, mkLogger
|
||||
, LoggerCtx(..)
|
||||
@ -135,10 +135,10 @@ cleanLoggerCtx :: LoggerCtx -> IO ()
|
||||
cleanLoggerCtx =
|
||||
FL.rmLoggerSet . _lcLoggerSet
|
||||
|
||||
type Logger = forall a. (ToEngineLog a) => a -> IO ()
|
||||
newtype Logger = Logger { unLogger :: forall a. (ToEngineLog a) => a -> IO () }
|
||||
|
||||
mkLogger :: LoggerCtx -> Logger
|
||||
mkLogger (LoggerCtx loggerSet serverLogLevel timeGetter) l = do
|
||||
mkLogger (LoggerCtx loggerSet serverLogLevel timeGetter) = Logger $ \l -> do
|
||||
localTime <- timeGetter
|
||||
let (logLevel, logTy, logDet) = toEngineLog l
|
||||
when (logLevel >= serverLogLevel) $
|
||||
|
||||
@ -129,7 +129,7 @@ logResult
|
||||
logResult req reqBody sc res qTime =
|
||||
liftIO $ logger $ mkAccessLog req (reqBody, res) qTime
|
||||
where
|
||||
logger = scLogger sc
|
||||
logger = L.unLogger $ scLogger sc
|
||||
|
||||
logError
|
||||
:: MonadIO m
|
||||
@ -163,7 +163,7 @@ mkSpockAction qErrEncoder serverCtx handler = do
|
||||
either (qErrToResp $ userRole userInfo == adminRole) resToResp result
|
||||
|
||||
where
|
||||
logger = scLogger serverCtx
|
||||
logger = L.unLogger $ scLogger serverCtx
|
||||
-- encode error response
|
||||
qErrToResp includeInternal qErr = do
|
||||
setStatus $ qeStatus qErr
|
||||
|
||||
@ -11,9 +11,14 @@ module Hasura.Server.Auth
|
||||
, AuthMode(..)
|
||||
, AccessKey (..)
|
||||
, Webhook (..)
|
||||
-- JWT related
|
||||
, RawJWT
|
||||
, JWTConfig (..)
|
||||
, JWTCtx (..)
|
||||
, JWKSet (..)
|
||||
, processJwt
|
||||
, updateJwkRef
|
||||
, jwkRefreshCtrl
|
||||
) where
|
||||
|
||||
import Control.Exception (try)
|
||||
@ -42,18 +47,16 @@ newtype AccessKey
|
||||
deriving (Show, Eq)
|
||||
|
||||
newtype Webhook
|
||||
= Webhook {getWebhook :: T.Text}
|
||||
= Webhook { getWebhook :: T.Text }
|
||||
deriving (Show, Eq)
|
||||
|
||||
data AuthMode
|
||||
= AMNoAuth
|
||||
| AMAccessKey !AccessKey
|
||||
| AMAccessKeyAndHook !AccessKey !Webhook
|
||||
| AMAccessKeyAndJWT !AccessKey !JWTConfig
|
||||
| AMAccessKeyAndJWT !AccessKey !JWTCtx
|
||||
deriving (Show, Eq)
|
||||
|
||||
type WebHookLogger = WebHookLog -> IO ()
|
||||
|
||||
|
||||
mkUserInfoFromResp
|
||||
:: (MonadIO m, MonadError QErr m)
|
||||
|
||||
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
@ -7,42 +8,67 @@ module Hasura.Server.Auth.JWT
|
||||
( processJwt
|
||||
, RawJWT
|
||||
, JWTConfig (..)
|
||||
, JWTCtx (..)
|
||||
, JWKSet (..)
|
||||
, updateJwkRef
|
||||
, jwkRefreshCtrl
|
||||
) where
|
||||
|
||||
import Control.Exception (try)
|
||||
import Control.Lens
|
||||
import Control.Monad (when)
|
||||
|
||||
import Crypto.JOSE.Types (Base64Integer (..))
|
||||
import Control.Monad (when)
|
||||
import Crypto.JWT
|
||||
import Crypto.PubKey.RSA (PublicKey (..))
|
||||
import Data.ASN1.BinaryEncoding (DER (..))
|
||||
import Data.ASN1.Encoding (decodeASN1')
|
||||
import Data.ASN1.Types (ASN1 (End, IntVal, Start),
|
||||
ASN1ConstructionType (Sequence),
|
||||
fromASN1)
|
||||
import Data.List (find)
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
import Data.IORef (IORef, modifyIORef, readIORef)
|
||||
|
||||
import Data.List (find)
|
||||
import Data.Time.Clock (NominalDiffTime, diffUTCTime,
|
||||
getCurrentTime)
|
||||
import Data.Time.Format (defaultTimeLocale, parseTimeM)
|
||||
|
||||
import Hasura.Logging (Logger (..))
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Utils (accessKeyHeader, bsToTxt,
|
||||
userRoleHeader)
|
||||
import Hasura.Server.Auth.JWT.Internal (parseHmacKey, parseRsaKey)
|
||||
import Hasura.Server.Auth.JWT.Logging
|
||||
import Hasura.Server.Utils (accessKeyHeader, bsToTxt,
|
||||
userRoleHeader)
|
||||
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Casing as A
|
||||
import qualified Data.Aeson.TH as A
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.ByteString.Lazy.Char8 as BLC
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.PEM as PEM
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as TE
|
||||
import qualified Data.X509 as X509
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Control.Concurrent as C
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.Aeson.Casing as A
|
||||
import qualified Data.Aeson.TH as A
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.ByteString.Lazy.Char8 as BLC
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.String.Conversions as CS
|
||||
import qualified Data.Text as T
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Network.URI as N
|
||||
import qualified Network.Wreq as Wreq
|
||||
|
||||
|
||||
type RawJWT = BL.ByteString
|
||||
newtype RawJWT = RawJWT BL.ByteString
|
||||
|
||||
data JWTConfig
|
||||
= JWTConfig
|
||||
{ jcType :: !T.Text
|
||||
, jcKeyOrUrl :: !(Either JWK N.URI)
|
||||
, jcClaimNs :: !(Maybe T.Text)
|
||||
, jcAudience :: !(Maybe T.Text)
|
||||
-- , jcIssuer :: !(Maybe T.Text)
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data JWTCtx
|
||||
= JWTCtx
|
||||
{ jcxKey :: !(IORef JWKSet)
|
||||
, jcxClaimNs :: !(Maybe T.Text)
|
||||
, jcxAudience :: !(Maybe T.Text)
|
||||
} deriving (Show, Eq)
|
||||
|
||||
instance Show (IORef JWKSet) where
|
||||
show _ = "<IORef JWKRef>"
|
||||
|
||||
data HasuraClaims
|
||||
= HasuraClaims
|
||||
@ -51,14 +77,6 @@ data HasuraClaims
|
||||
} deriving (Show, Eq)
|
||||
$(A.deriveJSON (A.aesonDrop 3 A.snakeCase) ''HasuraClaims)
|
||||
|
||||
-- | HGE's own representation of various JWKs
|
||||
data JWTConfig
|
||||
= JWTConfig
|
||||
{ jcType :: !T.Text
|
||||
, jcKey :: !JWK
|
||||
, jcClaimNs :: !(Maybe T.Text)
|
||||
} deriving (Show, Eq)
|
||||
|
||||
allowedRolesClaim :: T.Text
|
||||
allowedRolesClaim = "x-hasura-allowed-roles"
|
||||
|
||||
@ -68,21 +86,93 @@ defaultRoleClaim = "x-hasura-default-role"
|
||||
defaultClaimNs :: T.Text
|
||||
defaultClaimNs = "https://hasura.io/jwt/claims"
|
||||
|
||||
-- | create a background thread to refresh the JWK
|
||||
jwkRefreshCtrl
|
||||
:: (MonadIO m)
|
||||
=> Logger
|
||||
-> HTTP.Manager
|
||||
-> N.URI
|
||||
-> IORef JWKSet
|
||||
-> NominalDiffTime
|
||||
-> m ()
|
||||
jwkRefreshCtrl lggr mngr url ref time =
|
||||
void $ liftIO $ C.forkIO $ do
|
||||
C.threadDelay $ delay time
|
||||
forever $ do
|
||||
res <- runExceptT $ updateJwkRef lggr mngr url ref
|
||||
mTime <- either (const $ return Nothing) return res
|
||||
C.threadDelay $ maybe (60 * aSecond) delay mTime
|
||||
where
|
||||
delay t = (floor (realToFrac t :: Double) - 10) * aSecond
|
||||
aSecond = 1000 * 1000
|
||||
|
||||
|
||||
-- | Given a JWK url, fetch JWK from it and update the IORef
|
||||
updateJwkRef
|
||||
:: ( MonadIO m
|
||||
, MonadError T.Text m)
|
||||
=> Logger
|
||||
-> HTTP.Manager
|
||||
-> N.URI
|
||||
-> IORef JWKSet
|
||||
-> m (Maybe NominalDiffTime)
|
||||
updateJwkRef (Logger logger) manager url jwkRef = do
|
||||
let options = Wreq.defaults
|
||||
& Wreq.checkResponse ?~ (\_ _ -> return ())
|
||||
& Wreq.manager .~ Right manager
|
||||
|
||||
res <- liftIO $ try $ Wreq.getWith options $ show url
|
||||
resp <- either logAndThrowHttp return res
|
||||
let status = resp ^. Wreq.responseStatus
|
||||
respBody = resp ^. Wreq.responseBody
|
||||
|
||||
when (status ^. Wreq.statusCode /= 200) $ do
|
||||
let urlT = T.pack $ show url
|
||||
respBodyT = Just $ CS.cs respBody
|
||||
errMsg = "non-200 response on fetching JWK from: " <> urlT
|
||||
httpErr = Just (JwkRefreshHttpError (Just status) urlT Nothing respBodyT)
|
||||
logAndThrow errMsg httpErr
|
||||
|
||||
jwkset <- either (\e -> logAndThrow (T.pack e) Nothing) return . A.eitherDecode $ respBody
|
||||
liftIO $ modifyIORef jwkRef (const jwkset)
|
||||
|
||||
let mExpiresT = resp ^? Wreq.responseHeader "Expires"
|
||||
forM mExpiresT $ \expiresT -> do
|
||||
let expiresE = parseTimeM True defaultTimeLocale timeFmt $ CS.cs expiresT
|
||||
expires <- either (`logAndThrow` Nothing) return expiresE
|
||||
currTime <- liftIO getCurrentTime
|
||||
return $ diffUTCTime expires currTime
|
||||
|
||||
where
|
||||
logAndThrow :: (MonadIO m, MonadError T.Text m) => T.Text -> Maybe JwkRefreshHttpError -> m a
|
||||
logAndThrow err httpErr = do
|
||||
liftIO $ logger $ mkJwkRefreshLog err httpErr
|
||||
throwError err
|
||||
|
||||
logAndThrowHttp :: (MonadIO m, MonadError T.Text m) => HTTP.HttpException -> m a
|
||||
logAndThrowHttp err = do
|
||||
let httpErr = JwkRefreshHttpError Nothing (T.pack $ show url) (Just err) Nothing
|
||||
errMsg = "error fetching JWK: " <> T.pack (show err)
|
||||
logAndThrow errMsg (Just httpErr)
|
||||
|
||||
timeFmt = "%a, %d %b %Y %T GMT"
|
||||
|
||||
|
||||
-- | Process the request headers to verify the JWT and extract UserInfo from it
|
||||
processJwt
|
||||
:: ( MonadIO m
|
||||
, MonadError QErr m)
|
||||
=> JWTConfig
|
||||
=> JWTCtx
|
||||
-> HTTP.RequestHeaders
|
||||
-> m UserInfo
|
||||
processJwt conf headers = do
|
||||
processJwt jwtCtx headers = do
|
||||
-- try to parse JWT token from Authorization header
|
||||
jwt <- parseAuthzHeader
|
||||
|
||||
-- verify the JWT
|
||||
claims <- liftJWTError invalidJWTError $ verifyJwt (jcKey conf) jwt
|
||||
claims <- liftJWTError invalidJWTError $ verifyJwt jwtCtx $ RawJWT jwt
|
||||
|
||||
let claimsNs = fromMaybe defaultClaimNs $ jcClaimNs conf
|
||||
let claimsNs = fromMaybe defaultClaimNs $ jcxClaimNs jwtCtx
|
||||
|
||||
-- see if the hasura claims key exist in the claims map
|
||||
let mHasuraClaims = Map.lookup claimsNs $ claims ^. unregisteredClaims
|
||||
@ -127,7 +217,7 @@ processJwt conf headers = do
|
||||
|
||||
-- see if there is a x-hasura-role header, or else pick the default role
|
||||
getCurrentRole defaultRole =
|
||||
let userRoleHeaderB = TE.encodeUtf8 userRoleHeader
|
||||
let userRoleHeaderB = CS.cs userRoleHeader
|
||||
mUserRole = snd <$> find (\h -> fst h == CI.mk userRoleHeaderB) headers
|
||||
in maybe defaultRole (RoleName . bsToTxt) mUserRole
|
||||
|
||||
@ -150,7 +240,7 @@ processJwt conf headers = do
|
||||
currRoleNotAllowed =
|
||||
throw400 AccessDenied "Your current role is not in allowed roles"
|
||||
claimsNotFound = do
|
||||
let claimsNs = fromMaybe defaultClaimNs $ jcClaimNs conf
|
||||
let claimsNs = fromMaybe defaultClaimNs $ jcxClaimNs jwtCtx
|
||||
throw400 JWTInvalidClaims $ "claims key: '" <> claimsNs <> "' not found"
|
||||
|
||||
|
||||
@ -192,15 +282,16 @@ verifyJwt
|
||||
:: ( MonadError JWTError m
|
||||
, MonadIO m
|
||||
)
|
||||
=> JWK
|
||||
=> JWTCtx
|
||||
-> RawJWT
|
||||
-> m ClaimsSet
|
||||
verifyJwt key rawJWT = do
|
||||
jwt <- decodeCompact rawJWT -- decode JWT
|
||||
verifyJwt ctx (RawJWT rawJWT) = do
|
||||
key <- liftIO $ readIORef $ jcxKey ctx
|
||||
jwt <- decodeCompact rawJWT
|
||||
t <- liftIO getCurrentTime
|
||||
verifyClaimsAt config key t jwt
|
||||
where
|
||||
audCheck = const True -- we ignore the audience check?
|
||||
audCheck aud = maybe True (== (T.pack . show) aud) $ jcxAudience ctx
|
||||
config = defaultJWTValidationSettings audCheck
|
||||
|
||||
|
||||
@ -211,103 +302,31 @@ instance A.FromJSON JWTConfig where
|
||||
|
||||
parseJSON = A.withObject "JWTConfig" $ \o -> do
|
||||
keyType <- o A..: "type"
|
||||
rawKey <- o A..: "key"
|
||||
mRawKey <- o A..:? "key"
|
||||
claimNs <- o A..:? "claims_namespace"
|
||||
case keyType of
|
||||
"HS256" -> parseHmacKey rawKey 256 keyType claimNs
|
||||
"HS384" -> parseHmacKey rawKey 384 keyType claimNs
|
||||
"HS512" -> parseHmacKey rawKey 512 keyType claimNs
|
||||
"RS256" -> parseRsaKey rawKey keyType claimNs
|
||||
"RS384" -> parseRsaKey rawKey keyType claimNs
|
||||
"RS512" -> parseRsaKey rawKey keyType claimNs
|
||||
-- TODO: support ES256, ES384, ES512, PS256, PS384
|
||||
_ -> invalidJwk ("Key type: " <> T.unpack keyType <> " is not supported")
|
||||
aud <- o A..:? "audience"
|
||||
jwkUrl <- o A..:? "jwk_url"
|
||||
|
||||
case (mRawKey, jwkUrl) of
|
||||
(Nothing, Nothing) -> fail "key and jwk_url both cannot be empty"
|
||||
(Just _, Just _) -> fail "key, jwk_url both cannot be present"
|
||||
(Just rawKey, Nothing) -> do
|
||||
key <- parseKey keyType rawKey
|
||||
return $ JWTConfig keyType (Left key) claimNs aud
|
||||
(Nothing, Just url) ->
|
||||
return $ JWTConfig keyType (Right url) claimNs aud
|
||||
|
||||
where
|
||||
parseHmacKey key size ktype cns = do
|
||||
let secret = BL.fromStrict $ TE.encodeUtf8 key
|
||||
when (BL.length secret < size `div` 8) $
|
||||
invalidJwk "Key size too small"
|
||||
return $ JWTConfig ktype (fromOctets secret) cns
|
||||
|
||||
parseRsaKey key ktype cns = do
|
||||
let res = fromRawPem (BL.fromStrict $ TE.encodeUtf8 key)
|
||||
err e = "Could not decode PEM: " <> T.unpack e
|
||||
either (invalidJwk . err) (\r -> return $ JWTConfig ktype r cns) res
|
||||
parseKey keyType rawKey =
|
||||
case keyType of
|
||||
"HS256" -> runEither $ parseHmacKey rawKey 256
|
||||
"HS384" -> runEither $ parseHmacKey rawKey 384
|
||||
"HS512" -> runEither $ parseHmacKey rawKey 512
|
||||
"RS256" -> runEither $ parseRsaKey rawKey
|
||||
"RS384" -> runEither $ parseRsaKey rawKey
|
||||
"RS512" -> runEither $ parseRsaKey rawKey
|
||||
-- TODO: support ES256, ES384, ES512, PS256, PS384
|
||||
_ -> invalidJwk ("Key type: " <> T.unpack keyType <> " is not supported")
|
||||
|
||||
runEither = either (invalidJwk . T.unpack) return
|
||||
invalidJwk msg = fail ("Invalid JWK: " <> msg)
|
||||
|
||||
|
||||
-- | Helper functions to decode PEM bytestring to RSA public key
|
||||
|
||||
-- try PKCS first, then x509
|
||||
fromRawPem :: BL.ByteString -> Either Text JWK
|
||||
fromRawPem bs = -- pubKeyToJwk <=< fromPkcsPem
|
||||
case fromPkcsPem bs of
|
||||
Right pk -> pubKeyToJwk pk
|
||||
Left e ->
|
||||
case fromX509Pem bs of
|
||||
Right pk1 -> pubKeyToJwk pk1
|
||||
Left e1 -> Left (e <> " " <> e1)
|
||||
|
||||
-- decode a PKCS1 or PKCS8 PEM to obtain the public key
|
||||
fromPkcsPem :: BL.ByteString -> Either Text X509.PubKey
|
||||
fromPkcsPem bs = do
|
||||
pems <- fmapL T.pack $ PEM.pemParseLBS bs
|
||||
pem <- getAtleastOne "No pem found" pems
|
||||
res <- fmapL asn1ErrToText $ decodeASN1' DER $ PEM.pemContent pem
|
||||
case res of
|
||||
-- PKCS#1 format
|
||||
[Start Sequence, IntVal n, IntVal e, End Sequence] ->
|
||||
return $ X509.PubKeyRSA $ PublicKey (calculateSize n) n e
|
||||
-- try and see if its a PKCS#8 format
|
||||
asn1 -> do
|
||||
(pub, xs) <- fmapL T.pack $ fromASN1 asn1
|
||||
unless (null xs) (Left "Could not decode public key")
|
||||
return pub
|
||||
where
|
||||
asn1ErrToText = T.pack . show
|
||||
|
||||
|
||||
-- decode a x509 certificate containing the RSA public key
|
||||
fromX509Pem :: BL.ByteString -> Either Text X509.PubKey
|
||||
fromX509Pem s = do
|
||||
-- try to parse bytestring to a [PEM]
|
||||
pems <- fmapL T.pack $ PEM.pemParseLBS s
|
||||
-- fail if [PEM] is empty
|
||||
pem <- getAtleastOne "No pem found" pems
|
||||
-- decode the bytestring to a certificate
|
||||
signedExactCert <- fmapL T.pack $ X509.decodeSignedCertificate $
|
||||
PEM.pemContent pem
|
||||
let cert = X509.signedObject $ X509.getSigned signedExactCert
|
||||
pubKey = X509.certPubKey cert
|
||||
case pubKey of
|
||||
X509.PubKeyRSA pk -> return $ X509.PubKeyRSA pk
|
||||
_ -> Left "Could not decode RSA public key from x509 cert"
|
||||
|
||||
|
||||
pubKeyToJwk :: X509.PubKey -> Either Text JWK
|
||||
pubKeyToJwk pubKey = do
|
||||
jwk' <- mkJwk
|
||||
return $ jwk' & jwkKeyOps .~ Just [Verify]
|
||||
where
|
||||
mkJwk = case pubKey of
|
||||
X509.PubKeyRSA (PublicKey _ n e) ->
|
||||
return $ fromKeyMaterial $ RSAKeyMaterial (rsaKeyParams n e)
|
||||
_ -> Left "This key type is not supported"
|
||||
rsaKeyParams n e =
|
||||
RSAKeyParameters (Base64Integer n) (Base64Integer e) Nothing
|
||||
|
||||
|
||||
fmapL :: (a -> a') -> Either a b -> Either a' b
|
||||
fmapL fn (Left e) = Left (fn e)
|
||||
fmapL _ (Right x) = pure x
|
||||
|
||||
getAtleastOne :: Text -> [a] -> Either Text a
|
||||
getAtleastOne err [] = Left err
|
||||
getAtleastOne _ (x:_) = Right x
|
||||
|
||||
calculateSize :: Integer -> Int
|
||||
calculateSize = go 1
|
||||
where
|
||||
go i n | 2 ^ (i * 8) > n = i
|
||||
| otherwise = go (i + 1) n
|
||||
|
||||
114
server/src-lib/Hasura/Server/Auth/JWT/Internal.hs
Normal file
114
server/src-lib/Hasura/Server/Auth/JWT/Internal.hs
Normal file
@ -0,0 +1,114 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Hasura.Server.Auth.JWT.Internal where
|
||||
|
||||
import Control.Lens
|
||||
import Crypto.JOSE.Types (Base64Integer (..))
|
||||
import Crypto.JWT
|
||||
import Crypto.PubKey.RSA (PublicKey (..))
|
||||
import Data.ASN1.BinaryEncoding (DER (..))
|
||||
import Data.ASN1.Encoding (decodeASN1')
|
||||
import Data.ASN1.Types (ASN1 (End, IntVal, Start),
|
||||
ASN1ConstructionType (Sequence),
|
||||
fromASN1)
|
||||
import Data.Int (Int64)
|
||||
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.PEM as PEM
|
||||
import qualified Data.String.Conversions as CS
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.X509 as X509
|
||||
|
||||
-- | Helper functions to decode Text to JWK
|
||||
|
||||
parseHmacKey :: T.Text -> Int64 -> Either T.Text JWK
|
||||
parseHmacKey key size = do
|
||||
let secret = CS.cs key
|
||||
err s = "Key size too small; should be atleast " <> show (s `div` 8) <> " characters"
|
||||
if BL.length secret < size `div` 8
|
||||
then Left . T.pack $ err size
|
||||
else pure $ fromOctets secret
|
||||
|
||||
parseRsaKey :: T.Text -> Either T.Text JWK
|
||||
parseRsaKey key = do
|
||||
let res = fromRawPem (CS.cs key)
|
||||
err e = "Could not decode PEM: " <> e
|
||||
either (Left . err) pure res
|
||||
|
||||
|
||||
-- | Helper functions to decode PEM bytestring to RSA public key
|
||||
|
||||
-- try PKCS first, then x509
|
||||
fromRawPem :: BL.ByteString -> Either Text JWK
|
||||
fromRawPem bs = -- pubKeyToJwk <=< fromPkcsPem
|
||||
case fromPkcsPem bs of
|
||||
Right pk -> pubKeyToJwk pk
|
||||
Left e ->
|
||||
case fromX509Pem bs of
|
||||
Right pk1 -> pubKeyToJwk pk1
|
||||
Left e1 -> Left (e <> " " <> e1)
|
||||
|
||||
-- decode a PKCS1 or PKCS8 PEM to obtain the public key
|
||||
fromPkcsPem :: BL.ByteString -> Either Text X509.PubKey
|
||||
fromPkcsPem bs = do
|
||||
pems <- fmapL T.pack $ PEM.pemParseLBS bs
|
||||
pem <- getAtleastOne "No pem found" pems
|
||||
res <- fmapL asn1ErrToText $ decodeASN1' DER $ PEM.pemContent pem
|
||||
case res of
|
||||
-- PKCS#1 format
|
||||
[Start Sequence, IntVal n, IntVal e, End Sequence] ->
|
||||
return $ X509.PubKeyRSA $ PublicKey (calculateSize n) n e
|
||||
-- try and see if its a PKCS#8 format
|
||||
asn1 -> do
|
||||
(pub, xs) <- fmapL T.pack $ fromASN1 asn1
|
||||
unless (null xs) (Left "Could not decode public key")
|
||||
return pub
|
||||
where
|
||||
asn1ErrToText = T.pack . show
|
||||
|
||||
|
||||
-- decode a x509 certificate containing the RSA public key
|
||||
fromX509Pem :: BL.ByteString -> Either Text X509.PubKey
|
||||
fromX509Pem s = do
|
||||
-- try to parse bytestring to a [PEM]
|
||||
pems <- fmapL T.pack $ PEM.pemParseLBS s
|
||||
-- fail if [PEM] is empty
|
||||
pem <- getAtleastOne "No pem found" pems
|
||||
-- decode the bytestring to a certificate
|
||||
signedExactCert <- fmapL T.pack $ X509.decodeSignedCertificate $
|
||||
PEM.pemContent pem
|
||||
let cert = X509.signedObject $ X509.getSigned signedExactCert
|
||||
pubKey = X509.certPubKey cert
|
||||
case pubKey of
|
||||
X509.PubKeyRSA pk -> return $ X509.PubKeyRSA pk
|
||||
_ -> Left "Could not decode RSA public key from x509 cert"
|
||||
|
||||
|
||||
pubKeyToJwk :: X509.PubKey -> Either Text JWK
|
||||
pubKeyToJwk pubKey = do
|
||||
jwk' <- mkJwk
|
||||
return $ jwk' & jwkKeyOps .~ Just [Verify]
|
||||
where
|
||||
mkJwk = case pubKey of
|
||||
X509.PubKeyRSA (PublicKey _ n e) ->
|
||||
return $ fromKeyMaterial $ RSAKeyMaterial (rsaKeyParams n e)
|
||||
_ -> Left "This key type is not supported"
|
||||
rsaKeyParams n e =
|
||||
RSAKeyParameters (Base64Integer n) (Base64Integer e) Nothing
|
||||
|
||||
|
||||
fmapL :: (a -> a') -> Either a b -> Either a' b
|
||||
fmapL fn (Left e) = Left (fn e)
|
||||
fmapL _ (Right x) = pure x
|
||||
|
||||
getAtleastOne :: Text -> [a] -> Either Text a
|
||||
getAtleastOne err [] = Left err
|
||||
getAtleastOne _ (x:_) = Right x
|
||||
|
||||
calculateSize :: Integer -> Int
|
||||
calculateSize = go 1
|
||||
where
|
||||
go i n | 2 ^ (i * 8) > n = i
|
||||
| otherwise = go (i + 1) n
|
||||
55
server/src-lib/Hasura/Server/Auth/JWT/Logging.hs
Normal file
55
server/src-lib/Hasura/Server/Auth/JWT/Logging.hs
Normal file
@ -0,0 +1,55 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Hasura.Server.Auth.JWT.Logging
|
||||
( JwkRefreshLog (..)
|
||||
, JwkRefreshHttpError (..)
|
||||
, mkJwkRefreshLog
|
||||
)
|
||||
where
|
||||
|
||||
import Data.Aeson
|
||||
|
||||
import Hasura.Logging (LogLevel (..), ToEngineLog (..))
|
||||
import Hasura.Prelude
|
||||
import Hasura.Server.Logging ()
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
|
||||
|
||||
data JwkRefreshLog
|
||||
= JwkRefreshLog
|
||||
{ jrlLogLevel :: !LogLevel
|
||||
, jrlError :: !T.Text
|
||||
, jrlHttpError :: !(Maybe JwkRefreshHttpError)
|
||||
} deriving (Show)
|
||||
|
||||
data JwkRefreshHttpError
|
||||
= JwkRefreshHttpError
|
||||
{ jrheStatus :: !(Maybe HTTP.Status)
|
||||
, jrheUrl :: !T.Text
|
||||
, jrheHttpException :: !(Maybe HTTP.HttpException)
|
||||
, jrheResponse :: !(Maybe T.Text)
|
||||
} deriving (Show)
|
||||
|
||||
instance ToJSON JwkRefreshHttpError where
|
||||
toJSON jhe =
|
||||
object [ "status_code" .= (HTTP.statusCode <$> jrheStatus jhe)
|
||||
, "url" .= jrheUrl jhe
|
||||
, "response" .= jrheResponse jhe
|
||||
, "http_exception" .= (toJSON <$> jrheHttpException jhe)
|
||||
]
|
||||
|
||||
instance ToJSON JwkRefreshLog where
|
||||
toJSON jrl =
|
||||
object [ "error" .= jrlError jrl
|
||||
, "http_error" .= (toJSON <$> jrlHttpError jrl)
|
||||
]
|
||||
|
||||
instance ToEngineLog JwkRefreshLog where
|
||||
toEngineLog jwkRefreshLog =
|
||||
(jrlLogLevel jwkRefreshLog, "jwk-refresh-log", toJSON jwkRefreshLog)
|
||||
|
||||
mkJwkRefreshLog :: T.Text -> Maybe JwkRefreshHttpError -> JwkRefreshLog
|
||||
mkJwkRefreshLog = JwkRefreshLog (LevelOther "critical")
|
||||
@ -8,6 +8,7 @@ module Hasura.Server.Logging
|
||||
( mkAccessLog
|
||||
, getRequestHeader
|
||||
, WebHookLog(..)
|
||||
, WebHookLogger
|
||||
) where
|
||||
|
||||
import Control.Arrow (first)
|
||||
@ -39,6 +40,7 @@ import Hasura.Prelude
|
||||
import Hasura.RQL.Types.Error
|
||||
import Hasura.Server.Utils
|
||||
|
||||
|
||||
data WebHookLog
|
||||
= WebHookLog
|
||||
{ whlLogLevel :: !L.LogLevel
|
||||
@ -69,6 +71,8 @@ instance ToJSON WebHookLog where
|
||||
, "response" .= whlResponse whl
|
||||
]
|
||||
|
||||
type WebHookLogger = WebHookLog -> IO ()
|
||||
|
||||
data AccessLog
|
||||
= AccessLog
|
||||
{ alStatus :: !N.Status
|
||||
|
||||
Loading…
Reference in New Issue
Block a user