{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Security.AccessTokenProvider.Internal.Providers.Fixed
( probeProviderFixed
) where
import Control.Exception.Safe
import Control.Lens
import Control.Monad.IO.Class
import Data.Format
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Text.Encoding as Text
import qualified Security.AccessTokenProvider.Internal.Lenses as L
import Security.AccessTokenProvider.Internal.Types
import qualified Security.AccessTokenProvider.Internal.Types.Severity as Severity
import Security.AccessTokenProvider.Internal.Util
probeProviderFixed :: (MonadIO m, MonadCatch m) => AtpProbe m
probeProviderFixed = AtpProbe probeProvider
probeProvider
:: (MonadIO m, MonadThrow m)
=> Backend m
-> AccessTokenName
-> m (Maybe (AccessTokenProvider m t))
probeProvider backend tokenName = do
let BackendLog { .. } = backendLog backend
BackendEnv { .. } = backendEnv backend
logAddNamespace "probe-fixed" $ do
envLookup "ATP_CONF_FIXED" >>= \ case
Just confS -> do
logMsg Severity.Info [fmt|Trying access token provider 'fixed'|]
throwDecode (Text.encodeUtf8 confS) >>= tryCreateProvider backend tokenName
Nothing ->
pure Nothing
tryCreateProvider
:: Monad m
=> Backend m
-> AccessTokenName
-> AtpConfFixed
-> m (Maybe (AccessTokenProvider m t))
tryCreateProvider backend (AccessTokenName tokenName) conf =
let BackendLog { .. } = backendLog backend
tokensMap = fromMaybe Map.empty (conf^.L.tokens)
in case Map.lookup tokenName tokensMap of
Just token -> do
logMsg Severity.Info [fmt|AccessTokenProvider started|]
pure . Just $ AccessTokenProvider
{ retrieveAccessToken = pure (AccessToken token)
, releaseProvider = pure ()
}
Nothing ->
pure Nothing