Tokens.hs

{-# 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 = do
  body <- keycloakGet' ("protocol/openid-connect/certs")
  info $ show body
  (JWKSet jwks) <- case eitherDecode body of
     Right ret -> do
       return ret
     Left (err2 :: String) -> do
       debug $ "Keycloak parse error: " ++ (show err2) 
       throwError $ ParseError $ pack (show err2)
  return 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 username password = do 
  debug "Get user token"
  client <- asks _confClientId
  secret <- asks _confClientSecret
  let dat = ["client_id" := client, 
             "client_secret" := secret,
             "grant_type" := ("password" :: Text),
             "password" := password,
             "username" := username]
  body <- keycloakPost' "protocol/openid-connect/token" dat
  debug $ "Keycloak: " ++ (show body) 
  case eitherDecode body of
    Right ret -> do 
      debug $ "Keycloak success: " ++ (show ret) 
      decodeCompact $ convertString $ accessToken ret
    Left err2 -> do
      debug $ "Keycloak parse error: " ++ (show err2) 
      throwError $ ParseError $ pack (show 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 = do
  debug "Get client token"
  client <- asks _confClientId
  secret <- asks _confClientSecret
  let dat = ["client_id" := client, 
             "client_secret" := secret,
             "grant_type" := ("client_credentials" :: Text)]
  body <- keycloakPost' "protocol/openid-connect/token" dat
  case eitherDecode body of
    Right ret -> do
      debug $ "Keycloak success: " ++ (show ret) 
      decodeCompact $ convertString $ accessToken ret
    Left err2 -> do
      debug $ "Keycloak parse error: " ++ (show err2) 
      throwError $ ParseError $ pack (show err2)


-- | Verify a JWT. If sucessful, the claims are returned. Otherwise, a JWTError is thrown. 
verifyJWT :: JWK -> JWT -> Keycloak ClaimsSet
verifyJWT jwk jwt = verifyClaims (defaultJWTValidationSettings (const True)) jwk jwt

-- | Extract the user identity from a token. Additional attributes can be encoded in the token.
getClaimsUser :: ClaimsSet -> User
getClaimsUser claims = User { userId          = Just $ UserId $ view (claimSub . _Just . string) claims
                            , userUsername    = view (unregisteredClaims . at "preferred_username" . _Just . _String) claims
                            , userFirstName   = preview (unregisteredClaims . at "given_name" . _Just . _String) claims
                            , userLastName    = preview (unregisteredClaims . at "family_name" . _Just . _String) claims
                            , userEmail       = preview (unregisteredClaims . at "email" . _Just . _String) claims
                            , userAttributes  = preview unregisteredClaims claims}