CLI.hs

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
  { appLogger :: Logger
  , appConfig :: Config
  , appOptions :: options
  , appAwsScope :: AwsScope
  , appAwsEnv :: AwsEnv
  }

optionsL :: Lens' (App options) options
optionsL = lens appOptions $ \x y -> x {appOptions = y}

instance HasLogger (App options) where
  loggerL = lens appLogger $ \x y -> x {appLogger = y}

instance HasConfig (App options) where
  configL = lens appConfig $ \x y -> x {appConfig = y}

instance HasAwsScope (App options) where
  awsScopeL = lens appAwsScope $ \x y -> x {appAwsScope = y}

instance HasAwsEnv (App options) where
  awsEnvL = lens appAwsEnv $ \x y -> x {appAwsEnv = y}

instance HasDirectoryOption options => HasDirectoryOption (App options) where
  directoryOptionL = optionsL . directoryOptionL

instance HasFilterOption options => HasFilterOption (App options) where
  filterOptionL = optionsL . filterOptionL

instance HasColorOption options => HasColorOption (App options) where
  colorOptionL = optionsL . colorOptionL

instance HasVerboseOption options => HasVerboseOption (App options) where
  verboseOptionL = optionsL . verboseOptionL

instance HasAutoSSOOption options => HasAutoSSOOption (App options) where
  autoSSOOptionL = optionsL . autoSSOOptionL

newtype AppT app m a = AppT
  { unAppT :: ReaderT app (LoggingT (ResourceT m)) a
  }
  deriving newtype
    ( Functor
    , Applicative
    , Monad
    , MonadIO
    , MonadUnliftIO
    , MonadResource
    , MonadReader app
    , MonadLogger
    , MonadThrow
    , MonadCatch
    , MonadMask
    )

runAppT
  :: ( MonadMask m
     , MonadUnliftIO m
     , HasColorOption options
     , HasVerboseOption options
     , HasAutoSSOOption options
     )
  => options
  -> AppT (App options) m a
  -> m a
runAppT options f = do
  envLogSettings <-
    liftIO
      . LoggingEnv.parseWith
      . setLogSettingsConcurrency (Just 1)
      $ defaultLogSettings

  logger <-
    newLogger
      $ adjustLogSettings
        (options ^. colorOptionL)
        (options ^. verboseOptionL)
        envLogSettings

  app <- runResourceT $ runLoggerLoggingT logger $ do
    aws <- runReaderT (handleAutoSSO options awsEnvDiscover) logger

    App logger
      <$> loadConfigOrExit
      <*> pure options
      <*> runReaderT fetchAwsScope aws
      <*> pure aws

  let
    AwsScope {..} = appAwsScope app

    context =
      [ "region" .= awsRegion
      , "accountId" .= awsAccountId
      , "accountName" .= awsAccountName
      ]

  runResourceT
    $ runLoggerLoggingT app
    $ flip runReaderT app
    $ withThreadContext context
    $ unAppT f

adjustLogSettings
  :: Maybe ColorOption -> Verbosity -> LogSettings -> LogSettings
adjustLogSettings mco v =
  maybe id (setLogSettingsColor . unColorOption) mco . verbositySetLogLevels v