Internal.hs

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE Rank2Types            #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}

module Security.AccessTokenProvider.Internal where

import           Control.Exception.Safe
import           Control.Monad.IO.Unlift
import           Data.List.NonEmpty                                           (NonEmpty (..))
import qualified Data.List.NonEmpty                                           as NonEmpty
import           Katip

import           Security.AccessTokenProvider.Internal.Providers.File
import           Security.AccessTokenProvider.Internal.Providers.Fixed
import           Security.AccessTokenProvider.Internal.Providers.OAuth2.Ropcg
import           Security.AccessTokenProvider.Internal.Types

namespace :: Namespace
namespace = "access-token-provider"

newWithProviders
  :: (MonadThrow m, KatipContext m)
  => NonEmpty (AtpProbe m)
  -> AccessTokenName
  -> m (AccessTokenProvider m t)
newWithProviders providers tokenName = katipAddNamespace namespace $
  probeProviders (NonEmpty.toList providers)

  where probeProviders [] =
          throwM $ AccessTokenProviderMissing tokenName
        probeProviders (AtpProbe tryProvider : rest) = do
          maybeProvider <- tryProvider tokenName
          case maybeProvider of
            Nothing ->
              probeProviders rest
            Just provider ->
              pure provider

new
  :: ( KatipContext m
     , MonadUnliftIO m
     , MonadMask m
     , MonadEnvironment m
     , MonadFilesystem m
     , MonadHttp m)
  => AccessTokenName -> m (AccessTokenProvider m t)
new = newWithProviders providers

  where providers =
          AtpProbe providerProbeFixed
          :| [ AtpProbe providerProbeFile
             , AtpProbe providerProbeRopcg ]