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

module Keycloak.Config where

import           Data.Aeson as JSON
import qualified Data.ByteString.Lazy as BL
import           Keycloak.Types
import           Keycloak.Tokens

-- | Read a configuration file.
-- This file can be found in Keycloak, in the Client Installation tab (JSON format).
readConfig :: FilePath -> IO AdapterConfig
readConfig :: FilePath -> IO AdapterConfig
readConfig FilePath
f = do
  ByteString
j <- FilePath -> IO ByteString
BL.readFile FilePath
f
  case ByteString -> Either FilePath AdapterConfig
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
j of
    Right AdapterConfig
c -> AdapterConfig -> IO AdapterConfig
forall (m :: * -> *) a. Monad m => a -> m a
return AdapterConfig
c
    Left FilePath
e -> FilePath -> IO AdapterConfig
forall a. HasCallStack => FilePath -> a
error FilePath
e

-- | Configure this library by reading the adapter JSON file, and getting signing keys from Keycloak.
-- The returned config can be used with 'runKeycloak' to run any function living in the 'Keycloak' Monad.
configureKeycloak :: FilePath -> IO KCConfig
configureKeycloak :: FilePath -> IO KCConfig
configureKeycloak FilePath
f = do
  AdapterConfig
adapterConf <- FilePath -> IO AdapterConfig
readConfig FilePath
f
  [JWK]
jwks <- Realm -> Realm -> IO [JWK]
getJWKs (AdapterConfig -> Realm
_confRealm AdapterConfig
adapterConf) (AdapterConfig -> Realm
_confAuthServerUrl AdapterConfig
adapterConf)
  KCConfig -> IO KCConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (KCConfig -> IO KCConfig) -> KCConfig -> IO KCConfig
forall a b. (a -> b) -> a -> b
$ AdapterConfig -> [JWK] -> KCConfig
KCConfig AdapterConfig
adapterConf [JWK]
jwks