{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

{-|
Authentication with Keycloak is based on [JWTs](https://jwt.io/).
This module helps you retrieve tokens from Keycloak, and use them to authenticate your users.
In Keycloak, you need to configure a realm, a client and a user.

Users can also have additional attributes.
To see them in the Token, you need to add "protocol mappers" in the Client, that will copy the User attribute in the Token.

The example below retrieves a User token using Login/password, verifies it, and extract all the user details from it.

@
-- Kecyloak configuration.
kcConfig :: KCConfig
kcConfig = KCConfig {
  _confBaseUrl       = "http://localhost:8080/auth",
  _confRealm         = "demo",
  _confClientId      = "demo",
  _confClientSecret  = "3d792576-4e56-4c58-991a-49074e6a92ea"}

main :: IO ()
main = do

  void $ flip runKeycloak kcConfig $ do
    liftIO $ putStrLn "Starting tests..."
  
    -- JWKs are public keys delivered by Keycloak to check the integrity of any JWT (user tokens).
    -- an application may retrieve these keys once at startup and keep them.
    jwks <- getJWKs
    liftIO $ putStrLn $ "Got JWKs: \n" ++ (show jwks) ++ "\n\n"
  
    -- Get a JWT from Keycloak. A JWT can then be used to authenticate yourself with an application.
    jwt <- getJWT "demo" "demo" 
    liftIO $ putStrLn $ "Got JWT: \n" ++ (show jwt) ++ "\n\n"
  
    -- Retrieve the claims contained in the JWT.
    claims <- verifyJWT (head jwks) jwt
    liftIO $ putStrLn $ "Claims decoded from Token: \n" ++ (show claims) ++ "\n\n"
    
    -- get the user from the claim
    let user = getClaimsUser claims
    liftIO $ putStrLn $ "User decoded from claims: \n" ++ (show user) ++ "\n\n"
@
-}

module Keycloak.Tokens where

import           Control.Lens hiding ((.=))
import           Control.Monad.Reader as R
import           Control.Monad.Except (throwError)
import           Crypto.JWT as JWT
import           Data.Aeson as JSON
import           Data.Aeson.Lens
import           Data.Text as T hiding (head, tail, map)
import           Data.Maybe
import qualified Data.HashMap.Strict as HM
import           Data.String.Conversions
import           Keycloak.Types
import           Keycloak.Utils
import           Network.Wreq as W hiding (statusCode)

-- * Tokens

-- | return JWKs from Keycloak. Its a set of keys that can be used to check signed tokens (JWTs)
getJWKs :: Keycloak [JWK]
getJWKs :: Keycloak [JWK]
getJWKs = do
  ByteString
body <- Path -> Keycloak ByteString
keycloakGet' (Path
"protocol/openid-connect/certs")
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
info (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a. Show a => a -> String
show ByteString
body
  (JWKSet [JWK]
jwks) <- case ByteString -> Either String JWKSet
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
     Right JWKSet
ret -> do
       JWKSet -> ReaderT KCConfig (ExceptT KCError IO) JWKSet
forall (m :: * -> *) a. Monad m => a -> m a
return JWKSet
ret
     Left (String
err2 :: String) -> do
       String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
err2) 
       KCError -> ReaderT KCConfig (ExceptT KCError IO) JWKSet
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> ReaderT KCConfig (ExceptT KCError IO) JWKSet)
-> KCError -> ReaderT KCConfig (ExceptT KCError IO) JWKSet
forall a b. (a -> b) -> a -> b
$ Path -> KCError
ParseError (Path -> KCError) -> Path -> KCError
forall a b. (a -> b) -> a -> b
$ String -> Path
pack (String -> String
forall a. Show a => a -> String
show String
err2)
  [JWK] -> Keycloak [JWK]
forall (m :: * -> *) a. Monad m => a -> m a
return [JWK]
jwks


-- | Retrieve the user's token. This token can be used to authenticate the user.
-- This token can be also used for every other Keycloak calls.
getJWT :: Username -> Password -> Keycloak JWT
getJWT :: Path -> Path -> Keycloak JWT
getJWT Path
username Path
password = do 
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"Get user token"
  Path
client <- (KCConfig -> Path) -> ReaderT KCConfig (ExceptT KCError IO) Path
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks KCConfig -> Path
_confClientId
  Path
secret <- (KCConfig -> Path) -> ReaderT KCConfig (ExceptT KCError IO) Path
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks KCConfig -> Path
_confClientSecret
  let dat :: [FormParam]
