module Stackctl.AutoSSO
  ( AutoSSOOption
  , defaultAutoSSOOption
  , HasAutoSSOOption (..)
  , autoSSOOption
  , envAutoSSOOption
  , handleAutoSSO
  ) where

import Stackctl.Prelude

import Amazonka.SSO (_UnauthorizedException)
import Data.Semigroup (Last (..))
import qualified Env
import Options.Applicative
import Stackctl.AWS.Core (formatServiceError)
import Stackctl.Prompt
import System.Process.Typed
import UnliftIO.Exception.Lens (catching)

data AutoSSOOption
  = AutoSSOAlways
  | AutoSSOAsk
  | AutoSSONever
  deriving (NonEmpty AutoSSOOption -> AutoSSOOption
AutoSSOOption -> AutoSSOOption -> AutoSSOOption
forall b. Integral b => b -> AutoSSOOption -> AutoSSOOption
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> AutoSSOOption -> AutoSSOOption
$cstimes :: forall b. Integral b => b -> AutoSSOOption -> AutoSSOOption
sconcat :: NonEmpty AutoSSOOption -> AutoSSOOption
$csconcat :: NonEmpty AutoSSOOption -> AutoSSOOption
<> :: AutoSSOOption -> AutoSSOOption -> AutoSSOOption
$c<> :: AutoSSOOption -> AutoSSOOption -> AutoSSOOption
Semigroup) via Last AutoSSOOption

defaultAutoSSOOption :: AutoSSOOption
defaultAutoSSOOption :: AutoSSOOption
defaultAutoSSOOption = AutoSSOOption
AutoSSOAsk

readAutoSSO :: String -> Either String AutoSSOOption
readAutoSSO :: String -> Either String AutoSSOOption
readAutoSSO = \case
  String
"always" -> forall a b. b -> Either a b
Right AutoSSOOption
AutoSSOAlways
  String
"ask" -> forall a b. b -> Either a b
Right AutoSSOOption
AutoSSOAsk
  String
"never" -> forall a b. b -> Either a b
Right AutoSSOOption
AutoSSONever
  String
x ->
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Invalid choice for auto-sso: " forall a. Semigroup a => a -> a -> a
<> String
x forall a. Semigroup a => a -> a -> a
<> String
", must be always|ask|never"

class HasAutoSSOOption env where
  autoSSOOptionL :: Lens' env AutoSSOOption

autoSSOOption :: Parser AutoSSOOption
autoSSOOption :: Parser AutoSSOOption
autoSSOOption =
  forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String AutoSSOOption
readAutoSSO)
    forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"auto-sso", forall (f :: * -> *) a. String -> Mod f a
help forall a. IsString a => a
autoSSOHelp, forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"WHEN"]

envAutoSSOOption :: Env.Parser Env.Error AutoSSOOption
envAutoSSOOption :: Parser Error AutoSSOOption
envAutoSSOOption =
  forall e a.
AsUnset e =>
Reader e a -> String -> Mod Var a -> Parser e a
Env.var (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Error
Env.UnreadError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String AutoSSOOption
readAutoSSO) String
"AUTO_SSO"
    forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. HasHelp t => String -> Mod t a
Env.help forall a. IsString a => a
autoSSOHelp

autoSSOHelp :: IsString a => a
autoSSOHelp :: forall a. IsString a => a
autoSSOHelp = a
"Automatically run aws-sso-login if necessary?"

handleAutoSSO
  :: ( MonadUnliftIO m
     , MonadReader env m
     , MonadLogger m
     , HasLogger env
     , HasAutoSSOOption options
     )
  => options
  -> m a
  -> m a
handleAutoSSO :: forall (m :: * -> *) env options a.
(MonadUnliftIO m, MonadReader env m, MonadLogger m, HasLogger env,
 HasAutoSSOOption options) =>
options -> m a -> m a
handleAutoSSO options
options m a
f = do
  forall (m :: * -> *) a r.
MonadUnliftIO m =>
Getting (First a) SomeException a -> m r -> (a -> m r) -> m r
catching forall a. AsError a => Fold a ServiceError
_UnauthorizedException m a
f forall a b. (a -> b) -> a -> b
$ \ServiceError
ex -> do
    case options
options forall s a. s -> Getting a s a -> a
^. forall env. HasAutoSSOOption env => Lens' env AutoSSOOption
autoSSOOptionL of
      AutoSSOOption
AutoSSOAlways -> do
        forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ ServiceError -> Message
ssoErrorMessage ServiceError
ex
        forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logInfo Message
"Running `aws sso login' automatically"
      AutoSSOOption
AutoSSOAsk -> do
        forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logWarn forall a b. (a -> b) -> a -> b
$ ServiceError -> Message
ssoErrorMessage ServiceError
ex
        forall (m :: * -> *) env.
(MonadIO m, MonadLogger m, MonadReader env m, HasLogger env) =>
Text -> m ()
promptOrExit Text
"Run `aws sso login'"
      AutoSSOOption
AutoSSONever -> do
        forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Message -> m ()
logError forall a b. (a -> b) -> a -> b
$ ServiceError -> Message
ssoErrorMessage ServiceError
ex
        forall (m :: * -> *) a. MonadIO m => m a
exitFailure

    forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
proc String
"aws" [String
"sso", String
"login"]
    m a
f
 where
  ssoErrorMessage :: ServiceError -> Message
ssoErrorMessage ServiceError
ex =
    Text
"AWS SSO authorization error"
      Text -> [SeriesElem] -> Message
:# [ Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ServiceError -> Text
formatServiceError ServiceError
ex
         , Key
"hint" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Text
"Run `aws sso login' and try again" :: Text)
         ]