Display times and link to activity in inbox, outbox and notifications

This commit is contained in:
fr33domlover 2019-06-30 14:04:28 +00:00
parent dc631a98c5
commit 31d7e9eac7
4 changed files with 84 additions and 32 deletions

View file

@ -61,6 +61,7 @@ import Data.Time.Interval (TimeInterval, toTimeUnit)
import Data.Time.Units (Second)
import Data.Traversable
import Database.Persist
import Database.Persist.Sql
import Network.HTTP.Client (Manager, HttpException, requestFromURI)
import Network.HTTP.Simple (httpJSONEither, getResponseBody, setRequestManager, addRequestHeader)
import Network.HTTP.Types.Header (hDate, hHost)
@ -127,11 +128,24 @@ import Vervis.RemoteActorStore
import Yesod.RenderSource
import Vervis.Settings
getShowTime = showTime <$> liftIO getCurrentTime
where
showTime now =
showEventTime .
intervalToEventTime .
FriendlyConvert .
diffUTCTime now
objectSummary o =
case M.lookup "summary" o of
Just (String t) | not (T.null t) -> Just t
_ -> Nothing
objectId o =
case M.lookup "id" o <|> M.lookup "@id" o of
Just (String t) | not (T.null t) -> t
_ -> error "'id' field not found"
getInboxR :: Handler Html
getInboxR = do
acts <-
@ -200,11 +214,12 @@ getInbox here getInboxId = do
then Just $ pageUrl $ current + 1
else Nothing
, collectionPageStartIndex = Nothing
, collectionPageItems = items
, collectionPageItems = map fst items
}
provideRep $
provideRep $ do
let pageNav = navWidget navModel
in defaultLayout $(widgetFile "person/inbox")
showTime <- getShowTime
defaultLayout $(widgetFile "person/inbox")
where
countItems ibid =
(+) <$> count [InboxItemLocalInbox ==. ibid]
@ -230,17 +245,24 @@ getInbox here getInboxId = do
return
( ib E.^. InboxItemId
, ob E.?. OutboxItemActivity
, ob E.?. OutboxItemPublished
, ract E.?. RemoteActivityContent
, ract E.?. RemoteActivityReceived
)
adaptItem (E.Value ibid, E.Value mact, E.Value mobj) =
case (mact, mobj) of
(Nothing, Nothing) ->
error $
"InboxItem #" ++ show ibid ++ " neither local nor remote"
(Just _, Just _) ->
error $ "InboxItem #" ++ show ibid ++ " both local and remote"
(Just act, Nothing) -> persistJSONObject act
(Nothing, Just obj) -> persistJSONObject obj
adaptItem
(E.Value ibid, E.Value mact, E.Value mpub, E.Value mobj, E.Value mrec) =
case (mact, mpub, mobj, mrec) of
(Nothing, Nothing, Nothing, Nothing) ->
error $ ibiidString ++ " neither local nor remote"
(Just _, Just _, Just _, Just _) ->
error $ ibiidString ++ " both local and remote"
(Just act, Just pub, Nothing, Nothing) ->
(persistJSONObject act, (pub, False))
(Nothing, Nothing, Just obj, Just rec) ->
(persistJSONObject obj, (rec, True))
_ -> error $ "Unexpected query result for " ++ ibiidString
where
ibiidString = "InboxItem #" ++ show (fromSqlKey ibid)
getSharerInboxR :: ShrIdent -> Handler TypedContent
getSharerInboxR shr = getInbox here getInboxId
@ -460,12 +482,7 @@ getOutbox here getObid = do
}
provideRep $ do
let pageNav = navWidget navModel
now <- liftIO getCurrentTime
let showTime =
showEventTime .
intervalToEventTime .
FriendlyConvert .
diffUTCTime now
showTime <- getShowTime
defaultLayout $(widgetFile "person/outbox")
getOutboxItem
@ -671,12 +688,13 @@ getNotificationsR shr = do
p <- getValBy404 $ UniquePersonIdent sid
let ibid = personInbox p
map adaptItem <$> getItems ibid
notifications <- for items $ \ (ibid, activity) -> do
notifications <- for items $ \ (ibiid, activity) -> do
((_result, widget), enctype) <-
runFormPost $ notificationForm $ Just $ Just (ibid, False)
runFormPost $ notificationForm $ Just $ Just (ibiid, False)
return (activity, widget, enctype)
((_result, widgetAll), enctypeAll) <-
runFormPost $ notificationForm $ Just Nothing
showTime <- getShowTime
defaultLayout $(widgetFile "person/notifications")
where
getItems ibid =
@ -700,17 +718,24 @@ getNotificationsR shr = do
return
( ib E.^. InboxItemId
, ob E.?. OutboxItemActivity
, ob E.?. OutboxItemPublished
, ract E.?. RemoteActivityContent
, ract E.?. RemoteActivityReceived
)
adaptItem (E.Value ibid, E.Value mact, E.Value mobj) =
case (mact, mobj) of
(Nothing, Nothing) ->
error $
"InboxItem #" ++ show ibid ++ " neither local nor remote"
(Just _, Just _) ->
error $ "InboxItem #" ++ show ibid ++ " both local and remote"
(Just act, Nothing) -> (ibid, persistJSONObject act)
(Nothing, Just obj) -> (ibid, persistJSONObject obj)
adaptItem
(E.Value ibid, E.Value mact, E.Value mpub, E.Value mobj, E.Value mrec) =
case (mact, mpub, mobj, mrec) of
(Nothing, Nothing, Nothing, Nothing) ->
error $ ibiidString ++ " neither local nor remote"
(Just _, Just _, Just _, Just _) ->
error $ ibiidString ++ " both local and remote"
(Just act, Just pub, Nothing, Nothing) ->
(ibid, (persistJSONObject act, (pub, False)))
(Nothing, Nothing, Just obj, Just rec) ->
(ibid, (persistJSONObject obj, (rec, True)))
_ -> error $ "Unexpected query result for " ++ ibiidString
where
ibiidString = "InboxItem #" ++ show (fromSqlKey ibid)
postNotificationsR :: ShrIdent -> Handler Html
postNotificationsR shr = do

View file

@ -20,11 +20,21 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
^{pageNav}
<div>
$forall obj <- items
$forall (obj, (time, isRemote)) <- items
<div>
$if isRemote
Received
$else
Published
<a href="#{objectId obj}">
#{showTime time}
$maybe summary <- objectSummary obj
<div>
^{preEscapedToHtml summary}
$nothing
^{renderPrettyJSONSkylighting obj}
<hr>
^{pageNav}

View file

@ -17,12 +17,23 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<input type=submit value="Mark all as read">
<div>
$forall (obj, widget, enctype) <- notifications
$forall ((obj, (time, isRemote)), widget, enctype) <- notifications
<div>
$if isRemote
Received
$else
Published
<a href="#{objectId obj}">
#{showTime time}
$maybe summary <- objectSummary obj
<div>
^{preEscapedToHtml summary}
$nothing
^{renderPrettyJSONSkylighting obj}
<form method=POST action=@{NotificationsR shr} enctype=#{enctype}>
^{widget}
<input type=submit value="Mark as read">
<hr>

View file

@ -21,12 +21,18 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<div>
$forall Entity _ (OutboxItem _ doc published) <- items
<div>#{showTime published}
$with obj <- persistJSONObject doc
<div>
Published
<a href="#{objectId obj}">
#{showTime published}
$maybe summary <- objectSummary obj
<div>
^{preEscapedToHtml summary}
$nothing
^{renderPrettyJSONSkylighting obj}
<hr>
^{pageNav}