module Stackctl.CLI
  ( App
  , optionsL
  , AppT
  , runAppT
  ) where

import Stackctl.Prelude

import qualified Blammo.Logging.LogSettings.Env as LoggingEnv
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Trans.Resource (ResourceT, runResourceT)
import Stackctl.AWS
import Stackctl.AWS.Scope
import Stackctl.AutoSSO
import Stackctl.ColorOption
import Stackctl.Config
import Stackctl.DirectoryOption
import Stackctl.FilterOption
import Stackctl.VerboseOption

data App options = App
  { forall options. App options -> Logger
appLogger :: Logger
  , forall options. App options -> Config
appConfig :: Config
  , forall options. App options -> options
appOptions :: options
  , forall options. App options -> AwsScope
appAwsScope :: AwsScope
  , forall options. App options -> AwsEnv
appAwsEnv :: AwsEnv
  }

optionsL :: Lens' (App options) options
optionsL :: forall options. Lens' (App options) options
optionsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall options. App options -> options
appOptions forall a b. (a -> b) -> a -> b
$ \App options
x options
y -> App options
x {appOptions :: options
appOptions = options
y}

instance HasLogger (App options) where
  loggerL :: Lens' (App options) Logger
loggerL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall options. App options -> Logger
appLogger forall a b. (a -> b) -> a -> b
$ \App options
x Logger
y -> App options
x {appLogger :: Logger
appLogger = Logger
y}

instance HasConfig (App options) where
  configL :: Lens' (App options) Config
configL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall options. App options -> Config
appConfig forall a b. (a -> b) -> a -> b
$ \App options
x Config
y -> App options
x {appConfig :: Config
appConfig = Config
y}

instance HasAwsScope (App options) where
  awsScopeL :: Lens' (App options) AwsScope
awsScopeL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall options. App options -> AwsScope
appAwsScope forall a b. (a -> b) -> a -> b
$ \App options
x AwsScope
y -> App options
x {appAwsScope :: AwsScope
appAwsScope = AwsScope
y}

instance HasAwsEnv (App options) where
  awsEnvL :: Lens' (App options) AwsEnv
awsEnvL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall options. App options -> AwsEnv
appAwsEnv forall a b. (a -> b) -> a -> b
$ \App options
x AwsEnv
y -> App options
x {appAwsEnv :: AwsEnv
appAwsEnv = AwsEnv
y}

instance HasDirectoryOption options => HasDirectoryOption (App options) where
  directoryOptionL :: Lens' (App options) DirectoryOption
directoryOptionL = forall options. Lens' (App options) options
optionsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasDirectoryOption env => Lens' env DirectoryOption
directoryOptionL

instance HasFilterOption options => HasFilterOption (App options) where
  filterOptionL :: Lens' (App options) FilterOption
filterOptionL = forall options. Lens' (App options) options
optionsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasFilterOption env => Lens' env FilterOption
filterOptionL

instance HasColorOption options => HasColorOption (App options) where
  colorOptionL :: Lens' (App options) (Maybe ColorOption)
colorOptionL = forall options. Lens' (App options) options
optionsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasColorOption env => Lens' env (Maybe ColorOption)
colorOptionL

instance HasVerboseOption options => HasVerboseOption (App options) where
  verboseOptionL :: Lens' (App options) Verbosity
verboseOptionL = forall options. Lens' (App options) options
optionsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasVerboseOption env => Lens' env Verbosity
verboseOptionL

instance HasAutoSSOOption options => HasAutoSSOOption (App options) where
  autoSSOOptionL :: Lens' (App options) AutoSSOOption
autoSSOOptionL = forall options. Lens' (App options) options
optionsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasAutoSSOOption env => Lens' env AutoSSOOption
autoSSOOptionL

