Update deps, fix log flushing bug

package.yaml

@@ -24,6 +24,7 @@ ghc-options:
   - -Wno-missing-import-lists
   - -Wno-missing-kind-signatures
   - -Wno-missing-local-signatures
+  - -Wno-missing-role-annotations
   - -Wno-missing-safe-haskell-mode
   - -Wno-prepositive-qualified-module
   - -Wno-unsafe

src/Stackctl/AWS/CloudFormation.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DuplicateRecordFields #-}
+
 module Stackctl.AWS.CloudFormation
   ( Stack (..)
   , stack_stackName

src/Stackctl/AWS/Core.hs

@@ -77,8 +77,6 @@ simple
      , MonadIO m
      , MonadAWS m
      , AWSRequest a
-     , Typeable a
-     , Typeable (AWSResponse a)
      )
   => a
   -> (AWSResponse a -> Maybe b)

src/Stackctl/AWS/Orphans.hs

@@ -14,6 +14,9 @@ import Amazonka.CloudFormation.Types
 import Data.Aeson
 import GHC.Generics (Rep)
 
+-- TODO: upstream
+deriving newtype instance MonadUnliftIO m => MonadUnliftIO (WithLogger env m)
+
 -- Makes it syntactally easier to do a bunch of these
 newtype Generically a = Generically {unGenerically :: a}
 

src/Stackctl/AWS/Scope.hs

@@ -27,12 +27,14 @@ awsScopeSpecPatterns AwsScope {..} =
   [ compile
       $ "stacks"
         </> unpack (unAccountId awsAccountId) <> ".*"
-        </> unpack (fromRegion awsRegion) <> "**"
+        </> unpack (fromRegion awsRegion)
+        </> "**"
         </> "*" <.> "yaml"
   , compile
       $ "stacks"
         </> "*." <> unpack (unAccountId awsAccountId)
-        </> unpack (fromRegion awsRegion) <> "**"
+        </> unpack (fromRegion awsRegion)
+        </> "**"
         </> "*" <.> "yaml"
   ]
 

src/Stackctl/CLI.hs

@@ -7,6 +7,7 @@ module Stackctl.CLI
 
 import Stackctl.Prelude
 
+import Blammo.Logging.LogSettings
 import qualified Blammo.Logging.LogSettings.Env as LoggingEnv
 import Control.Monad.AWS as AWS
 import Control.Monad.AWS.ViaReader as AWS
@@ -60,7 +61,7 @@ instance HasAutoSSOOption options => HasAutoSSOOption (App options) where
   autoSSOOptionL = optionsL . autoSSOOptionL
 
 newtype AppT app m a = AppT
