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

src/Vervis/Handler/Inbox.hs

@@ -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) =
+    adaptItem
-        case (mact, mobj) of
+        (E.Value ibid, E.Value mact, E.Value mpub, E.Value mobj, E.Value mrec) =
-            (Nothing, Nothing) ->
+            case (mact, mpub, mobj, mrec) of
-                error $
+                (Nothing, Nothing, Nothing, Nothing) ->
-                    "InboxItem #" ++ show ibid ++ " neither local nor remote"
+                    error $ ibiidString ++ " neither local nor remote"
-            (Just _, Just _) ->
+                (Just _, Just _, Just _, Just _) ->
-                error $ "InboxItem #" ++ show ibid ++ " both local and remote"
+                    error $ ibiidString ++ " both local and remote"
-            (Just act, Nothing) -> persistJSONObject act
+                (Just act, Just pub, Nothing, Nothing) ->
-            (Nothing, Just obj) -> persistJSONObject obj
+                    (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
+                    showTime <- getShowTime
-                    let showTime =
-                            showEventTime .
-                            intervalToEventTime .
-                            FriendlyConvert .
-                            diffUTCTime now
                     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) =
+    adaptItem
-        case (mact, mobj) of
+        (E.Value ibid, E.Value mact, E.Value mpub, E.Value mobj, E.Value mrec) =
-            (Nothing, Nothing) ->
+            case (mact, mpub, mobj, mrec) of
-                error $
+                (Nothing, Nothing, Nothing, Nothing) ->
-                    "InboxItem #" ++ show ibid ++ " neither local nor remote"
+                    error $ ibiidString ++ " neither local nor remote"
-            (Just _, Just _) ->
+                (Just _, Just _, Just _, Just _) ->
-                error $ "InboxItem #" ++ show ibid ++ " both local and remote"
+                    error $ ibiidString ++ " both local and remote"
-            (Just act, Nothing) -> (ibid, persistJSONObject act)
+                (Just act, Just pub, Nothing, Nothing) ->
-            (Nothing, Just obj) -> (ibid, persistJSONObject obj)
+                    (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

templates/person/inbox.hamlet

@@ -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}

templates/person/notifications.hamlet

@@ -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>

templates/person/outbox.hamlet

@@ -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}