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.
-- 
-- @
-- main :: IO ()
-- main = do
-- 
--   --configure Keycloak with the adapter config file. You can retrieve this file in your Client/Installation tab (JSON format).
--   --This function will also get the signing keys from Keycloak, so make sure that Keycloak is on and configured!
--   kcConfig <- configureKeycloak "keycloak.json"
--
--   void $ flip runKeycloak kcConfig $ do
--   
--     -- 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 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.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           Data.String.Conversions
import           Keycloak.Types
import           Keycloak.Utils
import           Network.Wreq as W hiding (statusCode)



-- | 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 <- view $ confAdapterConfig.confResource
  secret <- view $ confAdapterConfig.confCredentials.confSecret
  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 <- view $ confAdapterConfig.confResource
  secret <- view $ confAdapterConfig.confCredentials.confSecret
  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 :: JWT -> Keycloak ClaimsSet
verifyJWT jwt = do
  jwks <- view confJWKs
  verifyClaims (defaultJWTValidationSettings (const True)) (head jwks) 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}


-- | return JWKs from Keycloak. Its a set of keys that can be used to check signed tokens (JWTs)
-- This is done for you in the 'configureKeycloak' function. JWKs are stored in the Keycloak State Monad.
getJWKs :: Realm -> ServerURL -> IO [JWK]
getJWKs realm baseUrl = do
  let opts = W.defaults
  let url = (unpack $ baseUrl <> "/realms/" <> realm <> "/protocol/openid-connect/certs") 
  info $ "Issuing KEYCLOAK GET with url: " ++ (show url) 
  debug $ "  headers: " ++ (show $ opts ^. W.headers) 
  res <- W.getWith opts url
  let body = fromJust $ res ^? responseBody
  info $ show body
  case eitherDecode body of
     Right (JWKSet jwks) -> return jwks
     Left (err2 :: String) -> do
       debug $ "Keycloak parse error: " ++ (show err2) 
       error $ (show err2)