dat = [ByteString
"client_id" ByteString -> Path -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Path
client, 
             ByteString
"client_secret" ByteString -> Path -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Path
secret,
             ByteString
"grant_type" ByteString -> Path -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (Path
"password" :: Text),
             ByteString
"password" ByteString -> Path -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Path
password,
             ByteString
"username" ByteString -> Path -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Path
username]
  ByteString
body <- Path -> [FormParam] -> Keycloak ByteString
forall dat.
(Postable dat, Show dat) =>
Path -> dat -> Keycloak ByteString
keycloakPost' Path
"protocol/openid-connect/token" [FormParam]
dat
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ByteString -> String
forall a. Show a => a -> String
show ByteString
body) 
  case ByteString -> Either String TokenRep
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
    Right TokenRep
ret -> do 
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak success: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (TokenRep -> String
forall a. Show a => a -> String
show TokenRep
ret) 
      ByteString -> Keycloak JWT
forall a e (m :: * -> *).
(FromCompact a, AsError e, MonadError e m) =>
ByteString -> m a
decodeCompact (ByteString -> Keycloak JWT) -> ByteString -> Keycloak JWT
forall a b. (a -> b) -> a -> b
$ Path -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (Path -> ByteString) -> Path -> ByteString
forall a b. (a -> b) -> a -> b
$ TokenRep -> Path
accessToken TokenRep
ret
    Left String
err2 -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
err2) 
      KCError -> Keycloak JWT
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak JWT) -> KCError -> Keycloak JWT
forall a b. (a -> b) -> a -> b
$ Path -> KCError
ParseError (Path -> KCError) -> Path -> KCError
forall a b. (a -> b) -> a -> b
$ String -> Path
pack (String -> String
forall a. Show a => a -> String
show String
err2)

-- | return a Client token (linked to a Client, not a User). It is useful to create Resources in that Client in Keycloak.
getClientJWT :: Keycloak JWT
getClientJWT :: Keycloak JWT
getClientJWT = do
  String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug String
"Get client token"
  Path
client <- (KCConfig -> Path) -> ReaderT KCConfig (ExceptT KCError IO) Path
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks KCConfig -> Path
_confClientId
  Path
secret <- (KCConfig -> Path) -> ReaderT KCConfig (ExceptT KCError IO) Path
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks KCConfig -> Path
_confClientSecret
  let dat :: [FormParam]
dat = [ByteString
"client_id" ByteString -> Path -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Path
client, 
             ByteString
"client_secret" ByteString -> Path -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= Path
secret,
             ByteString
"grant_type" ByteString -> Path -> FormParam
forall v. FormValue v => ByteString -> v -> FormParam
:= (Path
"client_credentials" :: Text)]
  ByteString
body <- Path -> [FormParam] -> Keycloak ByteString
forall dat.
(Postable dat, Show dat) =>
Path -> dat -> Keycloak ByteString
keycloakPost' Path
"protocol/openid-connect/token" [FormParam]
dat
  case ByteString -> Either String TokenRep
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
body of
    Right TokenRep
ret -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak success: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (TokenRep -> String
forall a. Show a => a -> String
show TokenRep
ret) 
      ByteString -> Keycloak JWT
forall a e (m :: * -> *).
(FromCompact a, AsError e, MonadError e m) =>
ByteString -> m a
decodeCompact (ByteString -> Keycloak JWT) -> ByteString -> Keycloak JWT
forall a b. (a -> b) -> a -> b
$ Path -> ByteString
forall a b. ConvertibleStrings a b => a -> b
convertString (Path -> ByteString) -> Path -> ByteString
forall a b. (a -> b) -> a -> b
$ TokenRep -> Path
accessToken TokenRep
ret
    Left String
err2 -> do
      String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debug (String -> ReaderT KCConfig (ExceptT KCError IO) ())
-> String -> ReaderT KCConfig (ExceptT KCError IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Keycloak parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> String
forall a. Show a => a -> String
show String
err2) 
      KCError -> Keycloak JWT
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (KCError -> Keycloak JWT) -> KCError -> Keycloak JWT
forall a b. (a -> b) -> a -> b
$ Path -> KCError
ParseError (Path -> KCError) -> Path -> KCError
forall a b. (a -> b) -> a -> b
$ String -> Path
pack (String -> String
forall a. Show a => a -> String
show String
err2)


