diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index eb0f44dc58117..f0c12aa425acc 100644 --- a/server/graphql-engine.cabal +++ b/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 diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index aab9e8169cc5c..0f0081bdd74c9 100644 --- a/server/src-exec/Main.hs +++ b/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 diff --git a/server/src-lib/Hasura/RQL/Types/Error.hs b/server/src-lib/Hasura/RQL/Types/Error.hs index 5b1375c21e528..2974359f24ffe 100644 --- a/server/src-lib/Hasura/RQL/Types/Error.hs +++ b/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 diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index 05acb2b087e02..5888b4eda5e1f 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/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 diff --git a/server/src-lib/Hasura/Server/Auth.hs b/server/src-lib/Hasura/Server/Auth.hs index d12e64445b84e..b1437d9bf6fb1 100644 --- a/server/src-lib/Hasura/Server/Auth.hs +++ b/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 diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs new file mode 100644 index 0000000000000..8e4f02d109f1a --- /dev/null +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -0,0 +1,291 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Hasura.Server.Auth.JWT + ( processJwt + , RawJWT + , JWTConfig (..) + ) where + +import Control.Lens +import Control.Monad (when) + +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.List (find) +import Data.Time.Clock (getCurrentTime) +import Hasura.Prelude +import Hasura.RQL.Types +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 + + +type RawJWT = BL.ByteString + +data HasuraClaims + = HasuraClaims + { _cmAllowedRoles :: ![RoleName] + , _cmDefaultRole :: !RoleName + } 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 + } deriving (Show, Eq) + +allowedRolesClaim :: T.Text +allowedRolesClaim = "x-hasura-allowed-roles" + +defaultRoleClaim :: T.Text +defaultRoleClaim = "x-hasura-default-role" + +-- | Process the request headers to verify the JWT and extract UserInfo from it +processJwt + :: ( MonadIO m + , MonadError QErr m) + => JWTConfig + -> HTTP.RequestHeaders + -> m UserInfo +processJwt conf headers = do + -- try to parse JWT token from Authorization header + jwt <- parseAuthzHeader + + -- verify the JWT + claims <- liftJWTError invalidJWTError $ verifyJwt (jcKey conf) jwt + + -- filter only x-hasura claims + let claimsMap = Map.filterWithKey (\k _ -> T.isPrefixOf "x-hasura-" k) $ + claims ^. unregisteredClaims + + HasuraClaims allowedRoles defaultRole <- parseHasuraClaims claimsMap + let role = getCurrentRole defaultRole + + when (role `notElem` allowedRoles) currRoleNotAllowed + let finalClaims = + Map.delete defaultRoleClaim . Map.delete allowedRolesClaim $ claimsMap + + -- transform the map of text:aeson-value -> text:text + metadata <- decodeJSON $ A.Object finalClaims + + -- delete the x-hasura-access-key from this map, and insert x-hasura-role + let hasuraMd = Map.insert userRoleHeader (getRoleTxt role) $ + Map.delete accessKeyHeader metadata + + return $ UserInfo role hasuraMd + + where + parseAuthzHeader = do + let mAuthzHeader = find (\h -> fst h == CI.mk "Authorization") headers + (_, authzHeader) <- maybe missingAuthzHeader return mAuthzHeader + let tokenParts = BLC.words $ BL.fromStrict authzHeader + case tokenParts of + ["Bearer", jwt] -> return jwt + _ -> malformedAuthzHeader + + -- see if there is a x-hasura-role header, or else pick the default role + getCurrentRole defaultRole = + let userRoleHeaderB = TE.encodeUtf8 userRoleHeader + mUserRole = snd <$> find (\h -> fst h == CI.mk userRoleHeaderB) headers + in maybe defaultRole (RoleName . bsToTxt) mUserRole + + decodeJSON val = case A.fromJSON val of + A.Error e -> throw400 JWTInvalidClaims ("x-hasura-* claims: " <> T.pack e) + A.Success a -> return a + + liftJWTError :: (MonadError e' m) => (e -> e') -> ExceptT e m a -> m a + liftJWTError ef action = do + res <- runExceptT action + either (throwError . ef) return res + + invalidJWTError e = + err400 JWTInvalid $ "Could not verify JWT: " <> T.pack (show e) + + malformedAuthzHeader = + throw400 InvalidHeaders "Malformed Authorization header" + missingAuthzHeader = + throw400 InvalidHeaders "Missing Authorization header in JWT authentication mode" + currRoleNotAllowed = + throw400 AccessDenied "Your current role is not in allowed roles" + + +-- parse x-hasura-allowed-roles, x-hasura-default-role from JWT claims +parseHasuraClaims + :: (MonadError QErr m) + => A.Object -> m HasuraClaims +parseHasuraClaims claimsMap = do + let mAllowedRolesV = Map.lookup allowedRolesClaim claimsMap + allowedRolesV <- maybe missingAllowedRolesClaim return mAllowedRolesV + allowedRoles <- parseJwtClaim (A.fromJSON allowedRolesV) errMsg + + let mDefaultRoleV = Map.lookup defaultRoleClaim claimsMap + defaultRoleV <- maybe missingDefaultRoleClaim return mDefaultRoleV + defaultRole <- parseJwtClaim (A.fromJSON defaultRoleV) errMsg + + return $ HasuraClaims allowedRoles defaultRole + + where + missingAllowedRolesClaim = + let msg = "JWT claim does not contain " <> allowedRolesClaim + in throw400 JWTRoleClaimMissing msg + + missingDefaultRoleClaim = + let msg = "JWT claim does not contain " <> defaultRoleClaim + in throw400 JWTRoleClaimMissing msg + + errMsg _ = "invalid " <> allowedRolesClaim <> "; should be a list of roles" + + parseJwtClaim :: (MonadError QErr m) => A.Result a -> (String -> Text) -> m a + parseJwtClaim res errFn = + case res of + A.Success val -> return val + A.Error e -> throw400 JWTInvalidClaims $ errFn e + + +-- | Verify the JWT against given JWK +verifyJwt + :: ( MonadError JWTError m + , MonadIO m + ) + => JWK + -> RawJWT + -> m ClaimsSet +verifyJwt key rawJWT = do + jwt <- decodeCompact rawJWT -- decode JWT + t <- liftIO getCurrentTime + verifyClaimsAt config key t jwt + where + audCheck = const True -- we ignore the audience check? + config = defaultJWTValidationSettings audCheck + + +-- | Parse from a json string like: +-- | `{"type": "RS256", "key": ""}` +-- | to JWTConfig +instance A.FromJSON JWTConfig where + + parseJSON = A.withObject "JWTConfig" $ \o -> do + keyType <- o A..: "type" + rawKey <- o A..: "key" + case keyType of + "HS256" -> parseHmacKey rawKey 256 keyType + "HS384" -> parseHmacKey rawKey 384 keyType + "HS512" -> parseHmacKey rawKey 512 keyType + "RS256" -> parseRsaKey rawKey keyType + "RS384" -> parseRsaKey rawKey keyType + "RS512" -> parseRsaKey rawKey keyType + -- TODO: support ES256, ES384, ES512, PS256, PS384 + _ -> invalidJwk ("Key type: " <> T.unpack keyType <> " is not supported") + where + parseHmacKey key size ktype = 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) + + parseRsaKey key ktype = do + let res = fromRawPem (BL.fromStrict $ TE.encodeUtf8 key) + err e = "Could not decode PEM: " <> T.unpack e + either (invalidJwk . err) (return . JWTConfig ktype) res + + 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 diff --git a/server/src-lib/Hasura/Server/CheckUpdates.hs b/server/src-lib/Hasura/Server/CheckUpdates.hs index f4611fd49bf33..2487882d38d21 100644 --- a/server/src-lib/Hasura/Server/CheckUpdates.hs +++ b/server/src-lib/Hasura/Server/CheckUpdates.hs @@ -25,7 +25,7 @@ import Hasura.Server.Version (currentVersion) newtype UpdateInfo = UpdateInfo - { uiLatest :: T.Text + { _uiLatest :: T.Text } deriving (Show, Eq) $(A.deriveJSON (A.aesonDrop 2 A.snakeCase) ''UpdateInfo) diff --git a/server/src-lib/Hasura/Server/Init.hs b/server/src-lib/Hasura/Server/Init.hs index 7edce99164471..276b67cb8cdbf 100644 --- a/server/src-lib/Hasura/Server/Init.hs +++ b/server/src-lib/Hasura/Server/Init.hs @@ -12,8 +12,10 @@ import qualified Data.Text as T import Hasura.Prelude import Hasura.RQL.DDL.Utils +import Hasura.Server.Auth import Hasura.Server.Utils + data InitError = InitError !String deriving (Show, Eq) @@ -24,7 +26,6 @@ instance Q.FromPGConnErr InitError where instance Q.FromPGTxErr InitError where fromPGTxErr = InitError . show -type AccessKey = T.Text initErrExit :: (Show e) => e -> IO a initErrExit e = print e >> exitFailure @@ -44,6 +45,16 @@ data RawConnInfo = , connOptions :: !(Maybe String) } deriving (Eq, Read, Show) +data CorsConfigG a + = CorsConfigG + { ccDomain :: !a + , ccDisabled :: !Bool + } deriving (Show, Eq) + +type CorsConfigFlags = CorsConfigG (Maybe T.Text) +type CorsConfig = CorsConfigG T.Text + + parseRawConnInfo :: Parser RawConnInfo parseRawConnInfo = RawConnInfo @@ -145,19 +156,34 @@ parseServerPort = help "Port on which graphql-engine should be served") parseAccessKey :: Parser (Maybe AccessKey) -parseAccessKey = optional $ strOption ( long "access-key" <> - metavar "SECRET ACCESS KEY" <> - help "Secret access key, required to access this instance" - ) - -data CorsConfigG a - = CorsConfigG - { ccDomain :: !a - , ccDisabled :: !Bool - } deriving (Show, Eq) +parseAccessKey = + optional $ AccessKey <$> + strOption ( long "access-key" <> + metavar "SECRET ACCESS KEY" <> + help "Secret access key, required to access this instance" + ) + +parseWebHook :: Parser (Maybe Webhook) +parseWebHook = + optional $ Webhook <$> + strOption ( long "auth-hook" <> + metavar "AUTHENTICATION WEB HOOK" <> + help "The authentication webhook, required to authenticate requests" + ) + + +parseJwtSecret :: Parser (Maybe Text) +parseJwtSecret = + optional $ strOption ( long "jwt-secret" <> + metavar "JWK" <> + help jwtSecretHelp + ) + +jwtSecretHelp :: String +jwtSecretHelp = "The JSON containing type and the JWK used for verifying. e.g: " + <> "`{\"type\": \"HS256\", \"key\": \"\"}`," + <> "`{\"type\": \"RS256\", \"key\": \"\"}`" -type CorsConfigFlags = CorsConfigG (Maybe T.Text) -type CorsConfig = CorsConfigG T.Text parseCorsConfig :: Parser CorsConfigFlags parseCorsConfig = @@ -170,12 +196,6 @@ parseCorsConfig = help "Disable CORS handling" ) -parseWebHook :: Parser (Maybe T.Text) -parseWebHook = optional $ strOption ( long "auth-hook" <> - metavar "AUTHENTICATION WEB HOOK" <> - help "The authentication webhook, required to authenticate requests" - ) - parseEnableConsole :: Parser Bool parseEnableConsole = switch ( long "enable-console" <> help "Enable API Console" diff --git a/server/src-lib/Hasura/Server/Utils.hs b/server/src-lib/Hasura/Server/Utils.hs index 07396c01748fd..c5bc0bc476ecf 100644 --- a/server/src-lib/Hasura/Server/Utils.hs +++ b/server/src-lib/Hasura/Server/Utils.hs @@ -9,12 +9,16 @@ import Network.URI import System.Exit import System.Process +import qualified Data.ByteString as B import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TE import qualified Data.Text.IO as TI import qualified Language.Haskell.TH.Syntax as TH import Hasura.Prelude + dropAndSnakeCase :: T.Text -> T.Text dropAndSnakeCase = T.drop 9 . toSnakeCase . T.toLower @@ -39,6 +43,9 @@ accessKeyHeader = "x-hasura-access-key" userIdHeader :: T.Text userIdHeader = "x-hasura-user-id" +bsToTxt :: B.ByteString -> T.Text +bsToTxt = TE.decodeUtf8With TE.lenientDecode + -- Parsing postgres database url -- from: https://github.com/futurice/postgresql-simple-url/ parseDatabaseUrl :: String -> Maybe String -> Maybe Q.ConnInfo