-- |
-- Module      : Amazonka.Auth.SSO
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Auth.SSO where

import Amazonka.Auth.Background (fetchAuthInBackground)
import Amazonka.Auth.Exception
import Amazonka.Core.Lens.Internal ((^.))
import qualified Amazonka.Crypto as Crypto
import Amazonka.Data.Sensitive
import Amazonka.Data.Time (Time (..))
import Amazonka.Env (Env, Env' (..))
import Amazonka.Prelude
import Amazonka.SSO.GetRoleCredentials as SSO
import qualified Amazonka.SSO.Types as SSO (RoleCredentials (..))
import Amazonka.Send (sendUnsignedEither)
import Amazonka.Types
import Control.Exception (IOException)
import qualified Control.Exception as Exception
import Control.Monad.Trans.Resource (runResourceT)
import Data.Aeson (FromJSON, decodeFileStrict)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)

data CachedAccessToken = CachedAccessToken
  { CachedAccessToken -> Text
startUrl :: Text,
    CachedAccessToken -> Region
region :: Region,
    CachedAccessToken -> Sensitive Text
accessToken :: Sensitive Text,
    CachedAccessToken -> UTCTime
expiresAt :: UTCTime
  }
  deriving stock (Int -> CachedAccessToken -> ShowS
[CachedAccessToken] -> ShowS
CachedAccessToken -> FilePath
(Int -> CachedAccessToken -> ShowS)
-> (CachedAccessToken -> FilePath)
-> ([CachedAccessToken] -> ShowS)
-> Show CachedAccessToken
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CachedAccessToken -> ShowS
showsPrec :: Int -> CachedAccessToken -> ShowS
$cshow :: CachedAccessToken -> FilePath
show :: CachedAccessToken -> FilePath
$cshowList :: [CachedAccessToken] -> ShowS
showList :: [CachedAccessToken] -> ShowS
Show, CachedAccessToken -> CachedAccessToken -> Bool
(CachedAccessToken -> CachedAccessToken -> Bool)
-> (CachedAccessToken -> CachedAccessToken -> Bool)
-> Eq CachedAccessToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CachedAccessToken -> CachedAccessToken -> Bool
== :: CachedAccessToken -> CachedAccessToken -> Bool
$c/= :: CachedAccessToken -> CachedAccessToken -> Bool
/= :: CachedAccessToken -> CachedAccessToken -> Bool
Eq, (forall x. CachedAccessToken -> Rep CachedAccessToken x)
-> (forall x. Rep CachedAccessToken x -> CachedAccessToken)
-> Generic CachedAccessToken
forall x. Rep CachedAccessToken x -> CachedAccessToken
forall x. CachedAccessToken -> Rep CachedAccessToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CachedAccessToken -> Rep CachedAccessToken x
from :: forall x. CachedAccessToken -> Rep CachedAccessToken x
$cto :: forall x. Rep CachedAccessToken x -> CachedAccessToken
to :: forall x. Rep CachedAccessToken x -> CachedAccessToken
Generic)
  deriving anyclass (Maybe CachedAccessToken
Value -> Parser [CachedAccessToken]
Value -> Parser CachedAccessToken
(Value -> Parser CachedAccessToken)
-> (Value -> Parser [CachedAccessToken])
-> Maybe CachedAccessToken
-> FromJSON CachedAccessToken
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser CachedAccessToken
parseJSON :: Value -> Parser CachedAccessToken
$cparseJSONList :: Value -> Parser [CachedAccessToken]
parseJSONList :: Value -> Parser [CachedAccessToken]
$comittedField :: Maybe CachedAccessToken
omittedField :: Maybe CachedAccessToken
FromJSON)