-- | Verify a JWT. If sucessful, the claims are returned. Otherwise, a JWTError is thrown. 
verifyJWT :: JWK -> JWT -> Keycloak ClaimsSet
verifyJWT :: JWK -> JWT -> Keycloak ClaimsSet
verifyJWT JWK
jwk JWT
jwt = JWTValidationSettings -> JWK -> JWT -> Keycloak ClaimsSet
forall (m :: * -> *) a e k.
(MonadTime m, HasAllowedSkew a, HasAudiencePredicate a,
 HasIssuerPredicate a, HasCheckIssuedAt a, HasValidationSettings a,
 AsError e, AsJWTError e, MonadError e m,
 VerificationKeyStore m (JWSHeader ()) ClaimsSet k) =>
a -> k -> JWT -> m ClaimsSet
verifyClaims ((StringOrURI -> Bool) -> JWTValidationSettings
defaultJWTValidationSettings (Bool -> StringOrURI -> Bool
forall a b. a -> b -> a
const Bool
True)) JWK
jwk JWT
jwt

-- | Extract the user identity from a token. Additional attributes can be encoded in the token.
getClaimsUser :: ClaimsSet -> User
getClaimsUser :: ClaimsSet -> User
getClaimsUser ClaimsSet
claims = User :: Maybe UserId
-> Path
-> Maybe Path
-> Maybe Path
-> Maybe Path
-> Maybe (HashMap Path Value)
-> User
User { userId :: Maybe UserId
userId          = UserId -> Maybe UserId
forall a. a -> Maybe a
Just (UserId -> Maybe UserId) -> UserId -> Maybe UserId
forall a b. (a -> b) -> a -> b
$ Path -> UserId
UserId (Path -> UserId) -> Path -> UserId
forall a b. (a -> b) -> a -> b
$ Getting Path ClaimsSet Path -> ClaimsSet -> Path
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Maybe StringOrURI -> Const Path (Maybe StringOrURI))
-> ClaimsSet -> Const Path ClaimsSet
Lens' ClaimsSet (Maybe StringOrURI)
claimSub ((Maybe StringOrURI -> Const Path (Maybe StringOrURI))
 -> ClaimsSet -> Const Path ClaimsSet)
-> ((Path -> Const Path Path)
    -> Maybe StringOrURI -> Const Path (Maybe StringOrURI))
-> Getting Path ClaimsSet Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StringOrURI -> Const Path StringOrURI)
-> Maybe StringOrURI -> Const Path (Maybe StringOrURI)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((StringOrURI -> Const Path StringOrURI)
 -> Maybe StringOrURI -> Const Path (Maybe StringOrURI))
-> ((Path -> Const Path Path)
    -> StringOrURI -> Const Path StringOrURI)
-> (Path -> Const Path Path)
-> Maybe StringOrURI
-> Const Path (Maybe StringOrURI)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path) -> StringOrURI -> Const Path StringOrURI
Prism' StringOrURI Path
string) ClaimsSet
claims
                            , userUsername :: Path
userUsername    = Getting Path ClaimsSet Path -> ClaimsSet -> Path
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((HashMap Path Value -> Const Path (HashMap Path Value))
-> ClaimsSet -> Const Path ClaimsSet
Lens' ClaimsSet (HashMap Path Value)
unregisteredClaims ((HashMap Path Value -> Const Path (HashMap Path Value))
 -> ClaimsSet -> Const Path ClaimsSet)
-> ((Path -> Const Path Path)
    -> HashMap Path Value -> Const Path (HashMap Path Value))
-> Getting Path ClaimsSet Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Path Value)
-> Lens'
     (HashMap Path Value) (Maybe (IxValue (HashMap Path Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Path Value)
"preferred_username" ((Maybe Value -> Const Path (Maybe Value))
 -> HashMap Path Value -> Const Path (HashMap Path Value))
-> ((Path -> Const Path Path)
    -> Maybe Value -> Const Path (Maybe Value))
-> (Path -> Const Path Path)
-> HashMap Path Value
-> Const Path (HashMap Path Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const Path Value)
-> Maybe Value -> Const Path (Maybe Value)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Value -> Const Path Value)
 -> Maybe Value -> Const Path (Maybe Value))
-> ((Path -> Const Path Path) -> Value -> Const Path Value)
-> (Path -> Const Path Path)
-> Maybe Value
-> Const Path (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const Path Path) -> Value -> Const Path Value
forall t. AsPrimitive t => Prism' t Path
_String) ClaimsSet
claims
                            , userFirstName :: Maybe Path
userFirstName   = Getting (First Path) ClaimsSet Path -> ClaimsSet -> Maybe Path
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> ClaimsSet -> Const (First Path) ClaimsSet
Lens' ClaimsSet (HashMap Path Value)
unregisteredClaims ((HashMap Path Value -> Const (First Path) (HashMap Path Value))
 -> ClaimsSet -> Const (First Path) ClaimsSet)
