Add settings switch for activity debug reports
This commit is contained in:
parent
d24710c46a
commit
46fb4d1512
5 changed files with 29 additions and 14 deletions
|
@ -160,3 +160,8 @@ drop-delivery-after:
|
|||
retry-delivery-every:
|
||||
amount: 1
|
||||
unit: hours
|
||||
|
||||
# How many activities to remember in the debug report list, showing latest
|
||||
# activities received in local inboxes and the result of their processing.
|
||||
# 'null' means disable the report page entirely.
|
||||
#activity-debug-reports: 10
|
||||
|
|
|
@ -130,7 +130,10 @@ makeFoundation appSettings = do
|
|||
|
||||
appActorFetchShare <- newResultShare actorFetchShareAction
|
||||
|
||||
appActivities <- newTVarIO mempty
|
||||
appActivities <-
|
||||
case appInboxDebugReportLength appSettings of
|
||||
Nothing -> return Nothing
|
||||
Just n -> Just . (n,) <$> newTVarIO mempty
|
||||
|
||||
-- We need a log function to create a connection pool. We need a connection
|
||||
-- pool to create our foundation. And we need our foundation to get a
|
||||
|
|
|
@ -113,7 +113,7 @@ data App = App
|
|||
, appHashidsContext :: HashidsContext
|
||||
, appActorFetchShare :: ActorFetchShare App
|
||||
|
||||
, appActivities :: TVar (Vector ActivityReport)
|
||||
, appActivities :: Maybe (Int, TVar (Vector ActivityReport))
|
||||
}
|
||||
|
||||
-- Aliases for the routes file, because it doesn't like spaces in path piece
|
||||
|
|
|
@ -105,7 +105,8 @@ import Vervis.Settings
|
|||
|
||||
getInboxR :: Handler Html
|
||||
getInboxR = do
|
||||
acts <- liftIO . readTVarIO =<< getsYesod appActivities
|
||||
acts <-
|
||||
liftIO . readTVarIO . snd =<< maybe notFound return =<< getsYesod appActivities
|
||||
defaultLayout
|
||||
[whamlet|
|
||||
<p>
|
||||
|
@ -187,7 +188,8 @@ postSharerInboxR shrRecip = do
|
|||
"application/ld+json; \
|
||||
\profile=\"https://www.w3.org/ns/activitystreams\""
|
||||
recordActivity now result contentTypes = do
|
||||
acts <- getsYesod appActivities
|
||||
macts <- getsYesod appActivities
|
||||
for_ macts $ \ (size, acts) ->
|
||||
liftIO $ atomically $ modifyTVar' acts $ \ vec ->
|
||||
let (msg, body) =
|
||||
case result of
|
||||
|
@ -195,7 +197,7 @@ postSharerInboxR shrRecip = do
|
|||
Right (o, t) -> (t, encodePretty o)
|
||||
item = ActivityReport now msg contentTypes body
|
||||
vec' = item `V.cons` vec
|
||||
in if V.length vec' > 10
|
||||
in if V.length vec' > size
|
||||
then V.init vec'
|
||||
else vec'
|
||||
|
||||
|
|
|
@ -148,6 +148,10 @@ data AppSettings = AppSettings
|
|||
, appDropDeliveryAfter :: NominalDiffTime
|
||||
-- | How much time to wait between retries of failed deliveries.
|
||||
, appDeliveryRetryFreq :: TimeInterval
|
||||
-- | How many activities to remember in the debug report list, showing
|
||||
-- latest activities received in local inboxes and the result of their
|
||||
-- processing. 'Nothing' means disable the report page entirely.
|
||||
, appInboxDebugReportLength :: Maybe Int
|
||||
}
|
||||
|
||||
instance FromJSON AppSettings where
|
||||
|
@ -196,6 +200,7 @@ instance FromJSON AppSettings where
|
|||
appRejectOnMaxKeys <- o .: "reject-on-max-keys"
|
||||
appDropDeliveryAfter <- ndt <$> o .: "drop-delivery-after"
|
||||
appDeliveryRetryFreq <- interval <$> o .: "retry-delivery-every"
|
||||
appInboxDebugReportLength <- o .:? "activity-debug-reports"
|
||||
|
||||
return AppSettings {..}
|
||||
where
|
||||
|
|
Loading…
Reference in a new issue