-- |
-- 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CachedAccessToken] -> ShowS
$cshowList :: [CachedAccessToken] -> ShowS
show :: CachedAccessToken -> String
$cshow :: CachedAccessToken -> String
showsPrec :: Int -> CachedAccessToken -> ShowS
$cshowsPrec :: Int -> CachedAccessToken -> ShowS
Show, CachedAccessToken -> CachedAccessToken -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CachedAccessToken -> CachedAccessToken -> Bool
$c/= :: CachedAccessToken -> CachedAccessToken -> Bool
== :: CachedAccessToken -> CachedAccessToken -> Bool
$c== :: CachedAccessToken -> CachedAccessToken -> Bool
Eq, 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
$cto :: forall x. Rep CachedAccessToken x -> CachedAccessToken
$cfrom :: forall x. CachedAccessToken -> Rep CachedAccessToken x
Generic)
  deriving anyclass (Value -> Parser [CachedAccessToken]
Value -> Parser CachedAccessToken
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CachedAccessToken]
$cparseJSONList :: Value -> Parser [CachedAccessToken]
parseJSON :: Value -> Parser CachedAccessToken
$cparseJSON :: 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
startUrl :: Text
$sel:startUrl:CachedAccessToken :: CachedAccessToken -> Text
startUrl} = Text -> f Text
f Text
startUrl forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
startUrl' -> CachedAccessToken
c {$sel:startUrl:CachedAccessToken :: Text
startUrl = Text
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 :: Region
$sel:region:CachedAccessToken :: CachedAccessToken -> Region
region} = Region -> f Region
f Region
region forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Region
region' -> (CachedAccessToken
c :: CachedAccessToken) {$sel:region:CachedAccessToken :: Region
region = 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 :: Sensitive Text
$sel:accessToken:CachedAccessToken :: CachedAccessToken -> Sensitive Text
accessToken} = Sensitive Text -> f (Sensitive Text)
f Sensitive Text
accessToken forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Sensitive Text
accessToken' -> (CachedAccessToken
c :: CachedAccessToken) {$sel:accessToken:CachedAccessToken :: Sensitive Text
accessToken = Sensitive Text
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 :: UTCTime
$sel:expiresAt:CachedAccessToken :: CachedAccessToken -> UTCTime
expiresAt} = UTCTime -> f UTCTime
f UTCTime
expiresAt forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \UTCTime
expiresAt' -> CachedAccessToken
c {$sel:expiresAt:CachedAccessToken :: UTCTime
expiresAt = UTCTime
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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ IO AuthEnv -> IO Auth
fetchAuthInBackground IO AuthEnv
getCredentials
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Env' withAuth
env {$sel:auth:Env :: Identity Auth
auth = forall a. a -> Identity a
Identity Auth
keys}
  where
    getCredentials :: IO AuthEnv
getCredentials = do
      CachedAccessToken {UTCTime
Text
Region
Sensitive Text
expiresAt :: UTCTime
accessToken :: Sensitive Text
region :: Region
startUrl :: Text
$sel:expiresAt:CachedAccessToken :: CachedAccessToken -> UTCTime
$sel:accessToken:CachedAccessToken :: CachedAccessToken -> Sensitive Text
$sel:region:CachedAccessToken :: CachedAccessToken -> Region
$sel:startUrl:CachedAccessToken :: CachedAccessToken -> Text
..} <- 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 {$sel:region:Env :: Region
region = Region
ssoRegion}
          getRoleCredentials :: GetRoleCredentials
getRoleCredentials =
            Text -> Text -> Text -> GetRoleCredentials
SSO.newGetRoleCredentials
              Text
roleName
              Text
accountId
              (forall a. Sensitive a -> a
fromSensitive Sensitive Text
accessToken)

      GetRoleCredentialsResponse
resp <- forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ 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
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. RoleCredentials -> AuthEnv
roleCredentialsToAuthEnv forall a b. (a -> b) -> a -> b
$
        GetRoleCredentialsResponse
resp forall s a. s -> Getting a s a -> a
^. 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 = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ByteArrayAccess a => a -> Digest SHA1
Crypto.hashSHA1 forall a b. (a -> b) -> a -> b
$ Text -> ByteString
Text.encodeUtf8 Text
startUrl
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String
"/.aws/sso/cache/" forall a. Semigroup a => a -> a -> a
<> String
sha1 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) a r.
MonadCatch m =>
Getting (First a) SomeException a -> m r -> m r -> m r
handling_ forall t. AsIOException t => Prism' t IOException
_IOException IO CachedAccessToken
err forall a b. (a -> b) -> a -> b
$ do
    Maybe CachedAccessToken
mCache <- forall a. FromJSON a => String -> IO (Maybe a)
decodeFileStrict String
p
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO CachedAccessToken
err forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CachedAccessToken
mCache
  where
    err :: IO CachedAccessToken
err =
      forall e a. Exception e => e -> IO a
Exception.throwIO forall a b. (a -> b) -> a -> b
$
        Text -> AuthError
InvalidFileError forall a b. (a -> b) -> a -> b
$
          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)
    (forall (a :: Format). UTCTime -> Time a
Time forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RoleCredentials -> Maybe Integer
SSO.expiration RoleCredentials
rc)