-- |
-- 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 (sendUnsigned)
import Amazonka.Types
import qualified Control.Exception as Exception
import Control.Exception.Lens (handling_, _IOException)
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 -> String
(Int -> CachedAccessToken -> ShowS)
-> (CachedAccessToken -> String)
-> ([CachedAccessToken] -> ShowS)
-> Show CachedAccessToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CachedAccessToken -> ShowS
showsPrec :: Int -> CachedAccessToken -> ShowS
$cshow :: CachedAccessToken -> String
show :: CachedAccessToken -> String
$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 (Value -> Parser [CachedAccessToken]
Value -> Parser CachedAccessToken
(Value -> Parser CachedAccessToken)
-> (Value -> Parser [CachedAccessToken])
-> FromJSON CachedAccessToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser CachedAccessToken
parseJSON :: Value -> Parser CachedAccessToken
$cparseJSONList :: Value -> Parser [CachedAccessToken]
parseJSONList :: Value -> Parser [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
$sel:startUrl:CachedAccessToken :: 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
$sel:region:CachedAccessToken :: 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
$sel:accessToken:CachedAccessToken :: 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
$sel:expiresAt:CachedAccessToken :: 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 =>
String -> Region -> Text -> Text -> Env' withAuth -> m Env
fromSSO String
cachedTokenFile Region
ssoRegion Text
accountId Text
roleName Env' withAuth
env = do
  Auth
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
  Env -> m Env
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Env -> m Env) -> Env -> m Env
forall a b. (a -> b) -> a -> b
$ Env' withAuth
env {auth = Identity keys}
  where
    getCredentials :: IO AuthEnv
getCredentials = do
      CachedAccessToken {Text
UTCTime
Sensitive Text
Region
$sel:startUrl:CachedAccessToken :: CachedAccessToken -> Text
$sel:region:CachedAccessToken :: CachedAccessToken -> Region
$sel:accessToken:CachedAccessToken :: CachedAccessToken -> Sensitive Text
$sel:expiresAt:CachedAccessToken :: CachedAccessToken -> UTCTime
startUrl :: Text
region :: Region
accessToken :: Sensitive Text
expiresAt :: UTCTime
..} <- String -> IO CachedAccessToken
forall (m :: * -> *). MonadIO m => String -> m CachedAccessToken
readCachedAccessToken String
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
ssoEnv = Env' withAuth
env {region = ssoRegion}
          getRoleCredentials :: GetRoleCredentials
getRoleCredentials =
            Text -> Text -> Text -> GetRoleCredentials
SSO.newGetRoleCredentials
              Text
roleName
              Text
accountId
              (Sensitive Text -> Text
forall a. Sensitive a -> a
fromSensitive Sensitive Text
accessToken)

      GetRoleCredentialsResponse
resp <- ResourceT IO GetRoleCredentialsResponse
-> IO GetRoleCredentialsResponse
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO GetRoleCredentialsResponse
 -> IO GetRoleCredentialsResponse)
-> ResourceT IO GetRoleCredentialsResponse
-> IO GetRoleCredentialsResponse
forall a b. (a -> b) -> a -> b
$ Env' withAuth
-> GetRoleCredentials
-> ResourceT IO (AWSResponse GetRoleCredentials)
forall (m :: * -> *) a (withAuth :: * -> *).
(MonadResource m, AWSRequest a, Typeable a,
 Typeable (AWSResponse a)) =>
Env' withAuth -> a -> m (AWSResponse a)
sendUnsigned Env' withAuth
ssoEnv GetRoleCredentials
getRoleCredentials
      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

-- | 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 :: MonadIO m => Text -> m FilePath
relativeCachedTokenFile :: forall (m :: * -> *). MonadIO m => Text -> m String
relativeCachedTokenFile Text
startUrl = do
  let sha1 :: String
sha1 = Digest SHA1 -> String
forall a. Show a => a -> String
show (Digest SHA1 -> String)
-> (ByteString -> Digest SHA1) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Digest SHA1
forall a. ByteArrayAccess a => a -> Digest SHA1
Crypto.hashSHA1 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
startUrl
  String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"/.aws/sso/cache/" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
sha1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
".json"

readCachedAccessToken :: MonadIO m => FilePath -> m CachedAccessToken
readCachedAccessToken :: forall (m :: * -> *). MonadIO m => String -> m CachedAccessToken
readCachedAccessToken String
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
$
  Getting (First IOException) SomeException IOException
-> IO CachedAccessToken
-> IO CachedAccessToken
-> IO CachedAccessToken
forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
handling_ Getting (First IOException) SomeException IOException
forall t. AsIOException t => Prism' t IOException
Prism' SomeException IOException
_IOException IO CachedAccessToken
err (IO CachedAccessToken -> IO CachedAccessToken)
-> IO CachedAccessToken -> IO CachedAccessToken
forall a b. (a -> b) -> a -> b
$ do
    Maybe CachedAccessToken
mCache <- String -> IO (Maybe CachedAccessToken)
forall a. FromJSON a => String -> IO (Maybe a)
decodeFileStrict String
p
    IO CachedAccessToken
-> (CachedAccessToken -> IO CachedAccessToken)
-> Maybe CachedAccessToken
-> IO CachedAccessToken
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO CachedAccessToken
err CachedAccessToken -> IO CachedAccessToken
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CachedAccessToken
mCache
  where
    err :: IO CachedAccessToken
err =
      AuthError -> IO CachedAccessToken
forall e a. 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. ",
              String -> Text
Text.pack String
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)