yesod-katip-0.1.0.0: Logging bridge between Yesod and Katip
Copyright(c) Isaac van Bakel 2020
LicenseBSD3
Maintainerivb@vanbakel.io
Stabilityexperimental
PortabilityPOSIX
Safe HaskellNone
LanguageHaskell2010

Yesod.Katip

Description

Katip's structured logging is useful, but adding logging after-the-fact to a Yesod site which already uses the Yesod-provided logging invocations can be a lot of work.

This module provides several convenience wrappers for converting existing Yesod sites into Katip-using versions without needing to modify any handlers. Instead, the wrapped versions will add in HTTP structures like requests, etc. automatically, and logs sent to Yesod will be intercepted and also sent to Katip along with any structure.

These wrappers are configurable - they can be made to redirect logs, duplicate them (sending both to Katip and the Yesod logger), or even ignore them, as necessary. See KatipConfig for more detail.

If your site has a Yesod instance, so will the wrapped version - so using it is as simple as passing the wrapped version along to WAI, or whichever server you use.

There's also support for using Katip's API for more direct control over your Katip logs inside Yesod handlers. This is based in SiteKatip, which is a ytl-style site class.

Synopsis

Documentation

newtype KatipSite site Source #

A wrapper for adding Katip functionality to a site.

This is the most basic wrapper. It will allow you to redirect logs from Yesod to Katip, as configured. It will not include HTTP structures in the output - for that, look at KatipContextSite instead.

Constructors

KatipSite 

Instances

Instances details
SiteTrans KatipSite Source # 
Instance details

Defined in Yesod.Katip

Methods

lift :: MonadSite m => m site a -> m (KatipSite site) a #