{-# INLINE cachedAccessToken_startUrl #-}
cachedAccessToken_startUrl :: Lens' CachedAccessToken Text
cachedAccessToken_startUrl :: Lens' CachedAccessToken Text
cachedAccessToken_startUrl Text -> f Text
f c :: CachedAccessToken
c@CachedAccessToken {Text
startUrl :: CachedAccessToken -> Text
startUrl :: Text
startUrl} = Text -> f Text
f Text
startUrl f Text -> (Text -> CachedAccessToken) -> f CachedAccessToken
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
startUrl' -> CachedAccessToken
c {startUrl = startUrl'}

{-# INLINE cachedAccessToken_region #-}
cachedAccessToken_region :: Lens' CachedAccessToken Region
cachedAccessToken_region :: Lens' CachedAccessToken Region
cachedAccessToken_region Region -> f Region
f c :: CachedAccessToken
c@CachedAccessToken {Region
region :: CachedAccessToken -> Region
region :: Region
region} = Region -> f Region
f Region
region f Region -> (Region -> CachedAccessToken) -> f CachedAccessToken
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Region
region' -> (CachedAccessToken
c :: CachedAccessToken) {region = region'}

{-# INLINE cachedAccessToken_accessToken #-}
cachedAccessToken_accessToken :: Lens' CachedAccessToken (Sensitive Text)
cachedAccessToken_accessToken :: Lens' CachedAccessToken (Sensitive Text)
cachedAccessToken_accessToken Sensitive Text -> f (Sensitive Text)
f c :: CachedAccessToken
c@CachedAccessToken {Sensitive Text
accessToken :: CachedAccessToken -> Sensitive Text
accessToken :: Sensitive Text
accessToken} = Sensitive Text -> f (Sensitive Text)
f Sensitive Text
accessToken f (Sensitive Text)
-> (Sensitive Text -> CachedAccessToken) -> f CachedAccessToken
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Sensitive Text
accessToken' -> (CachedAccessToken
c :: CachedAccessToken) {accessToken = accessToken'}

{-# INLINE cachedAccessToken_expiresAt #-}
cachedAccessToken_expiresAt :: Lens' CachedAccessToken UTCTime
cachedAccessToken_expiresAt :: Lens' CachedAccessToken UTCTime
cachedAccessToken_expiresAt UTCTime -> f UTCTime
f c :: CachedAccessToken
c@CachedAccessToken {UTCTime
expiresAt :: CachedAccessToken -> UTCTime
expiresAt :: UTCTime
expiresAt} = UTCTime -> f UTCTime
f UTCTime
expiresAt f UTCTime -> (UTCTime -> CachedAccessToken) -> f CachedAccessToken
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \UTCTime
expiresAt' -> CachedAccessToken
c {expiresAt = expiresAt'}

-- | Assume a role using an SSO Token.
--
-- The user must have previously called @aws sso login@, and pass in the path to
-- the cached token file, along with SSO region, account ID and role name.
-- ('Amazonka.Auth.ConfigFile.fromFilePath' understands the @sso_@ variables
-- used by the official AWS CLI and will call 'fromSSO' for you.) This function
-- uses 'fetchAuthInBackground' to refresh the credentials as long as the token
-- in the @sso/cache@ file is not expired. When it has, the user will need to
-- @aws sso login@ again.
--
-- <https://docs.aws.amazon.com/cli/latest/userguide/cli-configure-sso.html>
fromSSO ::
  forall m withAuth.
  (MonadIO m) =>
  FilePath ->
  Region ->
  -- | Account ID
  Text ->
  -- | Role Name
  Text ->
  Env' withAuth ->
  m Env
fromSSO :: forall (m :: * -> *) (withAuth :: * -> *).
MonadIO m =>
FilePath -> Region -> Text -> Text -> Env' withAuth -> m Env
fromSSO FilePath
cachedTokenFile Region
ssoRegion Text
accountId Text
roleName Env' withAuth
env = do
  keys <- IO Auth -> m Auth
forall a. IO a -> m a
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
  pure $ env {auth = Identity keys}
  where
    getCredentials :: IO AuthEnv
getCredentials = do
      CachedAccessToken {..} <- FilePath -> IO CachedAccessToken
forall (m :: * -> *). MonadIO m => FilePath -> m CachedAccessToken
readCachedAccessToken FilePath
cachedTokenFile

      -- The Region you SSO through may differ from the Region you intend to
      -- interact with after. The former is handled here, the latter is taken
      -- care of later, in ConfigFile.
      let ssoEnv :: Env' withAuth
          ssoEnv = Env' withAuth
env {region = ssoRegion}
          getRoleCredentials =
            Text -> Text -> Text -> GetRoleCredentials
SSO.newGetRoleCredentials
              Text
roleName
              Text
accountId
              (Sensitive Text -> Text
forall a. Sensitive a -> a
fromSensitive Sensitive Text
accessToken)

      runResourceT (sendUnsignedEither ssoEnv getRoleCredentials) >>= \case
        Left Error
err -> AuthError -> IO AuthEnv
forall e a. (HasCallStack, Exception e) => e -> IO a
Exception.throwIO (Error -> AuthError
errorAsAuthError Error
err)
        Right GetRoleCredentialsResponse
resp ->
          AuthEnv -> IO AuthEnv
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthEnv -> IO AuthEnv)
-> (RoleCredentials -> AuthEnv) -> RoleCredentials -> IO AuthEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoleCredentials -> AuthEnv
roleCredentialsToAuthEnv (RoleCredentials -> IO AuthEnv) -> RoleCredentials -> IO AuthEnv
forall a b. (a -> b) -> a -> b
$
            GetRoleCredentialsResponse
resp GetRoleCredentialsResponse
-> Getting
     RoleCredentials GetRoleCredentialsResponse RoleCredentials
-> RoleCredentials
forall s a. s -> Getting a s a -> a
^. Getting RoleCredentials GetRoleCredentialsResponse RoleCredentials
Lens' GetRoleCredentialsResponse RoleCredentials
SSO.getRoleCredentialsResponse_roleCredentials

    errorAsAuthError :: Error -> AuthError
errorAsAuthError = \case
      ServiceError ServiceError
err -> ServiceError -> AuthError
AuthServiceError ServiceError
err
      TransportError HttpException
err -> HttpException -> AuthError
RetrievalError HttpException
err
      Error
other -> SomeException -> AuthError
OtherAuthError (Error -> SomeException
forall e. Exception e => e -> SomeException
Exception.toException Error
other)

-- | Return the cached token file for a given @sso_start_url@
--
-- Matches
-- [botocore](https://github.com/boto/botocore/blob/c02f3561f56085b8a3f98501d25b9857b916c10e/botocore/utils.py#L2596-L2597),
-- so that we find tokens produced by @aws sso login@.
relativeCachedTokenFile :: Text -> FilePath
relativeCachedTokenFile :: Text -> FilePath
relativeCachedTokenFile Text
startUrl = FilePath
"/.aws/sso/cache/" FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
sha1 FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
".json"
  where
    sha1 :: FilePath
sha1 = Digest SHA1 -> FilePath
forall a. Show a => a -> FilePath
show (Digest SHA1 -> FilePath)
-> (ByteString -> Digest SHA1) -> ByteString -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1
forall a. ByteArrayAccess a => a -> Digest SHA1
Crypto.hashSHA1 (ByteString -> FilePath) -> ByteString -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
startUrl

readCachedAccessToken :: (MonadIO m) => FilePath -> m CachedAccessToken
readCachedAccessToken :: forall (m :: * -> *). MonadIO m => FilePath -> m CachedAccessToken
readCachedAccessToken FilePath
p = IO CachedAccessToken -> m CachedAccessToken
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CachedAccessToken -> m CachedAccessToken)
-> IO CachedAccessToken -> m CachedAccessToken
forall a b. (a -> b) -> a -> b
$
  (IOException -> IO CachedAccessToken)
-> IO CachedAccessToken -> IO CachedAccessToken
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
Exception.handle (\(IOException
_ :: IOException) -> IO CachedAccessToken
err) (IO CachedAccessToken -> IO CachedAccessToken)
-> IO CachedAccessToken -> IO CachedAccessToken
forall a b. (a -> b) -> a -> b
$ do
    mCache <- FilePath -> IO (Maybe CachedAccessToken)
forall a. FromJSON a => FilePath -> IO (Maybe a)
decodeFileStrict FilePath
p
    maybe err pure mCache
  where
    err :: IO CachedAccessToken
err =
      AuthError -> IO CachedAccessToken
forall e a. (HasCallStack, Exception e) => e -> IO a
Exception.throwIO (AuthError -> IO CachedAccessToken)
-> AuthError -> IO CachedAccessToken
forall a b. (a -> b) -> a -> b
$
        Text -> AuthError
InvalidFileError (Text -> AuthError) -> Text -> AuthError
forall a b. (a -> b) -> a -> b
$
          [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
            [ Text
"Unable to read SSO cache. ",
              FilePath -> Text
Text.pack FilePath
p,
              Text
" is missing or invalid."
            ]

roleCredentialsToAuthEnv :: SSO.RoleCredentials -> AuthEnv
roleCredentialsToAuthEnv :: RoleCredentials -> AuthEnv
roleCredentialsToAuthEnv RoleCredentials
rc =
  AccessKey
-> Sensitive SecretKey
-> Maybe (Sensitive SessionToken)
-> Maybe ISO8601
-> AuthEnv
AuthEnv
    (RoleCredentials -> AccessKey
SSO.accessKeyId RoleCredentials
rc)
    (RoleCredentials -> Sensitive SecretKey
SSO.secretAccessKey RoleCredentials
rc)
    (RoleCredentials -> Maybe (Sensitive SessionToken)
SSO.sessionToken RoleCredentials
rc)
    (UTCTime -> ISO8601
forall (a :: Format). UTCTime -> Time a
Time (UTCTime -> ISO8601) -> (Integer -> UTCTime) -> Integer -> ISO8601
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Integer -> POSIXTime) -> Integer -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a. Num a => Integer -> a
fromInteger (Integer -> ISO8601) -> Maybe Integer -> Maybe ISO8601
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoleCredentials -> Maybe Integer
SSO.expiration RoleCredentials
rc)