-  { unAppT :: ReaderT app (LoggingT (ResourceT m)) a
+  { unAppT :: ReaderT app (ResourceT m) a
   }
   deriving newtype
     ( Functor
@@ -70,12 +71,13 @@ newtype AppT app m a = AppT
     , MonadUnliftIO
     , MonadResource
     , MonadReader app
-    , MonadLogger
     , MonadThrow
     , MonadCatch
     , MonadMask
     )
   deriving (MonadAWS) via (ReaderAWS (AppT app m))
+  deriving (MonadLogger) via (WithLogger app (ResourceT m))
+  deriving (MonadLoggerIO) via (WithLogger app (ResourceT m))
 
 runAppT
   :: ( MonadMask m
@@ -94,36 +96,33 @@ runAppT options f = do
       . setLogSettingsConcurrency (Just 1)
       $ defaultLogSettings
 
-  logger <-
-    newLogger
-      $ adjustLogSettings
-        (options ^. colorOptionL)
-        (options ^. verboseOptionL)
-        envLogSettings
-
-  app <- runResourceT $ runLoggerLoggingT logger $ do
-    aws <- runReaderT (handleAutoSSO options AWS.discover) logger
-
-    App logger
-      <$> loadConfigOrExit
-      <*> pure options
-      <*> AWS.runEnvT 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
+  let logSettings =
+        adjustLogSettings
+          (options ^. colorOptionL)
+          (options ^. verboseOptionL)
+          envLogSettings
+
+  withLogger logSettings $ \appLogger -> do
+    appAwsEnv <- runWithLogger appLogger $ handleAutoSSO options AWS.discover
+    appConfig <- runWithLogger appLogger loadConfigOrExit
+    appAwsScope <- AWS.runEnvT fetchAwsScope appAwsEnv
+
+    let
+      AwsScope {..} = appAwsScope
+
+      context =
+        [ "region" .= awsRegion
+        , "accountId" .= awsAccountId
+        , "accountName" .= awsAccountName
+        ]
+
+      appOptions = options
+      app = App {..}
+
+    runResourceT
+      $ flip runReaderT app
+      $ withThreadContext context
+      $ unAppT f
 
 adjustLogSettings
   :: Maybe ColorOption -> Verbosity -> LogSettings -> LogSettings

src/Stackctl/Prelude.hs

@@ -20,6 +20,8 @@ import RIO as X hiding
   )
 
 import Blammo.Logging as X
+import Blammo.Logging.Setup as X
+import Blammo.Logging.ThreadContext as X
 import Control.Error.Util as X (hush, note)
 import Data.Aeson as X (ToJSON (..), object)
 import Data.Text as X (pack, unpack)

src/Stackctl/StackSpecYaml.hs

@@ -107,7 +107,7 @@ instance ToJSON ParametersYaml where
   toJSON = object . parametersYamlPairs
   toEncoding = pairs . mconcat . parametersYamlPairs
 
-parametersYamlPairs :: KeyValue kv => ParametersYaml -> [kv]
+parametersYamlPairs :: KeyValue e kv => ParametersYaml -> [kv]
 parametersYamlPairs = map parameterYamlPair . unParametersYaml
 
 parametersYaml :: [ParameterYaml] -> ParametersYaml
@@ -124,7 +124,7 @@ instance FromJSON ParameterYaml where
     (mkParameterYaml <$> o .: "Name" <*> o .:? "Value")
       <|> (mkParameterYaml <$> o .: "ParameterKey" <*> o .:? "ParameterValue")
 
-parameterYamlPair :: KeyValue kv => ParameterYaml -> kv
+parameterYamlPair :: KeyValue e kv => ParameterYaml -> kv
 parameterYamlPair ParameterYaml {..} = pyKey .= pyValue
 
 parameterYaml :: Parameter -> Maybe ParameterYaml
@@ -235,7 +235,7 @@ instance ToJSON TagsYaml where
   toJSON = object . tagsYamlPairs
   toEncoding = pairs . mconcat . tagsYamlPairs
 
-tagsYamlPairs :: KeyValue kv => TagsYaml -> [kv]
+tagsYamlPairs :: KeyValue e kv => TagsYaml -> [kv]
 tagsYamlPairs = map tagYamlPair . unTagsYaml
 
 tagsYaml :: [TagYaml] -> TagsYaml
@@ -251,5 +251,5 @@ instance FromJSON TagYaml where
     t <- newTag <$> o .: "Key" <*> o .: "Value"
     pure $ TagYaml t
 
-tagYamlPair :: KeyValue kv => TagYaml -> kv
+tagYamlPair :: KeyValue e kv => TagYaml -> kv
 tagYamlPair (TagYaml t) = Key.fromText (t ^. tag_key) .= (t ^. tag_value)

src/Stackctl/VerboseOption.hs

@@ -7,6 +7,7 @@ module Stackctl.VerboseOption
 
 import Stackctl.Prelude
 
+import Blammo.Logging.LogSettings
 import Blammo.Logging.LogSettings.LogLevels
 import Options.Applicative
 

stack.yaml

@@ -1,6 +1,17 @@
-resolver: lts-22.6
+resolver: lts-23.7
 
 extra-deps:
-  - Blammo-1.1.2.3
+  - github: brendanhay/amazonka
+    commit: f3a7fca02fdbb832cc348e991983b1465225d50c
+    subdirs:
+      - lib/amazonka
+      - lib/amazonka-core
+      - lib/services/amazonka-cloudformation
+      - lib/services/amazonka-ec2
+      - lib/services/amazonka-lambda
+      - lib/services/amazonka-sso
+      - lib/services/amazonka-sts
+
   - amazonka-mtl-0.1.1.0
   - cfn-flip-0.1.0.3
+  - microlens-pro-0.2.0.2