Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Cargohold: Log more about AWS errors #1205

Merged
merged 2 commits into from
Sep 17, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 23 additions & 4 deletions services/cargohold/src/CargoHold/AWS.hs
Original file line number Diff line number Diff line change
Expand Up @@ -129,8 +129,17 @@ mkEnv lgr s3End s3Download bucket cfOpts mgr = do
<&> AWS.configure s3
awsLogger g l = Logger.log g (mapLevel l) . Log.msg . toLazyByteString
mapLevel AWS.Info = Logger.Info
-- Debug output from amazonka can be very useful for tracing requests
-- but is very verbose (and multiline which we don't handle well)
-- distracting from our own debug logs, so we map amazonka's 'Debug'
-- level to our 'Trace' level.
mapLevel AWS.Debug = Logger.Trace
mapLevel AWS.Trace = Logger.Trace
-- n.b. Errors are either returned or thrown. In both cases they will
-- already be logged if left unhandled. We don't want errors to be
-- logged inside amazonka already, before we even had a chance to handle
-- them, which results in distracting noise. For debugging purposes,
-- they are still revealed on debug level.
mapLevel AWS.Error = Logger.Debug

execute :: MonadIO m => Env -> Amazon a -> m a
Expand Down Expand Up @@ -158,13 +167,23 @@ throwA :: Either AWS.Error a -> Amazon a
throwA = either (throwM . GeneralError) return

exec ::
(AWSRequest r, MonadIO m) =>
(AWSRequest r, Show r, MonadLogger m, MonadIO m, MonadThrow m) =>
Env ->
(Text -> r) ->
m (Rs r)
exec env request = do
let bucket = _s3Bucket env
execute env (AWS.send $ request bucket)
let req = request (_s3Bucket env)
resp <- execute env (sendCatch req)
case resp of
Left err -> do
Log.info $
Log.field "remote" (Log.val "S3")
~~ Log.msg (show err)
~~ Log.msg (show req)
-- We just re-throw the error, but logging it here also gives us the request
-- that caused it.
throwM (GeneralError err)
Right r -> return r

execCatch ::
(AWSRequest r, Show r, MonadLogger m, MonadIO m) =>
Expand All @@ -176,7 +195,7 @@ execCatch env request = do
resp <- execute env (retrying retry5x (const canRetry) (const (sendCatch req)))
case resp of
Left err -> do
Log.debug $
Log.info $
Log.field "remote" (Log.val "S3")
~~ Log.msg (show err)
~~ Log.msg (show req)
Expand Down
4 changes: 2 additions & 2 deletions services/cargohold/src/CargoHold/S3.hs
Original file line number Diff line number Diff line change
Expand Up @@ -107,7 +107,7 @@ uploadV3 ::
Conduit.ConduitM () ByteString (ResourceT IO) () ->
ExceptT Error App ()
uploadV3 prc (s3Key . mkKey -> key) (V3.AssetHeaders ct cl md5) tok src = do
Log.debug $
Log.info $
"remote" .= val "S3"
~~ "asset.owner" .= toByteString prc
~~ "asset.key" .= key
Expand Down Expand Up @@ -728,7 +728,7 @@ parseAmzMeta k h = lookupCI k h >>= fromByteString . encodeUtf8
octets :: MIME.Type
octets = MIME.Type (MIME.Application "octet-stream") []

exec :: (AWSRequest r) => (Text -> r) -> ExceptT Error App (Rs r)
exec :: (AWSRequest r, Show r) => (Text -> r) -> ExceptT Error App (Rs r)
exec req = do
env <- view aws
AWS.exec env req
Expand Down