-> ((Path -> Const (First Path) Path)
    -> HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> Getting (First Path) ClaimsSet Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Path Value)
-> Lens'
     (HashMap Path Value) (Maybe (IxValue (HashMap Path Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Path Value)
"given_name" ((Maybe Value -> Const (First Path) (Maybe Value))
 -> HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> ((Path -> Const (First Path) Path)
    -> Maybe Value -> Const (First Path) (Maybe Value))
-> (Path -> Const (First Path) Path)
-> HashMap Path Value
-> Const (First Path) (HashMap Path Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (First Path) Value)
-> Maybe Value -> Const (First Path) (Maybe Value)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Value -> Const (First Path) Value)
 -> Maybe Value -> Const (First Path) (Maybe Value))
-> ((Path -> Const (First Path) Path)
    -> Value -> Const (First Path) Value)
-> (Path -> Const (First Path) Path)
-> Maybe Value
-> Const (First Path) (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (First Path) Path)
-> Value -> Const (First Path) Value
forall t. AsPrimitive t => Prism' t Path
_String) ClaimsSet
claims
                            , userLastName :: Maybe Path
userLastName    = Getting (First Path) ClaimsSet Path -> ClaimsSet -> Maybe Path
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> ClaimsSet -> Const (First Path) ClaimsSet
Lens' ClaimsSet (HashMap Path Value)
unregisteredClaims ((HashMap Path Value -> Const (First Path) (HashMap Path Value))
 -> ClaimsSet -> Const (First Path) ClaimsSet)
-> ((Path -> Const (First Path) Path)
    -> HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> Getting (First Path) ClaimsSet Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Path Value)
-> Lens'
     (HashMap Path Value) (Maybe (IxValue (HashMap Path Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Path Value)
"family_name" ((Maybe Value -> Const (First Path) (Maybe Value))
 -> HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> ((Path -> Const (First Path) Path)
    -> Maybe Value -> Const (First Path) (Maybe Value))
-> (Path -> Const (First Path) Path)
-> HashMap Path Value
-> Const (First Path) (HashMap Path Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (First Path) Value)
-> Maybe Value -> Const (First Path) (Maybe Value)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Value -> Const (First Path) Value)
 -> Maybe Value -> Const (First Path) (Maybe Value))
-> ((Path -> Const (First Path) Path)
    -> Value -> Const (First Path) Value)
-> (Path -> Const (First Path) Path)
-> Maybe Value
-> Const (First Path) (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (First Path) Path)
-> Value -> Const (First Path) Value
forall t. AsPrimitive t => Prism' t Path
_String) ClaimsSet
claims
                            , userEmail :: Maybe Path
userEmail       = Getting (First Path) ClaimsSet Path -> ClaimsSet -> Maybe Path
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> ClaimsSet -> Const (First Path) ClaimsSet
Lens' ClaimsSet (HashMap Path Value)
unregisteredClaims ((HashMap Path Value -> Const (First Path) (HashMap Path Value))
 -> ClaimsSet -> Const (First Path) ClaimsSet)
-> ((Path -> Const (First Path) Path)
    -> HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> Getting (First Path) ClaimsSet Path
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (HashMap Path Value)
-> Lens'
     (HashMap Path Value) (Maybe (IxValue (HashMap Path Value)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (HashMap Path Value)
"email" ((Maybe Value -> Const (First Path) (Maybe Value))
 -> HashMap Path Value -> Const (First Path) (HashMap Path Value))
-> ((Path -> Const (First Path) Path)
    -> Maybe Value -> Const (First Path) (Maybe Value))
-> (Path -> Const (First Path) Path)
-> HashMap Path Value
-> Const (First Path) (HashMap Path Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (First Path) Value)
-> Maybe Value -> Const (First Path) (Maybe Value)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Value -> Const (First Path) Value)
 -> Maybe Value -> Const (First Path) (Maybe Value))
-> ((Path -> Const (First Path) Path)
    -> Value -> Const (First Path) Value)
-> (Path -> Const (First Path) Path)
-> Maybe Value
-> Const (First Path) (Maybe Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path -> Const (First Path) Path)
-> Value -> Const (First Path) Value
forall t. AsPrimitive t => Prism' t Path
_String) ClaimsSet
claims
                            , userAttributes :: Maybe (HashMap Path Value)
userAttributes  = Getting (First (HashMap Path Value)) ClaimsSet (HashMap Path Value)
-> ClaimsSet -> Maybe (HashMap Path Value)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (HashMap Path Value)) ClaimsSet (HashMap Path Value)
Lens' ClaimsSet (HashMap Path Value)
unregisteredClaims ClaimsSet
claims}