{-# LANGUAGE BangPatterns #-}
module Amazonka.Auth
(
getAuth,
Credentials (..),
Auth (..),
envAccessKey,
envSecretKey,
envSessionToken,
envWebIdentityTokenFile,
envRole,
envRoleSessionName,
confRegion,
confFile,
credAccessKey,
credSecretKey,
credSessionToken,
credProfile,
credFile,
fromKeys,
fromSession,
fromTemporarySession,
fromEnv,
fromEnvKeys,
fromFile,
fromFilePath,
fromProfile,
fromProfileName,
fromContainer,
AccessKey (..),
SecretKey (..),
SessionToken (..),
AsAuthError (..),
AuthError (..),
Env' (..),
)
where
import Amazonka.Data
import Amazonka.EC2.Metadata
import {-# SOURCE #-} Amazonka.HTTP (retryRequest)
import Amazonka.Lens (catching, catching_, exception, prism, throwingM, _IOException)
import Amazonka.Prelude
import qualified Amazonka.STS as STS
import qualified Amazonka.STS.AssumeRoleWithWebIdentity as STS
import Amazonka.Types
import Control.Concurrent (ThreadId)
import qualified Control.Concurrent as Concurrent
import qualified Control.Exception as Exception
import Control.Lens ((^.))
import Control.Monad.Trans.Maybe (MaybeT (..))
import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as LBS8
import qualified Data.Char as Char
import Data.IORef (IORef)
import qualified Data.IORef as IORef
import qualified Data.Ini as INI
import Data.Monoid (Dual, Endo)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.IO as Text
import qualified Data.Time as Time
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as UUID
import qualified Network.HTTP.Client as Client
import qualified System.Directory as Directory
import qualified System.Environment as Environment
import System.Mem.Weak (Weak)
import qualified System.Mem.Weak as Weak
envAccessKey ::
Text
envAccessKey :: Text
envAccessKey = Text
"AWS_ACCESS_KEY_ID"
envSecretKey ::
Text
envSecretKey :: Text
envSecretKey = Text
"AWS_SECRET_ACCESS_KEY"
envSessionToken ::
Text
envSessionToken :: Text
envSessionToken = Text
"AWS_SESSION_TOKEN"
envProfile ::
Text
envProfile :: Text
envProfile = Text
"AWS_PROFILE"
envRegion ::
Text
envRegion :: Text
envRegion = Text
"AWS_REGION"
envWebIdentityTokenFile ::
Text
envWebIdentityTokenFile :: Text
envWebIdentityTokenFile = Text
"AWS_WEB_IDENTITY_TOKEN_FILE"
envRole ::
Text
envRole :: Text
envRole = Text
"AWS_ROLE_ARN"
envRoleSessionName ::
Text
envRoleSessionName :: Text
envRoleSessionName = Text
"AWS_ROLE_SESSION_NAME"
envContainerCredentialsURI ::
Text
envContainerCredentialsURI :: Text
envContainerCredentialsURI = Text
"AWS_CONTAINER_CREDENTIALS_RELATIVE_URI"
credAccessKey ::
Text
credAccessKey :: Text
credAccessKey = Text
"aws_access_key_id"
credSecretKey ::
Text
credSecretKey :: Text
credSecretKey = Text
"aws_secret_access_key"
credSessionToken ::
Text
credSessionToken :: Text
credSessionToken = Text
"aws_session_token"
credProfile ::
Text
credProfile :: Text
credProfile = Text
"default"
credFile :: MonadIO m => m FilePath
credFile :: m FilePath
credFile = IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Getting (First IOException) SomeException IOException
-> IO FilePath -> IO FilePath -> IO FilePath
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
catching_ Getting (First IOException) SomeException IOException
forall t. AsIOException t => Prism' t IOException
_IOException IO FilePath
dir IO FilePath
err)
where
dir :: IO FilePath
dir = (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
Directory.getHomeDirectory
err :: IO FilePath
err = AuthError -> IO FilePath
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO FilePath) -> AuthError -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> AuthError
MissingFileError (FilePath
"$HOME" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path)
path :: FilePath
path = FilePath
"/.aws/credentials"
confRegion ::
Text
confRegion :: Text
confRegion = Text
"region"
confFile :: MonadIO m => m FilePath
confFile :: m FilePath
confFile = IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Getting (First IOException) SomeException IOException
-> IO FilePath -> IO FilePath -> IO FilePath
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
catching_ Getting (First IOException) SomeException IOException
forall t. AsIOException t => Prism' t IOException
_IOException IO FilePath
dir IO FilePath
err)
where
dir :: IO FilePath
dir = (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath -> IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO FilePath
Directory.getHomeDirectory
err :: IO FilePath
err = AuthError -> IO FilePath
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO FilePath) -> AuthError -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> AuthError
MissingFileError (FilePath
"$HOME" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path)
path :: FilePath
path = FilePath
"/.aws/config"
fromKeys :: AccessKey -> SecretKey -> Auth
fromKeys :: AccessKey -> SecretKey -> Auth
fromKeys AccessKey
a SecretKey
s = AuthEnv -> Auth
Auth (AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv AccessKey
a (SecretKey -> Sensitive SecretKey
forall a. a -> Sensitive a
Sensitive SecretKey
s) Maybe (Sensitive SessionToken)
forall a. Maybe a
Nothing Maybe ISO8601
forall a. Maybe a
Nothing)
fromSession :: AccessKey -> SecretKey -> SessionToken -> Auth
fromSession :: AccessKey -> SecretKey -> SessionToken -> Auth
fromSession AccessKey
a SecretKey
s SessionToken
t =
AuthEnv -> Auth
Auth (AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv AccessKey
a (SecretKey -> Sensitive SecretKey
forall a. a -> Sensitive a
Sensitive SecretKey
s) (Sensitive SessionToken -> Maybe (Sensitive SessionToken)
forall a. a -> Maybe a
Just (SessionToken -> Sensitive SessionToken
forall a. a -> Sensitive a
Sensitive SessionToken
t)) Maybe ISO8601
forall a. Maybe a
Nothing)
fromTemporarySession ::
AccessKey ->
SecretKey ->
SessionToken ->
UTCTime ->
Auth
fromTemporarySession :: AccessKey -> SecretKey -> SessionToken -> UTCTime -> Auth
fromTemporarySession AccessKey
a SecretKey
s SessionToken
t UTCTime
e =
AuthEnv -> Auth
Auth (AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv AccessKey
a (SecretKey -> Sensitive SecretKey
forall a. a -> Sensitive a
Sensitive SecretKey
s) (Sensitive SessionToken -> Maybe (Sensitive SessionToken)
forall a. a -> Maybe a
Just (SessionToken -> Sensitive SessionToken
forall a. a -> Sensitive a
Sensitive SessionToken
t)) (ISO8601 -> Maybe ISO8601
forall a. a -> Maybe a
Just (UTCTime -> ISO8601
forall (a :: Format). UTCTime -> Time a
Time UTCTime
e)))
data Credentials
=
FromKeys AccessKey SecretKey
|
FromSession AccessKey SecretKey SessionToken
|
FromEnv Text Text (Maybe Text) (Maybe Text)
|
FromProfile Text
|
FromFile Text FilePath FilePath
|
FromWebIdentity
|
FromContainer
|
Discover
deriving stock (Credentials -> Credentials -> Bool
(Credentials -> Credentials -> Bool)
-> (Credentials -> Credentials -> Bool) -> Eq Credentials
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credentials -> Credentials -> Bool
$c/= :: Credentials -> Credentials -> Bool
== :: Credentials -> Credentials -> Bool
$c== :: Credentials -> Credentials -> Bool
Eq, (forall x. Credentials -> Rep Credentials x)
-> (forall x. Rep Credentials x -> Credentials)
-> Generic Credentials
forall x. Rep Credentials x -> Credentials
forall x. Credentials -> Rep Credentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Credentials x -> Credentials
$cfrom :: forall x. Credentials -> Rep Credentials x
Generic)
instance ToLog Credentials where
build :: Credentials -> ByteStringBuilder
build = \case
FromKeys AccessKey
a SecretKey
_ ->
ByteStringBuilder
"FromKeys " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> AccessKey -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build AccessKey
a ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" ****"
FromSession AccessKey
a SecretKey
_ SessionToken
_ ->
ByteStringBuilder
"FromSession " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> AccessKey -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build AccessKey
a ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" **** ****"
FromEnv Text
a Text
s Maybe Text
t Maybe Text
r ->
ByteStringBuilder
"FromEnv " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
a ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
s ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> ByteStringBuilder
forall a. ToLog a => Maybe a -> ByteStringBuilder
m Maybe Text
t ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Maybe Text -> ByteStringBuilder
forall a. ToLog a => Maybe a -> ByteStringBuilder
m Maybe Text
r
FromProfile Text
n ->
ByteStringBuilder
"FromProfile " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
n
FromFile Text
n FilePath
f FilePath
g ->
ByteStringBuilder
"FromFile " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
n ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> FilePath -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build FilePath
f ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
" " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> FilePath -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build FilePath
g
Credentials
FromWebIdentity ->
ByteStringBuilder
"FromWebIdentity"
Credentials
FromContainer ->
ByteStringBuilder
"FromContainer"
Credentials
Discover ->
ByteStringBuilder
"Discover"
where
m :: Maybe a -> ByteStringBuilder
m (Just a
x) = ByteStringBuilder
"(Just " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> a -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build a
x ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
")"
m Maybe a
Nothing = ByteStringBuilder
"Nothing"
instance Show Credentials where
show :: Credentials -> FilePath
show = ByteString -> FilePath
BS8.unpack (ByteString -> FilePath)
-> (Credentials -> ByteString) -> Credentials -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStringBuilder -> ByteString
forall a. ToByteString a => a -> ByteString
toBS (ByteStringBuilder -> ByteString)
-> (Credentials -> ByteStringBuilder) -> Credentials -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credentials -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build
data AuthError
= RetrievalError HttpException
| MissingEnvError Text
| InvalidEnvError Text
| MissingFileError FilePath
| InvalidFileError Text
| InvalidIAMError Text
deriving stock (Int -> AuthError -> FilePath -> FilePath
[AuthError] -> FilePath -> FilePath
AuthError -> FilePath
(Int -> AuthError -> FilePath -> FilePath)
-> (AuthError -> FilePath)
-> ([AuthError] -> FilePath -> FilePath)
-> Show AuthError
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [AuthError] -> FilePath -> FilePath
$cshowList :: [AuthError] -> FilePath -> FilePath
show :: AuthError -> FilePath
$cshow :: AuthError -> FilePath
showsPrec :: Int -> AuthError -> FilePath -> FilePath
$cshowsPrec :: Int -> AuthError -> FilePath -> FilePath
Show, (forall x. AuthError -> Rep AuthError x)
-> (forall x. Rep AuthError x -> AuthError) -> Generic AuthError
forall x. Rep AuthError x -> AuthError
forall x. AuthError -> Rep AuthError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AuthError x -> AuthError
$cfrom :: forall x. AuthError -> Rep AuthError x
Generic)
instance Exception AuthError
instance ToLog AuthError where
build :: AuthError -> ByteStringBuilder
build = \case
RetrievalError HttpException
e -> HttpException -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build HttpException
e
MissingEnvError Text
e -> ByteStringBuilder
"[MissingEnvError] { message = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
e ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
InvalidEnvError Text
e -> ByteStringBuilder
"[InvalidEnvError] { message = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
e ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
MissingFileError FilePath
f -> ByteStringBuilder
"[MissingFileError] { path = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> FilePath -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build FilePath
f ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
InvalidFileError Text
e -> ByteStringBuilder
"[InvalidFileError] { message = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
e ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
InvalidIAMError Text
e -> ByteStringBuilder
"[InvalidIAMError] { message = " ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> Text -> ByteStringBuilder
forall a. ToLog a => a -> ByteStringBuilder
build Text
e ByteStringBuilder -> ByteStringBuilder -> ByteStringBuilder
forall a. Semigroup a => a -> a -> a
<> ByteStringBuilder
"}"
class AsAuthError a where
_AuthError :: Prism' a AuthError
{-# MINIMAL _AuthError #-}
_RetrievalError :: Prism' a HttpException
_MissingEnvError :: Prism' a Text
_InvalidEnvError :: Prism' a Text
_MissingFileError :: Prism' a FilePath
_InvalidFileError :: Prism' a Text
_InvalidIAMError :: Prism' a Text
_RetrievalError = p AuthError (f AuthError) -> p a (f a)
forall a. AsAuthError a => Prism' a AuthError
_AuthError (p AuthError (f AuthError) -> p a (f a))
-> (p HttpException (f HttpException) -> p AuthError (f AuthError))
-> p HttpException (f HttpException)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p HttpException (f HttpException) -> p AuthError (f AuthError)
forall a. AsAuthError a => Prism' a HttpException
_RetrievalError
_MissingEnvError = p AuthError (f AuthError) -> p a (f a)
forall a. AsAuthError a => Prism' a AuthError
_AuthError (p AuthError (f AuthError) -> p a (f a))
-> (p Text (f Text) -> p AuthError (f AuthError))
-> p Text (f Text)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p AuthError (f AuthError)
forall a. AsAuthError a => Prism' a Text
_MissingEnvError
_InvalidEnvError = p AuthError (f AuthError) -> p a (f a)
forall a. AsAuthError a => Prism' a AuthError
_AuthError (p AuthError (f AuthError) -> p a (f a))
-> (p Text (f Text) -> p AuthError (f AuthError))
-> p Text (f Text)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p AuthError (f AuthError)
forall a. AsAuthError a => Prism' a Text
_InvalidEnvError
_MissingFileError = p AuthError (f AuthError) -> p a (f a)
forall a. AsAuthError a => Prism' a AuthError
_AuthError (p AuthError (f AuthError) -> p a (f a))
-> (p FilePath (f FilePath) -> p AuthError (f AuthError))
-> p FilePath (f FilePath)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p FilePath (f FilePath) -> p AuthError (f AuthError)
forall a. AsAuthError a => Prism' a FilePath
_MissingFileError
_InvalidFileError = p AuthError (f AuthError) -> p a (f a)
forall a. AsAuthError a => Prism' a AuthError
_AuthError (p AuthError (f AuthError) -> p a (f a))
-> (p Text (f Text) -> p AuthError (f AuthError))
-> p Text (f Text)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p AuthError (f AuthError)
forall a. AsAuthError a => Prism' a Text
_InvalidFileError
_InvalidIAMError = p AuthError (f AuthError) -> p a (f a)
forall a. AsAuthError a => Prism' a AuthError
_AuthError (p AuthError (f AuthError) -> p a (f a))
-> (p Text (f Text) -> p AuthError (f AuthError))
-> p Text (f Text)
-> p a (f a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p Text (f Text) -> p AuthError (f AuthError)
forall a. AsAuthError a => Prism' a Text
_InvalidIAMError
instance AsAuthError SomeException where
_AuthError :: p AuthError (f AuthError) -> p SomeException (f SomeException)
_AuthError = p AuthError (f AuthError) -> p SomeException (f SomeException)
forall a. Exception a => Prism' SomeException a
exception
instance AsAuthError AuthError where
_AuthError :: p AuthError (f AuthError) -> p AuthError (f AuthError)
_AuthError = p AuthError (f AuthError) -> p AuthError (f AuthError)
forall a. a -> a
id
_RetrievalError :: p HttpException (f HttpException) -> p AuthError (f AuthError)
_RetrievalError = (HttpException -> AuthError)
-> (AuthError -> Either AuthError HttpException)
-> Prism' AuthError HttpException
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism HttpException -> AuthError
RetrievalError ((AuthError -> Either AuthError HttpException)
-> Prism' AuthError HttpException)
-> (AuthError -> Either AuthError HttpException)
-> Prism' AuthError HttpException
forall a b. (a -> b) -> a -> b
$ \case
RetrievalError HttpException
e -> HttpException -> Either AuthError HttpException
forall a b. b -> Either a b
Right HttpException
e
AuthError
x -> AuthError -> Either AuthError HttpException
forall a b. a -> Either a b
Left AuthError
x
_MissingEnvError :: p Text (f Text) -> p AuthError (f AuthError)
_MissingEnvError = (Text -> AuthError)
-> (AuthError -> Either AuthError Text) -> Prism' AuthError Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> AuthError
MissingEnvError ((AuthError -> Either AuthError Text) -> Prism' AuthError Text)
-> (AuthError -> Either AuthError Text) -> Prism' AuthError Text
forall a b. (a -> b) -> a -> b
$ \case
MissingEnvError Text
e -> Text -> Either AuthError Text
forall a b. b -> Either a b
Right Text
e
AuthError
x -> AuthError -> Either AuthError Text
forall a b. a -> Either a b
Left AuthError
x
_InvalidEnvError :: p Text (f Text) -> p AuthError (f AuthError)
_InvalidEnvError = (Text -> AuthError)
-> (AuthError -> Either AuthError Text) -> Prism' AuthError Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> AuthError
InvalidEnvError ((AuthError -> Either AuthError Text) -> Prism' AuthError Text)
-> (AuthError -> Either AuthError Text) -> Prism' AuthError Text
forall a b. (a -> b) -> a -> b
$ \case
InvalidEnvError Text
e -> Text -> Either AuthError Text
forall a b. b -> Either a b
Right Text
e
AuthError
x -> AuthError -> Either AuthError Text
forall a b. a -> Either a b
Left AuthError
x
_MissingFileError :: p FilePath (f FilePath) -> p AuthError (f AuthError)
_MissingFileError = (FilePath -> AuthError)
-> (AuthError -> Either AuthError FilePath)
-> Prism' AuthError FilePath
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism FilePath -> AuthError
MissingFileError ((AuthError -> Either AuthError FilePath)
-> Prism' AuthError FilePath)
-> (AuthError -> Either AuthError FilePath)
-> Prism' AuthError FilePath
forall a b. (a -> b) -> a -> b
$ \case
MissingFileError FilePath
f -> FilePath -> Either AuthError FilePath
forall a b. b -> Either a b
Right FilePath
f
AuthError
x -> AuthError -> Either AuthError FilePath
forall a b. a -> Either a b
Left AuthError
x
_InvalidFileError :: p Text (f Text) -> p AuthError (f AuthError)
_InvalidFileError = (Text -> AuthError)
-> (AuthError -> Either AuthError Text) -> Prism' AuthError Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> AuthError
InvalidFileError ((AuthError -> Either AuthError Text) -> Prism' AuthError Text)
-> (AuthError -> Either AuthError Text) -> Prism' AuthError Text
forall a b. (a -> b) -> a -> b
$ \case
InvalidFileError Text
e -> Text -> Either AuthError Text
forall a b. b -> Either a b
Right Text
e
AuthError
x -> AuthError -> Either AuthError Text
forall a b. a -> Either a b
Left AuthError
x
_InvalidIAMError :: p Text (f Text) -> p AuthError (f AuthError)
_InvalidIAMError = (Text -> AuthError)
-> (AuthError -> Either AuthError Text) -> Prism' AuthError Text
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism Text -> AuthError
InvalidIAMError ((AuthError -> Either AuthError Text) -> Prism' AuthError Text)
-> (AuthError -> Either AuthError Text) -> Prism' AuthError Text
forall a b. (a -> b) -> a -> b
$ \case
InvalidIAMError Text
e -> Text -> Either AuthError Text
forall a b. b -> Either a b
Right Text
e
AuthError
x -> AuthError -> Either AuthError Text
forall a b. a -> Either a b
Left AuthError
x
getAuth ::
(MonadIO m, Foldable withAuth) =>
Env' withAuth ->
Credentials ->
m (Auth, Maybe Region)
getAuth :: Env' withAuth -> Credentials -> m (Auth, Maybe Region)
getAuth env :: Env' withAuth
env@Env {withAuth Auth
Dual (Endo Service)
Manager
Region
Int -> HttpException -> Bool
Logger
$sel:_envAuth:Env :: forall (withAuth :: * -> *). Env' withAuth -> withAuth Auth
$sel:_envManager:Env :: forall (withAuth :: * -> *). Env' withAuth -> Manager
$sel:_envOverride:Env :: forall (withAuth :: * -> *). Env' withAuth -> Dual (Endo Service)
$sel:_envRetryCheck:Env :: forall (withAuth :: * -> *).
Env' withAuth -> Int -> HttpException -> Bool
$sel:_envLogger:Env :: forall (withAuth :: * -> *). Env' withAuth -> Logger
$sel:_envRegion:Env :: forall (withAuth :: * -> *). Env' withAuth -> Region
_envAuth :: withAuth Auth
_envManager :: Manager
_envOverride :: Dual (Endo Service)
_envRetryCheck :: Int -> HttpException -> Bool
_envLogger :: Logger
_envRegion :: Region
..} =
IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Auth, Maybe Region) -> m (Auth, Maybe Region))
-> (Credentials -> IO (Auth, Maybe Region))
-> Credentials
-> m (Auth, Maybe Region)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
FromKeys AccessKey
a SecretKey
s -> (Auth, Maybe Region) -> IO (Auth, Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AccessKey -> SecretKey -> Auth
fromKeys AccessKey
a SecretKey
s, Maybe Region
forall a. Maybe a
Nothing)
FromSession AccessKey
a SecretKey
s SessionToken
t -> (Auth, Maybe Region) -> IO (Auth, Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AccessKey -> SecretKey -> SessionToken -> Auth
fromSession AccessKey
a SecretKey
s SessionToken
t, Maybe Region
forall a. Maybe a
Nothing)
FromEnv Text
a Text
s Maybe Text
t Maybe Text
r -> Text -> Text -> Maybe Text -> Maybe Text -> IO (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> Maybe Text -> Maybe Text -> m (Auth, Maybe Region)
fromEnvKeys Text
a Text
s Maybe Text
t Maybe Text
r
FromProfile Text
n -> Manager -> Text -> IO (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Manager -> Text -> m (Auth, Maybe Region)
fromProfileName Manager
_envManager Text
n
FromFile Text
n FilePath
cred FilePath
conf -> Text -> FilePath -> FilePath -> IO (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Text -> FilePath -> FilePath -> m (Auth, Maybe Region)
fromFilePath Text
n FilePath
cred FilePath
conf
Credentials
FromContainer -> Manager -> IO (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Manager -> m (Auth, Maybe Region)
fromContainer Manager
_envManager
Credentials
FromWebIdentity -> Env' withAuth -> IO (Auth, Maybe Region)
forall (m :: * -> *) (withAuth :: * -> *).
(MonadIO m, Foldable withAuth) =>
Env' withAuth -> m (Auth, Maybe Region)
fromWebIdentity Env' withAuth
env
Credentials
Discover ->
Getting (First Text) SomeException Text
-> IO (Auth, Maybe Region)
-> IO (Auth, Maybe Region)
-> IO (Auth, Maybe Region)
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
catching_ Getting (First Text) SomeException Text
forall a. AsAuthError a => Prism' a Text
_MissingEnvError IO (Auth, Maybe Region)
forall (m :: * -> *). MonadIO m => m (Auth, Maybe Region)
fromEnv (IO (Auth, Maybe Region) -> IO (Auth, Maybe Region))
-> IO (Auth, Maybe Region) -> IO (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$
Getting (First FilePath) SomeException FilePath
-> IO (Auth, Maybe Region)
-> (FilePath -> IO (Auth, Maybe Region))
-> IO (Auth, Maybe Region)
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> (a -> m r) -> m r
catching Getting (First FilePath) SomeException FilePath
forall a. AsAuthError a => Prism' a FilePath
_MissingFileError IO (Auth, Maybe Region)
forall (m :: * -> *). MonadIO m => m (Auth, Maybe Region)
fromFile ((FilePath -> IO (Auth, Maybe Region)) -> IO (Auth, Maybe Region))
-> (FilePath -> IO (Auth, Maybe Region)) -> IO (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$ \FilePath
f ->
Getting (First Text) SomeException Text
-> IO (Auth, Maybe Region)
-> IO (Auth, Maybe Region)
-> IO (Auth, Maybe Region)
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
catching_ Getting (First Text) SomeException Text
forall a. AsAuthError a => Prism' a Text
_MissingEnvError (Env' withAuth -> IO (Auth, Maybe Region)
forall (m :: * -> *) (withAuth :: * -> *).
(MonadIO m, Foldable withAuth) =>
Env' withAuth -> m (Auth, Maybe Region)
fromWebIdentity Env' withAuth
env) (IO (Auth, Maybe Region) -> IO (Auth, Maybe Region))
-> IO (Auth, Maybe Region) -> IO (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$
Getting (First Text) SomeException Text
-> IO (Auth, Maybe Region)
-> IO (Auth, Maybe Region)
-> IO (Auth, Maybe Region)
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
catching_ Getting (First Text) SomeException Text
forall a. AsAuthError a => Prism' a Text
_MissingEnvError (Manager -> IO (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Manager -> m (Auth, Maybe Region)
fromContainer Manager
_envManager) (IO (Auth, Maybe Region) -> IO (Auth, Maybe Region))
-> IO (Auth, Maybe Region) -> IO (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$ do
Bool
p <- Manager -> IO Bool
forall (m :: * -> *). MonadIO m => Manager -> m Bool
isEC2 Manager
_envManager
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
p (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
AReview SomeException FilePath -> FilePath -> IO ()
forall (m :: * -> *) b r.
MonadThrow m =>
AReview SomeException b -> b -> m r
throwingM AReview SomeException FilePath
forall a. AsAuthError a => Prism' a FilePath
_MissingFileError FilePath
f
Manager -> IO (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Manager -> m (Auth, Maybe Region)
fromProfile Manager
_envManager
fromEnv :: MonadIO m => m (Auth, Maybe Region)
fromEnv :: m (Auth, Maybe Region)
fromEnv =
Text -> Text -> Maybe Text -> Maybe Text -> m (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Text -> Text -> Maybe Text -> Maybe Text -> m (Auth, Maybe Region)
fromEnvKeys
Text
envAccessKey
Text
envSecretKey
(Text -> Maybe Text
forall a. a -> Maybe a
Just Text
envSessionToken)
(Text -> Maybe Text
forall a. a -> Maybe a
Just Text
envRegion)
fromEnvKeys ::
MonadIO m =>
Text ->
Text ->
Maybe Text ->
Maybe Text ->
m (Auth, Maybe Region)
fromEnvKeys :: Text -> Text -> Maybe Text -> Maybe Text -> m (Auth, Maybe Region)
fromEnvKeys Text
access Text
secret Maybe Text
session Maybe Text
region' =
IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Auth, Maybe Region) -> m (Auth, Maybe Region))
-> IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$ (,) (Auth -> Maybe Region -> (Auth, Maybe Region))
-> IO Auth -> IO (Maybe Region -> (Auth, Maybe Region))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AuthEnv -> Auth) -> IO AuthEnv -> IO Auth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AuthEnv -> Auth
Auth IO AuthEnv
lookupKeys IO (Maybe Region -> (Auth, Maybe Region))
-> IO (Maybe Region) -> IO (Auth, Maybe Region)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (Maybe Region)
lookupRegion
where
lookupKeys :: IO AuthEnv
lookupKeys =
AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv
(AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv)
-> IO AccessKey
-> IO
(Sensitive SecretKey
-> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> IO FilePath
forall (m :: * -> *). MonadIO m => Text -> m FilePath
reqEnv Text
access IO FilePath -> (FilePath -> AccessKey) -> IO AccessKey
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> AccessKey
AccessKey (ByteString -> AccessKey)
-> (FilePath -> ByteString) -> FilePath -> AccessKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BS8.pack)
IO
(Sensitive SecretKey
-> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> IO (Sensitive SecretKey)
-> IO (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> IO FilePath
forall (m :: * -> *). MonadIO m => Text -> m FilePath
reqEnv Text
secret IO FilePath
-> (FilePath -> Sensitive SecretKey) -> IO (Sensitive SecretKey)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SecretKey -> Sensitive SecretKey
forall a. a -> Sensitive a
Sensitive (SecretKey -> Sensitive SecretKey)
-> (FilePath -> SecretKey) -> FilePath -> Sensitive SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
SecretKey (ByteString -> SecretKey)
-> (FilePath -> ByteString) -> FilePath -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BS8.pack)
IO (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> IO (Maybe (Sensitive SessionToken))
-> IO (Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Text -> IO (Maybe FilePath)
opt Maybe Text
session IO (Maybe FilePath)
-> (Maybe FilePath -> Maybe (Sensitive SessionToken))
-> IO (Maybe (Sensitive SessionToken))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (FilePath -> Sensitive SessionToken)
-> Maybe FilePath -> Maybe (Sensitive SessionToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SessionToken -> Sensitive SessionToken
forall a. a -> Sensitive a
Sensitive (SessionToken -> Sensitive SessionToken)
-> (FilePath -> SessionToken) -> FilePath -> Sensitive SessionToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SessionToken
SessionToken (ByteString -> SessionToken)
-> (FilePath -> ByteString) -> FilePath -> SessionToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString
BS8.pack))
IO (Maybe ISO8601 -> AuthEnv) -> IO (Maybe ISO8601) -> IO AuthEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ISO8601 -> IO (Maybe ISO8601)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ISO8601
forall a. Maybe a
Nothing
lookupRegion :: IO (Maybe Region)
lookupRegion = Maybe Text -> IO (Maybe FilePath)
opt Maybe Text
region' IO (Maybe FilePath)
-> (Maybe FilePath -> Maybe Region) -> IO (Maybe Region)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (FilePath -> Region) -> Maybe FilePath -> Maybe Region
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Region
Region' (Text -> Region) -> (FilePath -> Text) -> FilePath -> Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack)
opt :: Maybe Text -> IO (Maybe FilePath)
opt = \case
Maybe Text
Nothing -> Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
Just Text
k -> FilePath -> IO (Maybe FilePath)
Environment.lookupEnv (Text -> FilePath
Text.unpack Text
k)
fromFile :: MonadIO m => m (Auth, Maybe Region)
fromFile :: m (Auth, Maybe Region)
fromFile = do
Maybe FilePath
mprofile <- IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO (Maybe FilePath)
Environment.lookupEnv (Text -> FilePath
Text.unpack Text
envProfile))
FilePath
cred <- m FilePath
forall (m :: * -> *). MonadIO m => m FilePath
credFile
FilePath
conf <- m FilePath
forall (m :: * -> *). MonadIO m => m FilePath
confFile
Text -> FilePath -> FilePath -> m (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Text -> FilePath -> FilePath -> m (Auth, Maybe Region)
fromFilePath (Text -> (FilePath -> Text) -> Maybe FilePath -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
credProfile FilePath -> Text
Text.pack Maybe FilePath
mprofile) FilePath
cred FilePath
conf
fromFilePath ::
MonadIO m =>
Text ->
FilePath ->
FilePath ->
m (Auth, Maybe Region)
fromFilePath :: Text -> FilePath -> FilePath -> m (Auth, Maybe Region)
fromFilePath Text
profile FilePath
cred FilePath
conf =
IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((,) (Auth -> Maybe Region -> (Auth, Maybe Region))
-> IO Auth -> IO (Maybe Region -> (Auth, Maybe Region))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Auth
lookupCredentials FilePath
cred IO (Maybe Region -> (Auth, Maybe Region))
-> IO (Maybe Region) -> IO (Auth, Maybe Region)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO (Maybe Region)
lookupRegion FilePath
conf)
where
lookupCredentials :: FilePath -> IO Auth
lookupCredentials FilePath
path = do
Bool
exists <- FilePath -> IO Bool
Directory.doesFileExist FilePath
path
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
AuthError -> IO ()
forall e a. Exception e => e -> IO a
Exception.throwIO (FilePath -> AuthError
MissingFileError FilePath
path)
Ini
ini <- FilePath -> IO (Either FilePath Ini)
INI.readIniFile FilePath
path IO (Either FilePath Ini)
-> (Either FilePath Ini -> IO Ini) -> IO Ini
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Ini)
-> (Ini -> IO Ini) -> Either FilePath Ini -> IO Ini
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Maybe Text -> FilePath -> IO Ini
forall a. FilePath -> Maybe Text -> FilePath -> IO a
throwInvalid FilePath
path Maybe Text
forall a. Maybe a
Nothing) Ini -> IO Ini
forall (f :: * -> *) a. Applicative f => a -> f a
pure
AuthEnv
env <-
AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv
(AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv)
-> IO AccessKey
-> IO
(Sensitive SecretKey
-> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Text -> Ini -> IO ByteString
required FilePath
path Text
credAccessKey Ini
ini IO ByteString -> (ByteString -> AccessKey) -> IO AccessKey
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> AccessKey
AccessKey)
IO
(Sensitive SecretKey
-> Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> IO (Sensitive SecretKey)
-> IO (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (FilePath -> Text -> Ini -> IO ByteString
required FilePath
path Text
credSecretKey Ini
ini IO ByteString
-> (ByteString -> Sensitive SecretKey) -> IO (Sensitive SecretKey)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SecretKey -> Sensitive SecretKey
forall a. a -> Sensitive a
Sensitive (SecretKey -> Sensitive SecretKey)
-> (ByteString -> SecretKey) -> ByteString -> Sensitive SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
SecretKey)
IO (Maybe (Sensitive SessionToken) -> Maybe ISO8601 -> AuthEnv)
-> IO (Maybe (Sensitive SessionToken))
-> IO (Maybe ISO8601 -> AuthEnv)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Ini -> IO (Maybe ByteString)
optional Text
credSessionToken Ini
ini IO (Maybe ByteString)
-> (Maybe ByteString -> Maybe (Sensitive SessionToken))
-> IO (Maybe (Sensitive SessionToken))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ByteString -> Sensitive SessionToken)
-> Maybe ByteString -> Maybe (Sensitive SessionToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SessionToken -> Sensitive SessionToken
forall a. a -> Sensitive a
Sensitive (SessionToken -> Sensitive SessionToken)
-> (ByteString -> SessionToken)
-> ByteString
-> Sensitive SessionToken
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SessionToken
SessionToken))
IO (Maybe ISO8601 -> AuthEnv) -> IO (Maybe ISO8601) -> IO AuthEnv
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe ISO8601 -> IO (Maybe ISO8601)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ISO8601
forall a. Maybe a
Nothing
Auth -> IO Auth
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthEnv -> Auth
Auth AuthEnv
env)
lookupRegion :: FilePath -> IO (Maybe Region)
lookupRegion FilePath
path = do
Bool
exists <- FilePath -> IO Bool
Directory.doesFileExist FilePath
path
if Bool -> Bool
not Bool
exists
then Maybe Region -> IO (Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Region
forall a. Maybe a
Nothing
else do
Ini
ini <- FilePath -> IO (Either FilePath Ini)
INI.readIniFile FilePath
path IO (Either FilePath Ini)
-> (Either FilePath Ini -> IO Ini) -> IO Ini
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Ini)
-> (Ini -> IO Ini) -> Either FilePath Ini -> IO Ini
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Maybe Text -> FilePath -> IO Ini
forall a. FilePath -> Maybe Text -> FilePath -> IO a
throwInvalid FilePath
path Maybe Text
forall a. Maybe a
Nothing) Ini -> IO Ini
forall (f :: * -> *) a. Applicative f => a -> f a
pure
let configProfile :: Text
configProfile =
if Text
profile Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"default"
then Text
profile
else Text
"profile " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
profile
case Text -> Text -> Ini -> Either FilePath Text
INI.lookupValue Text
configProfile Text
confRegion Ini
ini of
Left FilePath
_ -> Maybe Region -> IO (Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Region
forall a. Maybe a
Nothing
Right Text
regionValue ->
case Text -> Either FilePath Region
forall a. FromText a => Text -> Either FilePath a
fromText Text
regionValue of
Left FilePath
err -> IO (Maybe Region) -> IO (Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> Maybe Text -> FilePath -> IO (Maybe Region)
forall a. FilePath -> Maybe Text -> FilePath -> IO a
throwInvalid FilePath
path (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
confRegion) FilePath
err)
Right Region
ok -> Maybe Region -> IO (Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Region -> Maybe Region
forall a. a -> Maybe a
Just Region
ok)
required :: FilePath -> Text -> Ini -> IO ByteString
required FilePath
path Text
key Ini
ini =
case Text -> Text -> Ini -> Either FilePath Text
INI.lookupValue Text
profile Text
key Ini
ini of
Left FilePath
err -> FilePath -> Maybe Text -> FilePath -> IO ByteString
forall a. FilePath -> Maybe Text -> FilePath -> IO a
throwInvalid FilePath
path (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key) FilePath
err
Right Text
x
| Text -> Bool
blank Text
x -> FilePath -> Maybe Text -> FilePath -> IO ByteString
forall a. FilePath -> Maybe Text -> FilePath -> IO a
throwInvalid FilePath
path (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
key) FilePath
"cannot be a blank string."
| Bool
otherwise -> ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ByteString
Text.encodeUtf8 Text
x)
where
blank :: Text -> Bool
blank Text
x = Text -> Bool
Text.null Text
x Bool -> Bool -> Bool
|| (Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
Char.isSpace Text
x
optional :: Text -> Ini -> IO (Maybe ByteString)
optional Text
key Ini
ini =
Maybe ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ByteString -> IO (Maybe ByteString))
-> Maybe ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
case Text -> Text -> Ini -> Either FilePath Text
INI.lookupValue Text
profile Text
key Ini
ini of
Left FilePath
_ -> Maybe ByteString
forall a. Maybe a
Nothing
Right Text
x -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
Text.encodeUtf8 Text
x)
throwInvalid :: FilePath -> Maybe Text -> String -> IO a
throwInvalid :: FilePath -> Maybe Text -> FilePath -> IO a
throwInvalid FilePath
path Maybe Text
mkey FilePath
err =
AuthError -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO a) -> (Text -> AuthError) -> Text -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
InvalidFileError (Text -> IO a) -> Text -> IO a
forall a b. (a -> b) -> a -> b
$
FilePath -> Text
Text.pack FilePath
path
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
forall a. Monoid a => a
mempty (Text
", key " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) Maybe Text
mkey
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
Text.pack FilePath
err
fromProfile ::
MonadIO m =>
Client.Manager ->
m (Auth, Maybe Region)
fromProfile :: Manager -> m (Auth, Maybe Region)
fromProfile Manager
m =
IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Auth, Maybe Region) -> m (Auth, Maybe Region))
-> IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$ do
Either HttpException ByteString
ls <- IO ByteString -> IO (Either HttpException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (IO ByteString -> IO (Either HttpException ByteString))
-> IO ByteString -> IO (Either HttpException ByteString)
forall a b. (a -> b) -> a -> b
$ Manager -> Metadata -> IO ByteString
forall (m :: * -> *).
MonadIO m =>
Manager -> Metadata -> m ByteString
metadata Manager
m (Info -> Metadata
IAM (Maybe Text -> Info
SecurityCredentials Maybe Text
forall a. Maybe a
Nothing))
case ByteString -> [ByteString]
BS8.lines (ByteString -> [ByteString])
-> Either HttpException ByteString
-> Either HttpException [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either HttpException ByteString
ls of
Right (ByteString
x : [ByteString]
_) -> Manager -> Text -> IO (Auth, Maybe Region)
forall (m :: * -> *).
MonadIO m =>
Manager -> Text -> m (Auth, Maybe Region)
fromProfileName Manager
m (ByteString -> Text
Text.decodeUtf8 ByteString
x)
Left HttpException
e -> AuthError -> IO (Auth, Maybe Region)
forall e a. Exception e => e -> IO a
Exception.throwIO (HttpException -> AuthError
RetrievalError HttpException
e)
Either HttpException [ByteString]
_ ->
AuthError -> IO (Auth, Maybe Region)
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO (Auth, Maybe Region))
-> AuthError -> IO (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$
Text -> AuthError
InvalidIAMError Text
"Unable to get default IAM Profile from EC2 metadata"
fromProfileName ::
MonadIO m =>
Client.Manager ->
Text ->
m (Auth, Maybe Region)
fromProfileName :: Manager -> Text -> m (Auth, Maybe Region)
fromProfileName Manager
m Text
name =
IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Auth, Maybe Region) -> m (Auth, Maybe Region))
-> IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$ do
Auth
auth <- IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
getCredentials
Region
reg <- IO Region
getRegionFromIdentity
(Auth, Maybe Region) -> IO (Auth, Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Auth
auth, Region -> Maybe Region
forall a. a -> Maybe a
Just Region
reg)
where
getCredentials :: IO AuthEnv
getCredentials =
IO ByteString -> IO (Either HttpException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (Manager -> Metadata -> IO ByteString
forall (m :: * -> *).
MonadIO m =>
Manager -> Metadata -> m ByteString
metadata Manager
m (Info -> Metadata
IAM (Info -> Metadata)
-> (Maybe Text -> Info) -> Maybe Text -> Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Text -> Info
SecurityCredentials (Maybe Text -> Metadata) -> Maybe Text -> Metadata
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name))
IO (Either HttpException ByteString)
-> (Either HttpException ByteString -> IO AuthEnv) -> IO AuthEnv
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> Either FilePath AuthEnv)
-> (FilePath -> AuthError)
-> Either HttpException ByteString
-> IO AuthEnv
forall e t a a.
Exception e =>
(t -> Either a a) -> (a -> e) -> Either HttpException t -> IO a
handleErr (ByteString -> Either FilePath AuthEnv
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode' (ByteString -> Either FilePath AuthEnv)
-> (ByteString -> ByteString)
-> ByteString
-> Either FilePath AuthEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS8.fromStrict) FilePath -> AuthError
invalidIAMErr
getRegionFromIdentity :: IO Region
getRegionFromIdentity =
IO (Either FilePath IdentityDocument)
-> IO (Either HttpException (Either FilePath IdentityDocument))
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try (Manager -> IO (Either FilePath IdentityDocument)
forall (m :: * -> *).
MonadIO m =>
Manager -> m (Either FilePath IdentityDocument)
identity Manager
m)
IO (Either HttpException (Either FilePath IdentityDocument))
-> (Either HttpException (Either FilePath IdentityDocument)
-> IO Region)
-> IO Region
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either FilePath IdentityDocument -> Either FilePath Region)
-> (FilePath -> AuthError)
-> Either HttpException (Either FilePath IdentityDocument)
-> IO Region
forall e t a a.
Exception e =>
(t -> Either a a) -> (a -> e) -> Either HttpException t -> IO a
handleErr ((IdentityDocument -> Region)
-> Either FilePath IdentityDocument -> Either FilePath Region
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IdentityDocument -> Region
_region) FilePath -> AuthError
invalidIdentityErr
handleErr :: (t -> Either a a) -> (a -> e) -> Either HttpException t -> IO a
handleErr t -> Either a a
f a -> e
g = \case
Left HttpException
e -> AuthError -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO (HttpException -> AuthError
RetrievalError HttpException
e)
Right t
x -> (a -> IO a) -> (a -> IO a) -> Either a a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> IO a
forall e a. Exception e => e -> IO a
Exception.throwIO (e -> IO a) -> (a -> e) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> e
g) a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t -> Either a a
f t
x)
invalidIAMErr :: FilePath -> AuthError
invalidIAMErr =
Text -> AuthError
InvalidIAMError
(Text -> AuthError) -> (FilePath -> Text) -> FilePath -> AuthError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend (Text
"Error parsing IAM profile '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' ")
(Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack
invalidIdentityErr :: FilePath -> AuthError
invalidIdentityErr =
Text -> AuthError
InvalidIAMError
(Text -> AuthError) -> (FilePath -> Text) -> FilePath -> AuthError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"Error parsing Instance Identity Document "
(Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack
fromWebIdentity ::
(MonadIO m, Foldable withAuth) =>
Env' withAuth ->
m (Auth, Maybe Region)
fromWebIdentity :: Env' withAuth -> m (Auth, Maybe Region)
fromWebIdentity Env' withAuth
env = do
FilePath
tokenFile <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Text -> IO FilePath
forall (m :: * -> *). MonadIO m => Text -> m FilePath
reqEnv Text
envWebIdentityTokenFile
Text
roleArn <- IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (FilePath -> Text) -> IO FilePath -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> IO FilePath
forall (m :: * -> *). MonadIO m => Text -> m FilePath
reqEnv Text
envRole
Text
sessionName <-
IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$
Text -> IO (Maybe FilePath)
forall (m :: * -> *). MonadIO m => Text -> m (Maybe FilePath)
optEnv Text
envRoleSessionName IO (Maybe FilePath) -> (Maybe FilePath -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing -> UUID -> Text
UUID.toText (UUID -> Text) -> IO UUID -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom
Just FilePath
v -> Text -> IO Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Text
forall a. IsString a => FilePath -> a
fromString FilePath
v)
Maybe Region
reg <- m (Maybe Region)
forall (m :: * -> *). MonadIO m => m (Maybe Region)
getRegion
let env' :: Env' withAuth
env' = case Maybe Region
reg of
Maybe Region
Nothing -> Env' withAuth
env
Just Region
r -> Env' withAuth
env {$sel:_envRegion:Env :: Region
_envRegion = Region
r}
let getCredentials :: IO AuthEnv
getCredentials = do
Text
token <- FilePath -> IO Text
Text.readFile FilePath
tokenFile
let assumeWeb :: AssumeRoleWithWebIdentity
assumeWeb =
Text -> Text -> Text -> AssumeRoleWithWebIdentity
STS.newAssumeRoleWithWebIdentity
Text
roleArn
Text
sessionName
Text
token
Either Error (Response AssumeRoleWithWebIdentityResponse)
eResponse <- ResourceT
IO (Either Error (Response AssumeRoleWithWebIdentityResponse))
-> IO (Either Error (Response AssumeRoleWithWebIdentityResponse))
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT
IO (Either Error (Response AssumeRoleWithWebIdentityResponse))
-> IO (Either Error (Response AssumeRoleWithWebIdentityResponse)))
-> ResourceT
IO (Either Error (Response AssumeRoleWithWebIdentityResponse))
-> IO (Either Error (Response AssumeRoleWithWebIdentityResponse))
forall a b. (a -> b) -> a -> b
$ Env' withAuth
-> AssumeRoleWithWebIdentity
-> ResourceT
IO
(Either
Error (ClientResponse (AWSResponse AssumeRoleWithWebIdentity)))
forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Foldable withAuth) =>
Env' withAuth
-> a -> m (Either Error (ClientResponse (AWSResponse a)))
retryRequest Env' withAuth
env' AssumeRoleWithWebIdentity
assumeWeb
Response AssumeRoleWithWebIdentityResponse
clientResponse <- (Error -> IO (Response AssumeRoleWithWebIdentityResponse))
-> (Response AssumeRoleWithWebIdentityResponse
-> IO (Response AssumeRoleWithWebIdentityResponse))
-> Either Error (Response AssumeRoleWithWebIdentityResponse)
-> IO (Response AssumeRoleWithWebIdentityResponse)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (IO (Response AssumeRoleWithWebIdentityResponse)
-> IO (Response AssumeRoleWithWebIdentityResponse)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response AssumeRoleWithWebIdentityResponse)
-> IO (Response AssumeRoleWithWebIdentityResponse))
-> (Error -> IO (Response AssumeRoleWithWebIdentityResponse))
-> Error
-> IO (Response AssumeRoleWithWebIdentityResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> IO (Response AssumeRoleWithWebIdentityResponse)
forall e a. Exception e => e -> IO a
Exception.throwIO) Response AssumeRoleWithWebIdentityResponse
-> IO (Response AssumeRoleWithWebIdentityResponse)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Error (Response AssumeRoleWithWebIdentityResponse)
eResponse
let mCredentials :: Maybe AuthEnv
mCredentials =
Response AssumeRoleWithWebIdentityResponse
-> AssumeRoleWithWebIdentityResponse
forall body. Response body -> body
Client.responseBody Response AssumeRoleWithWebIdentityResponse
clientResponse
AssumeRoleWithWebIdentityResponse
-> Getting
(Maybe AuthEnv) AssumeRoleWithWebIdentityResponse (Maybe AuthEnv)
-> Maybe AuthEnv
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe AuthEnv) AssumeRoleWithWebIdentityResponse (Maybe AuthEnv)
Lens' AssumeRoleWithWebIdentityResponse (Maybe AuthEnv)
STS.assumeRoleWithWebIdentityResponse_credentials
case Maybe AuthEnv
mCredentials of
Maybe AuthEnv
Nothing ->
FilePath -> IO AuthEnv
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"sts:AssumeRoleWithWebIdentity returned no credentials."
Just AuthEnv
c -> AuthEnv -> IO AuthEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure AuthEnv
c
Auth
auth <- IO Auth -> m Auth
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Auth -> m Auth) -> IO Auth -> m Auth
forall a b. (a -> b) -> a -> b
$ IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
getCredentials
(Auth, Maybe Region) -> m (Auth, Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Auth
auth, Maybe Region
reg)
fromContainer ::
MonadIO m =>
Client.Manager ->
m (Auth, Maybe Region)
fromContainer :: Manager -> m (Auth, Maybe Region)
fromContainer Manager
m =
IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Auth, Maybe Region) -> m (Auth, Maybe Region))
-> IO (Auth, Maybe Region) -> m (Auth, Maybe Region)
forall a b. (a -> b) -> a -> b
$ do
ClientRequest
req <- IO ClientRequest
getCredentialsURI
Auth
auth <- IO AuthEnv -> IO Auth
fetchAuthInBackground (ClientRequest -> IO AuthEnv
renew ClientRequest
req)
Maybe Region
reg <- IO (Maybe Region)
forall (m :: * -> *). MonadIO m => m (Maybe Region)
getRegion
(Auth, Maybe Region) -> IO (Auth, Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Auth
auth, Maybe Region
reg)
where
getCredentialsURI :: IO ClientRequest
getCredentialsURI :: IO ClientRequest
getCredentialsURI = do
Maybe FilePath
mp <- FilePath -> IO (Maybe FilePath)
Environment.lookupEnv (Text -> FilePath
Text.unpack Text
envContainerCredentialsURI)
FilePath
p <-
IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(AuthError -> IO FilePath
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO FilePath)
-> (Text -> AuthError) -> Text -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
MissingEnvError (Text -> IO FilePath) -> Text -> IO FilePath
forall a b. (a -> b) -> a -> b
$ Text
"Unable to read ENV variable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
envContainerCredentialsURI)
FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Maybe FilePath
mp
FilePath -> IO ClientRequest
forall (m :: * -> *). MonadThrow m => FilePath -> m ClientRequest
Client.parseUrlThrow (FilePath
"http://169.254.170.2" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
p)
renew :: ClientRequest -> IO AuthEnv
renew :: ClientRequest -> IO AuthEnv
renew ClientRequest
req = do
Response ByteString
rs <- ClientRequest -> Manager -> IO (Response ByteString)
Client.httpLbs ClientRequest
req Manager
m
(FilePath -> IO AuthEnv)
-> (AuthEnv -> IO AuthEnv) -> Either FilePath AuthEnv -> IO AuthEnv
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(AuthError -> IO AuthEnv
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO AuthEnv)
-> (FilePath -> AuthError) -> FilePath -> IO AuthEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> AuthError
invalidIdentityErr)
AuthEnv -> IO AuthEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(ByteString -> Either FilePath AuthEnv
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
Client.responseBody Response ByteString
rs))
invalidIdentityErr :: FilePath -> AuthError
invalidIdentityErr =
Text -> AuthError
InvalidIAMError
(Text -> AuthError) -> (FilePath -> Text) -> FilePath -> AuthError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
"Error parsing Task Identity Document "
(Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack
reqEnv :: MonadIO m => Text -> m String
reqEnv :: Text -> m FilePath
reqEnv Text
k =
Text -> m (Maybe FilePath)
forall (m :: * -> *). MonadIO m => Text -> m (Maybe FilePath)
optEnv Text
k m (Maybe FilePath) -> (Maybe FilePath -> m FilePath) -> m FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe FilePath
Nothing ->
IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath)
-> (Text -> IO FilePath) -> Text -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AuthError -> IO FilePath
forall e a. Exception e => e -> IO a
Exception.throwIO (AuthError -> IO FilePath)
-> (Text -> AuthError) -> Text -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AuthError
MissingEnvError (Text -> m FilePath) -> Text -> m FilePath
forall a b. (a -> b) -> a -> b
$
Text
"Unable to read ENV variable: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k
Just FilePath
v -> FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
v
optEnv :: MonadIO m => Text.Text -> m (Maybe String)
optEnv :: Text -> m (Maybe FilePath)
optEnv Text
k = IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> m (Maybe FilePath))
-> (FilePath -> IO (Maybe FilePath))
-> FilePath
-> m (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe FilePath)
Environment.lookupEnv (FilePath -> m (Maybe FilePath)) -> FilePath -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
Text.unpack Text
k
getRegion :: MonadIO m => m (Maybe Region)
getRegion :: m (Maybe Region)
getRegion = MaybeT m Region -> m (Maybe Region)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m Region -> m (Maybe Region))
-> MaybeT m Region -> m (Maybe Region)
forall a b. (a -> b) -> a -> b
$ do
FilePath
mr <- m (Maybe FilePath) -> MaybeT m FilePath
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe FilePath) -> MaybeT m FilePath)
-> (IO (Maybe FilePath) -> m (Maybe FilePath))
-> IO (Maybe FilePath)
-> MaybeT m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> MaybeT m FilePath)
-> IO (Maybe FilePath) -> MaybeT m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe FilePath)
Environment.lookupEnv (Text -> FilePath
Text.unpack Text
envRegion)
(FilePath -> MaybeT m Region)
-> (Region -> MaybeT m Region)
-> Either FilePath Region
-> MaybeT m Region
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(MaybeT m Region -> FilePath -> MaybeT m Region
forall a b. a -> b -> a
const (MaybeT m Region -> FilePath -> MaybeT m Region)
-> (m (Maybe Region) -> MaybeT m Region)
-> m (Maybe Region)
-> FilePath
-> MaybeT m Region
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Maybe Region) -> MaybeT m Region
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Region) -> FilePath -> MaybeT m Region)
-> m (Maybe Region) -> FilePath -> MaybeT m Region
forall a b. (a -> b) -> a -> b
$ Maybe Region -> m (Maybe Region)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Region
forall a. Maybe a
Nothing)
Region -> MaybeT m Region
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Text -> Either FilePath Region
forall a. FromText a => Text -> Either FilePath a
fromText (FilePath -> Text
Text.pack FilePath
mr))
fetchAuthInBackground :: IO AuthEnv -> IO Auth
fetchAuthInBackground :: IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
menv =
IO AuthEnv
menv IO AuthEnv -> (AuthEnv -> IO Auth) -> IO Auth
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(!AuthEnv
env) -> IO Auth -> IO Auth
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Auth -> IO Auth) -> IO Auth -> IO Auth
forall a b. (a -> b) -> a -> b
$
case AuthEnv -> Maybe ISO8601
_authExpiration AuthEnv
env of
Maybe ISO8601
Nothing -> Auth -> IO Auth
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthEnv -> Auth
Auth AuthEnv
env)
Just ISO8601
x -> do
IORef AuthEnv
r <- AuthEnv -> IO (IORef AuthEnv)
forall a. a -> IO (IORef a)
IORef.newIORef AuthEnv
env
ThreadId
p <- IO ThreadId
Concurrent.myThreadId
ThreadId
s <- IO AuthEnv -> IORef AuthEnv -> ThreadId -> ISO8601 -> IO ThreadId
timer IO AuthEnv
menv IORef AuthEnv
r ThreadId
p ISO8601
x
Auth -> IO Auth
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ThreadId -> IORef AuthEnv -> Auth
Ref ThreadId
s IORef AuthEnv
r)
where
timer :: IO AuthEnv -> IORef AuthEnv -> ThreadId -> ISO8601 -> IO ThreadId
timer :: IO AuthEnv -> IORef AuthEnv -> ThreadId -> ISO8601 -> IO ThreadId
timer IO AuthEnv
ma !IORef AuthEnv
r !ThreadId
p !ISO8601
x =
IO () -> IO ThreadId
Concurrent.forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
ThreadId
s <- IO ThreadId
Concurrent.myThreadId
Weak (IORef AuthEnv)
w <- IORef AuthEnv -> IO () -> IO (Weak (IORef AuthEnv))
forall a. IORef a -> IO () -> IO (Weak (IORef a))
IORef.mkWeakIORef IORef AuthEnv
r (ThreadId -> IO ()
Concurrent.killThread ThreadId
s)
IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO ()
loop IO AuthEnv
ma Weak (IORef AuthEnv)
w ThreadId
p ISO8601
x
loop :: IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO ()
loop :: IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO ()
loop IO AuthEnv
ma Weak (IORef AuthEnv)
w !ThreadId
p !ISO8601
x = do
ISO8601 -> UTCTime -> Int
forall a (a :: Format). Integral a => Time a -> UTCTime -> a
diff ISO8601
x (UTCTime -> Int) -> IO UTCTime -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
Time.getCurrentTime IO Int -> (Int -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IO ()
Concurrent.threadDelay
Either HttpException AuthEnv
env <- IO AuthEnv -> IO (Either HttpException AuthEnv)
forall e a. Exception e => IO a -> IO (Either e a)
Exception.try IO AuthEnv
ma
case Either HttpException AuthEnv
env of
Left HttpException
e -> ThreadId -> AuthError -> IO ()
forall e. Exception e => ThreadId -> e -> IO ()
Exception.throwTo ThreadId
p (HttpException -> AuthError
RetrievalError HttpException
e)
Right !AuthEnv
a -> do
Maybe (IORef AuthEnv)
mr <- Weak (IORef AuthEnv) -> IO (Maybe (IORef AuthEnv))
forall v. Weak v -> IO (Maybe v)
Weak.deRefWeak Weak (IORef AuthEnv)
w
case Maybe (IORef AuthEnv)
mr of
Maybe (IORef AuthEnv)
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just IORef AuthEnv
r -> do
IORef AuthEnv -> AuthEnv -> IO ()
forall a. IORef a -> a -> IO ()
IORef.atomicWriteIORef IORef AuthEnv
r AuthEnv
a
IO () -> (ISO8601 -> IO ()) -> Maybe ISO8601 -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (IO AuthEnv -> Weak (IORef AuthEnv) -> ThreadId -> ISO8601 -> IO ()
loop IO AuthEnv
ma Weak (IORef AuthEnv)
w ThreadId
p) (AuthEnv -> Maybe ISO8601
_authExpiration AuthEnv
a)
diff :: Time a -> UTCTime -> a
diff (Time !UTCTime
x) !UTCTime
y = (a -> a -> a
forall a. Num a => a -> a -> a
* a
1000000) (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 then a
n else a
1
where
!n :: a
n = NominalDiffTime -> a
forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> UTCTime -> NominalDiffTime
Time.diffUTCTime UTCTime
x UTCTime
y) a -> a -> a
forall a. Num a => a -> a -> a
- a
60
data Env' withAuth = Env
{ Env' withAuth -> Region
_envRegion :: Region,
Env' withAuth -> Logger
_envLogger :: Logger,
Env' withAuth -> Int -> HttpException -> Bool
_envRetryCheck :: Int -> Client.HttpException -> Bool,
Env' withAuth -> Dual (Endo Service)
_envOverride :: Dual (Endo Service),
Env' withAuth -> Manager
_envManager :: Client.Manager,
Env' withAuth -> withAuth Auth
_envAuth :: withAuth Auth
}
deriving stock ((forall x. Env' withAuth -> Rep (Env' withAuth) x)
-> (forall x. Rep (Env' withAuth) x -> Env' withAuth)
-> Generic (Env' withAuth)
forall x. Rep (Env' withAuth) x -> Env' withAuth
forall x. Env' withAuth -> Rep (Env' withAuth) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (withAuth :: * -> *) x.
Rep (Env' withAuth) x -> Env' withAuth
forall (withAuth :: * -> *) x.
Env' withAuth -> Rep (Env' withAuth) x
$cto :: forall (withAuth :: * -> *) x.
Rep (Env' withAuth) x -> Env' withAuth
$cfrom :: forall (withAuth :: * -> *) x.
Env' withAuth -> Rep (Env' withAuth) x
Generic)