mapSiteT :: (MonadSite m, MonadSite n, SiteCompatible site site') => (m site a -> n site' b) -> m (KatipSite site) a -> n (KatipSite site') b #

Eq (Route site) => Eq (Route (KatipSite site)) Source # 
Instance details

Defined in Yesod.Katip

Methods

(==) :: Route (KatipSite site) -> Route (KatipSite site) -> Bool #

(/=) :: Route (KatipSite site) -> Route (KatipSite site) -> Bool #

(SiteCompatible site (KatipSite site), Yesod site, Eq (Route site)) => Yesod (KatipSite site) Source # 
Instance details

Defined in Yesod.Katip

Methods

approot :: Approot (KatipSite site) #

errorHandler :: ErrorResponse -> HandlerFor (KatipSite site) TypedContent #

defaultLayout :: WidgetFor (KatipSite site) () -> HandlerFor (KatipSite site) Html #

urlParamRenderOverride :: KatipSite site -> Route (KatipSite site) -> [(Text, Text)] -> Maybe Builder #

isAuthorized :: Route (KatipSite site) -> Bool -> HandlerFor (KatipSite site) AuthResult #

isWriteRequest :: Route (KatipSite site) -> HandlerFor (KatipSite site) Bool #

authRoute :: KatipSite site -> Maybe (Route (KatipSite site)) #

cleanPath :: KatipSite site -> [Text] -> Either [Text] [Text] #

joinPath :: KatipSite site -> Text -> [Text] -> [(Text, Text)] -> Builder #

addStaticContent :: Text -> Text -> ByteString -> HandlerFor (KatipSite site) (Maybe (Either Text (Route (KatipSite site), [(Text, Text)]))) #

maximumContentLength :: KatipSite site -> Maybe (Route (KatipSite site)) -> Maybe Word64 #

maximumContentLengthIO :: KatipSite site -> Maybe (Route (KatipSite site)) -> IO (Maybe Word64) #

makeLogger :: KatipSite site -> IO Logger #

messageLoggerSource :: KatipSite site -> Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO () #

jsLoader :: KatipSite site -> ScriptLoadPosition (KatipSite site) #

jsAttributes :: KatipSite site -> [(Text, Text)] #

jsAttributesHandler :: HandlerFor (KatipSite site) [(Text, Text)] #

makeSessionBackend :: KatipSite site -> IO (Maybe SessionBackend) #

fileUpload :: KatipSite site -> RequestBodyLength -> FileUpload #

shouldLogIO :: KatipSite site -> LogSource -> LogLevel -> IO Bool #

yesodMiddleware :: ToTypedContent res => HandlerFor (KatipSite site) res -> HandlerFor (KatipSite site) res #

yesodWithInternalState :: KatipSite site -> Maybe (Route (KatipSite site)) -> (InternalState -> IO a) -> IO a #

defaultMessageWidget :: Html -> HtmlUrl (Route (KatipSite site)) -> WidgetFor (KatipSite site) () #

(RenderRoute site, Eq (Route site)) => RenderRoute (KatipSite site) Source # 
Instance details

Defined in Yesod.Katip

Associated Types

data Route (KatipSite site) #

Methods

renderRoute :: Route (KatipSite site) -> ([Text], [(Text, Text)]) #

SiteKatip (KatipSite site) Source # 
Instance details

Defined in Yesod.Katip

Methods

getLogEnv :: MonadSite m => m (KatipSite site) LogEnv Source #

localLogEnv :: MonadSite m => (LogEnv -> LogEnv) -> m (KatipSite site) a -> m (KatipSite site) a Source #

newtype Route (KatipSite site) Source # 
Instance details

Defined in Yesod.Katip

newtype Route (KatipSite site) = KRoute (Route (ReaderSite (KatipConfig, LogEnv) site))

data KatipContextSite site Source #

A wrapper for adding Katip functionality to a site.

This is the more featureful wrapper. It can redirect logs, just like KatipSite, but will also augment them with useful HTTP structure from Yesod.

Instances

Instances details
SiteTrans KatipContextSite Source # 
Instance details

Defined in Yesod.Katip

Methods

lift :: MonadSite m => m site a -> m (KatipContextSite site) a #

mapSiteT :: (MonadSite m, MonadSite n, SiteCompatible site site') => (m site a -> n site' b) -> m (KatipContextSite site) a -> n (KatipContextSite site') b #

Eq (Route site) => Eq (Route (KatipContextSite site)) Source # 
Instance details

Defined in Yesod.Katip

(LogItem Request, SiteCompatible site (KatipContextSite site), Yesod site, Eq (Route site)) => Yesod (KatipContextSite site) Source # 
Instance details

Defined in Yesod.Katip

Methods

approot :: Approot (KatipContextSite site) #

errorHandler :: ErrorResponse -> HandlerFor (KatipContextSite site) TypedContent #

defaultLayout :: WidgetFor (KatipContextSite site) () -> HandlerFor (KatipContextSite site) Html #

urlParamRenderOverride :: KatipContextSite site -> Route (KatipContextSite site) -> [(Text, Text)] -> Maybe Builder #

isAuthorized :: Route (KatipContextSite site) -> Bool -> HandlerFor (KatipContextSite site) AuthResult #

isWriteRequest :: Route (KatipContextSite site) -> HandlerFor (KatipContextSite site) Bool #

authRoute :: KatipContextSite site -> Maybe (Route (KatipContextSite site)) #

cleanPath :: KatipContextSite site -> [Text] -> Either [Text] [Text] #

joinPath :: KatipContextSite site -> Text -> [Text] -> [(Text, Text)] -> Builder #

addStaticContent :: Text -> Text -> ByteString -> HandlerFor (KatipContextSite site) (Maybe (Either Text (Route (KatipContextSite site), [(Text, Text)]))) #

maximumContentLength :: KatipContextSite site -> Maybe (Route (KatipContextSite site)) -> Maybe Word64 #

maximumContentLengthIO :: KatipContextSite site -> Maybe (Route (KatipContextSite site)) -> IO (Maybe Word64) #

makeLogger :: KatipContextSite site -> IO Logger #

messageLoggerSource :: KatipContextSite site -> Logger -> Loc -> LogSource -> LogLevel -> LogStr -> IO () #

jsLoader :: KatipContextSite site -> ScriptLoadPosition (KatipContextSite site) #

jsAttributes :: KatipContextSite site -> [(Text, Text)] #

jsAttributesHandler :: HandlerFor (KatipContextSite site) [(Text, Text)] #

makeSessionBackend :: KatipContextSite site -> IO (Maybe SessionBackend) #

fileUpload :: KatipContextSite site -> RequestBodyLength -> FileUpload #

shouldLogIO :: KatipContextSite site -> LogSource -> LogLevel -> IO Bool #

yesodMiddleware :: ToTypedContent res => HandlerFor (KatipContextSite site) res -> HandlerFor (KatipContextSite site) res #

yesodWithInternalState :: KatipContextSite site -> Maybe (Route (KatipContextSite site)) -> (InternalState -> IO a) -> IO a #

defaultMessageWidget :: Html -> HtmlUrl (Route (KatipContextSite site)) -> WidgetFor (KatipContextSite site) () #

(RenderRoute site, Eq (Route site)) => RenderRoute (KatipContextSite site) Source # 
Instance details

Defined in Yesod.Katip

Associated Types

data Route (KatipContextSite site) #

Methods

renderRoute :: Route (KatipContextSite site) -> ([Text], [(Text, Text)]) #

SiteKatipContext (KatipContextSite site) Source # 
Instance details

Defined in Yesod.Katip

SiteKatip (KatipContextSite site) Source # 
Instance details

Defined in Yesod.Katip

newtype Route (KatipContextSite site) Source # 
Instance details

Defined in Yesod.Katip

data KatipConfig Source #

Configuration for how KatipSite and KatipContextSite turn Yesod logs into Katip ones

Constructors

KatipConfig 

Fields

Instances

Instances details
Default KatipConfig Source # 
Instance details

Defined in Yesod.Katip

Methods

def :: KatipConfig #

data LoggingApproach Source #

Control how the Katip wrapper directs logs that come from Yesod.

Regardless of the choice of approach, logs will only be sent when shouldLogIO says they should.

Constructors

YesodOnly

Send these logs only to the Yesod logger configured by the site's Yesod instance already. This is provided only for debugging convenience - it doesn't make sense to use it in production.

KatipOnly

Send these logs only to the Katip scribes, ignoring the Yesod logger.

Both

Send logs to both the Katip scribes and the Yesod logger. If Katip is configured to log structure as well, this structure *won't* be sent to the Yesod logger. This is the default.