Repository: hasura/graphql-engine
File: server/src-lib/Hasura/Server/Auth/JWT.hs (Haskell)

Code before:

      claimsNsFields = case claimNs of
        ClaimNsPath nsPath ->
          ["claims_namespace_path" J..= (encodeJSONPath nsPath)]
        ClaimNs ns -> ["claims_ns" J..= J.String ns]

      sharedFields = [ "claims_format" J..= claimsFmt
                     , "audience" J..= aud
                     , "issuer" J..= iss
                     ]

-- | Parse from a json string like:
-- | `{"type": "RS256", "key": "<PEM-encoded-public-key-or-X509-cert>"}`
-- | to JWTConfig
instance J.FromJSON JWTConfig where

  parseJSON = J.withObject "JWTConfig" $ \o -> do
    mRawKey <- o J..:? "key"
    claimNs <- o J..:? "claims_namespace"
    claimNsPathStr <- o J..:? "claims_namespace_path"
    aud     <- o J..:? "audience"
    iss     <- o J..:? "issuer"
    jwkUrl  <- o J..:? "jwk_url"
    isStrngfd <- o J..:? "claims_format"

    let hasuraClaimsNs :: Either String JWTConfigClaims
        hasuraClaimsNs =
          case claimNsPathStr of
            Just nsPathStr ->
              let eClaimNsPath = JSONPath.parseJSONPath nsPathStr
              in
                case eClaimNsPath of
                  Left err -> Left err
                  Right nsPath -> Right $ ClaimNsPath nsPath
            Nothing ->
              case claimNs of
                Just ns -> Right $ ClaimNs ns
                Nothing -> Right $ ClaimNs defaultClaimNs

    case hasuraClaimsNs of
      Left err -> fail ("invalid JSON path claims_namespace_path error:" ++
                        (show err))
      Right claimsNs ->
        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
            keyType <- o J..: "type"
            key <- parseKey keyType rawKey
            return $ JWTConfig (Left key) claimsNs aud isStrngfd iss
          (Nothing, Just url) ->

Review comment (bug):
You can directly `parseJSONPath` and `fail` in single line
```haskell
     maybeClaimNsPath <- (o J..:? "claims_namespace_path")  >>= mapM (either failJSONPathParsing pure . JSONPath.parseJSONPath)
```
in `where`
```haskell
failJSONPathParsing err = fail $ "invalid JSON path claims_namespace_path error: " ++ err
```
Compute `hasuraClaimsNs` without any error handling

```haskell
hasuraClaimsNs = case maybeClaimNsPath of
  Just claimsNsPath -> ClaimNsPath claimsNsPath
  Nothing -> ClaimNs $ fromMaybe defaultClaimNs claimNs
```

Now code is much read-able and pretty. :slightly_smiling_face: 


Code after:
        Left _    -> [ "type" J..= J.String "<TYPE REDACTED>"
                     , "key" J..= J.String "<JWK REDACTED>" ]
        Right url -> [ "jwk_url" J..= url ]

      claimsNsFields = case claimNs of
        ClaimNsPath nsPath ->
          ["claims_namespace_path" J..= (encodeJSONPath nsPath)]
        ClaimNs ns -> ["claims_namespace" J..= J.String ns]

      sharedFields = [ "claims_format" J..= claimsFmt
                     , "audience" J..= aud
                     , "issuer" J..= iss
                     ]

-- | Parse from a json string like:
-- | `{"type": "RS256", "key": "<PEM-encoded-public-key-or-X509-cert>"}`
-- | to JWTConfig
instance J.FromJSON JWTConfig where

  parseJSON = J.withObject "JWTConfig" $ \o -> do
    mRawKey <- o J..:? "key"
    claimsNs <- o J..:? "claims_namespace"
    claimsNsPath <- o J..:? "claims_namespace_path"
    aud     <- o J..:? "audience"
    iss     <- o J..:? "issuer"
    jwkUrl  <- o J..:? "jwk_url"
    isStrngfd <- o J..:? "claims_format"


    hasuraClaimsNs <-
      case (claimsNsPath,claimsNs) of
        (Nothing, Nothing) -> return $ ClaimNs defaultClaimNs
        (Just nsPath, Nothing) -> either failJSONPathParsing (return . ClaimNsPath) . JSONPath.parseJSONPath $ nsPath
        (Nothing, Just ns) -> return $ ClaimNs ns
        (Just _, Just _) -> fail "claims_namespace and claims_namespace_path both cannot be set"

    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
        keyType <- o J..: "type"
        key <- parseKey keyType rawKey
        return $ JWTConfig (Left key) hasuraClaimsNs aud isStrngfd iss
      (Nothing, Just url) ->
        return $ JWTConfig (Right url) hasuraClaimsNs aud isStrngfd iss

    where
      parseKey keyType rawKey =
       case keyType of
          "HS256" -> runEither $ parseHmacKey rawKey 256
          "HS384" -> runEither $ parseHmacKey rawKey 384