newtype AppT app m a = AppT
  { forall app (m :: * -> *) a.
AppT app m a -> ReaderT app (LoggingT (ResourceT m)) a
unAppT :: ReaderT app (LoggingT (ResourceT m)) a
  }
  deriving newtype
    ( forall a b. a -> AppT app m b -> AppT app m a
forall a b. (a -> b) -> AppT app m a -> AppT app m b
forall app (m :: * -> *) a b.
Functor m =>
a -> AppT app m b -> AppT app m a
forall app (m :: * -> *) a b.
Functor m =>
(a -> b) -> AppT app m a -> AppT app m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> AppT app m b -> AppT app m a
$c<$ :: forall app (m :: * -> *) a b.
Functor m =>
a -> AppT app m b -> AppT app m a
fmap :: forall a b. (a -> b) -> AppT app m a -> AppT app m b
$cfmap :: forall app (m :: * -> *) a b.
Functor m =>
(a -> b) -> AppT app m a -> AppT app m b
Functor
    , forall a. a -> AppT app m a
forall a b. AppT app m a -> AppT app m b -> AppT app m a
forall a b. AppT app m a -> AppT app m b -> AppT app m b
forall a b. AppT app m (a -> b) -> AppT app m a -> AppT app m b
forall a b c.
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
forall {app} {m :: * -> *}. Applicative m => Functor (AppT app m)
forall app (m :: * -> *) a. Applicative m => a -> AppT app m a
forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m a
forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m b
forall app (m :: * -> *) a b.
Applicative m =>
AppT app m (a -> b) -> AppT app m a -> AppT app m b
forall app (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. AppT app m a -> AppT app m b -> AppT app m a
$c<* :: forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m a
*> :: forall a b. AppT app m a -> AppT app m b -> AppT app m b
$c*> :: forall app (m :: * -> *) a b.
Applicative m =>
AppT app m a -> AppT app m b -> AppT app m b
liftA2 :: forall a b c.
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
$cliftA2 :: forall app (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> AppT app m a -> AppT app m b -> AppT app m c
<*> :: forall a b. AppT app m (a -> b) -> AppT app m a -> AppT app m b
$c<*> :: forall app (m :: * -> *) a b.
Applicative m =>
AppT app m (a -> b) -> AppT app m a -> AppT app m b
pure :: forall a. a -> AppT app m a
$cpure :: forall app (m :: * -> *) a. Applicative m => a -> AppT app m a
Applicative
    , forall a. a -> AppT app m a
forall a b. AppT app m a -> AppT app m b -> AppT app m b
forall a b. AppT app m a -> (a -> AppT app m b) -> AppT app m b
forall {app} {m :: * -> *}. Monad m => Applicative (AppT app m)
forall app (m :: * -> *) a. Monad m => a -> AppT app m a
forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> AppT app m b -> AppT app m b
forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> (a -> AppT app m b) -> AppT app m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> AppT app m a
$creturn :: forall app (m :: * -> *) a. Monad m => a -> AppT app m a
>> :: forall a b. AppT app m a -> AppT app m b -> AppT app m b
$c>> :: forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> AppT app m b -> AppT app m b
>>= :: forall a b. AppT app m a -> (a -> AppT app m b) -> AppT app m b
$c>>= :: forall app (m :: * -> *) a b.
Monad m =>
AppT app m a -> (a -> AppT app m b) -> AppT app m b
Monad
    , forall a. IO a -> AppT app m a
forall {app} {m :: * -> *}. MonadIO m => Monad (AppT app m)
forall app (m :: * -> *) a. MonadIO m => IO a -> AppT app m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> AppT app m a
$cliftIO :: forall app (m :: * -> *) a. MonadIO m => IO a -> AppT app m a
MonadIO
    , forall b.
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
forall {app} {m :: * -> *}. MonadUnliftIO m => MonadIO (AppT app m)
forall app (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
forall (m :: * -> *).
MonadIO m
-> (forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
withRunInIO :: forall b.
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
$cwithRunInIO :: forall app (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. AppT app m a -> IO a) -> IO b) -> AppT app m b
MonadUnliftIO
    , forall a. ResourceT IO a -> AppT app m a
forall app (m :: * -> *). MonadIO m => MonadIO (AppT app m)
forall app (m :: * -> *) a.
MonadIO m =>
ResourceT IO a -> AppT app m a
forall (m :: * -> *).
MonadIO m -> (forall a. ResourceT IO a -> m a) -> MonadResource m
liftResourceT :: forall a. ResourceT IO a -> AppT app m a
$cliftResourceT :: forall app (m :: * -> *) a.
MonadIO m =>
ResourceT IO a -> AppT app m a
MonadResource
    , MonadReader app
    , forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
forall {app} {m :: * -> *}. MonadIO m => Monad (AppT app m)
forall app (m :: * -> *) msg.
(MonadIO m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
forall (m :: * -> *).
Monad m
-> (forall msg.
    ToLogStr msg =>
    Loc -> LogSource -> LogLevel -> msg -> m ())
-> MonadLogger m
monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
$cmonadLoggerLog :: forall app (m :: * -> *) msg.
(MonadIO m, ToLogStr msg) =>
Loc -> LogSource -> LogLevel -> msg -> AppT app m ()
MonadLogger
    , forall e a. Exception e => e -> AppT app m a
forall {app} {m :: * -> *}. MonadThrow m => Monad (AppT app m)
forall app (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> AppT app m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> AppT app m a
$cthrowM :: forall app (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> AppT app m a
MonadThrow
    , forall e a.
Exception e =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
forall {app} {m :: * -> *}. MonadCatch m => MonadThrow (AppT app m)
forall app (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
$ccatch :: forall app (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
AppT app m a -> (e -> AppT app m a) -> AppT app m a
MonadCatch
    , forall b.
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
forall a b c.
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
forall {app} {m :: * -> *}. MonadMask m => MonadCatch (AppT app m)
forall app (m :: * -> *) b.
MonadMask m =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
forall app (m :: * -> *) a b c.
MonadMask m =>
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
$cgeneralBracket :: forall app (m :: * -> *) a b c.
MonadMask m =>
AppT app m a
-> (a -> ExitCase b -> AppT app m c)
-> (a -> AppT app m b)
-> AppT app m (b, c)
uninterruptibleMask :: forall b.
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
$cuninterruptibleMask :: forall app (m :: * -> *) b.
MonadMask m =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
mask :: forall b.
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
$cmask :: forall app (m :: * -> *) b.
MonadMask m =>
((forall a. AppT app m a -> AppT app m a) -> AppT app m b)
-> AppT app m b
MonadMask
    )

runAppT
  :: ( MonadMask m
     , MonadUnliftIO m
     , HasColorOption options
     , HasVerboseOption options
     , HasAutoSSOOption options
     )
  => options
  -> AppT (App options) m a
  -> m a
runAppT :: forall (m :: * -> *) options a.
(MonadMask m, MonadUnliftIO m, HasColorOption options,
 HasVerboseOption options, HasAutoSSOOption options) =>
options -> AppT (App options) m a -> m a
runAppT options
options AppT (App options) m a
f = do
  LogSettings
envLogSettings <-
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. LogSettings -> IO LogSettings
LoggingEnv.parseWith
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> LogSettings -> LogSettings
setLogSettingsConcurrency (forall a. a -> Maybe a
Just Int
1)
      forall a b. (a -> b) -> a -> b
$ LogSettings
defaultLogSettings

  Logger
logger <-
    forall (m :: * -> *). MonadIO m => LogSettings -> m Logger
newLogger
      forall a b. (a -> b) -> a -> b
$ Maybe ColorOption -> Verbosity -> LogSettings -> LogSettings
adjustLogSettings
        (options
options forall s a. s -> Getting a s a -> a
^. forall env. HasColorOption env => Lens' env (Maybe ColorOption)
colorOptionL)
        (options
options forall s a. s -> Getting a s a -> a
^. forall env. HasVerboseOption env => Lens' env Verbosity
verboseOptionL)
        LogSettings
envLogSettings

  App options
app <- forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadUnliftIO m, HasLogger env) =>
env -> LoggingT m a -> m a
runLoggerLoggingT Logger
logger forall a b. (a -> b) -> a -> b
$ do
    AwsEnv
aws <- forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) env options a.
(MonadUnliftIO m, MonadReader env m, MonadLogger m, HasLogger env,
 HasAutoSSOOption options) =>
options -> m a -> m a
handleAutoSSO options
options forall (m :: * -> *). MonadLoggerIO m => m AwsEnv
awsEnvDiscover) Logger
logger

    forall options.
Logger -> Config -> options -> AwsScope -> AwsEnv -> App options
App Logger
logger
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). (MonadIO m, MonadLogger m) => m Config
loadConfigOrExit
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure options
options
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
m AwsScope
fetchAwsScope AwsEnv
aws
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure AwsEnv
aws

  let
    AwsScope {LogSource
Region
AccountId
awsRegion :: AwsScope -> Region
awsAccountName :: AwsScope -> LogSource
awsAccountId :: AwsScope -> AccountId
awsRegion :: Region
awsAccountName :: LogSource
awsAccountId :: AccountId
..} = forall options. App options -> AwsScope
appAwsScope App options
app

    context :: [Pair]
context =
      [ Key
"region" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Region
awsRegion
      , Key
"accountId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AccountId
awsAccountId
      , Key
"accountName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= LogSource
awsAccountName
      ]

  forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env a.
(MonadUnliftIO m, HasLogger env) =>
env -> LoggingT m a -> m a
runLoggerLoggingT App options
app
    forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT App options
app
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[Pair] -> m a -> m a
withThreadContext [Pair]
context
    forall a b. (a -> b) -> a -> b
$ forall app (m :: * -> *) a.
AppT app m a -> ReaderT app (LoggingT (ResourceT m)) a
unAppT AppT (App options) m a
f

adjustLogSettings
  :: Maybe ColorOption -> Verbosity -> LogSettings -> LogSettings
adjustLogSettings :: Maybe ColorOption -> Verbosity -> LogSettings -> LogSettings
adjustLogSettings Maybe ColorOption
mco Verbosity
v =
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (LogColor -> LogSettings -> LogSettings
setLogSettingsColor forall b c a. (b -> c) -> (a -> b) -> a -> c
. ColorOption -> LogColor
unColorOption) Maybe ColorOption
mco forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> LogSettings -> LogSettings
verbositySetLogLevels Verbosity
v