From 8303baa69d7ddfd8407a3df920018ae447e78dee Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sun, 5 May 2019 10:20:55 +0000 Subject: [PATCH] Implement GETing the personal inbox --- config/models | 6 ++++ src/Vervis/Federation.hs | 36 ++++++++++++++------ src/Vervis/Foundation.hs | 1 + src/Vervis/Handler/Inbox.hs | 63 +++++++++++++++++++++++++++++++---- src/Vervis/Migration.hs | 21 +++++++++--- templates/person/inbox.hamlet | 31 +++++++++++++++++ 6 files changed, 136 insertions(+), 22 deletions(-) create mode 100644 templates/person/inbox.hamlet diff --git a/config/models b/config/models index ea94bba..414c555 100644 --- a/config/models +++ b/config/models @@ -44,11 +44,15 @@ OutboxItem activity PersistActivity published UTCTime +InboxItem + InboxItemLocal person PersonId activity OutboxItemId + item InboxItemId UniqueInboxItemLocal person activity + UniqueInboxItemLocalItem item RemoteActivity instance InstanceId @@ -61,8 +65,10 @@ RemoteActivity InboxItemRemote person PersonId activity RemoteActivityId + item InboxItemId UniqueInboxItemRemote person activity + UniqueInboxItemRemoteItem item UnlinkedDelivery recipient UnfetchedRemoteActorId diff --git a/src/Vervis/Federation.hs b/src/Vervis/Federation.hs index 8a87b72..914ad98 100644 --- a/src/Vervis/Federation.hs +++ b/src/Vervis/Federation.hs @@ -605,12 +605,17 @@ handleSharerInbox _now shrRecip (Left pidAuthor) _raw activity = do throwE "Activity author in DB and in received JSON don't match" if pidRecip == pidAuthor then return "Received activity authored by self, ignoring" - else do - miblid <- lift $ insertUnique $ InboxItemLocal pidRecip obid + else lift $ do + ibid <- insert InboxItem + miblid <- insertUnique $ InboxItemLocal pidRecip obid ibid let recip = shr2text shrRecip - return $ case miblid of - Nothing -> "Activity already exists in inbox of /s/" <> recip - Just _ -> "Activity inserted to inbox of /s/" <> recip + case miblid of + Nothing -> do + delete ibid + return $ + "Activity already exists in inbox of /s/" <> recip + Just _ -> + return $ "Activity inserted to inbox of /s/" <> recip handleSharerInbox now shrRecip (Right iidSender) raw activity = case activitySpecific activity of CreateActivity (Create note) -> handleNote note @@ -684,11 +689,14 @@ handleSharerInbox now shrRecip (Right iidSender) raw activity = jsonObj = PersistJSON raw ract = RemoteActivity iidSender luActivity jsonObj now ractid <- either entityKey id <$> insertBy' ract - mibrid <- insertUnique $ InboxItemRemote pidRecip ractid + ibid <- insert InboxItem + mibrid <- insertUnique $ InboxItemRemote pidRecip ractid ibid let recip = shr2text shrRecip - return $ case mibrid of - Nothing -> "Activity already exists in inbox of /s/" <> recip - Just _ -> "Activity inserted to inbox of /s/" <> recip + case mibrid of + Nothing -> do + delete ibid + return $ "Activity already exists in inbox of /s/" <> recip + Just _ -> return $ "Activity inserted to inbox of /s/" <> recip handleProjectInbox :: UTCTime @@ -889,7 +897,11 @@ handleProjectInbox now shrRecip prjRecip iidSender hSender raidSender body raw a let pids = union teamPids fsPids -- TODO inefficient, see the other TODOs about mergeConcat remotes = map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes - for_ pids $ \ pid -> insertUnique_ $ InboxItemRemote pid ractid + for_ pids $ \ pid -> do + ibid <- insert InboxItem + mibrid <- insertUnique $ InboxItemRemote pid ractid ibid + when (isNothing mibrid) $ + delete ibid return remotes deliverRemoteDB @@ -1428,7 +1440,9 @@ handleOutboxNote host (Note mluNote luAttrib aud muParent muContext mpublished c -- lists have the same instance. , map (second $ NE.nubBy ((==) `on` fst4)) $ mergeConcat teamRemotes fsRemotes ) - lift $ for_ (union recipPids morePids) $ \ pid -> insert_ $ InboxItemLocal pid obid + lift $ for_ (union recipPids morePids) $ \ pid -> do + ibid <- insert InboxItem + insert_ $ InboxItemLocal pid obid ibid return remotes where getPersonId :: ShrIdent -> ExceptT Text AppDB PersonId diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index a7edc76..7897063 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -235,6 +235,7 @@ instance Yesod App where | a == resendVerifyR -> personFromResendForm (AuthR (PluginR "account" ["verify", u, _]), False) -> personUnver u + (SharerInboxR shr , False) -> person shr (OutboxR shr , True) -> person shr (GroupsR , True) -> personAny diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs index e908cb8..978c5fc 100644 --- a/src/Vervis/Handler/Inbox.hs +++ b/src/Vervis/Handler/Inbox.hs @@ -42,6 +42,7 @@ import Control.Monad.Trans.Maybe import Crypto.Error (CryptoFailable (..)) import Crypto.PubKey.Ed25519 (publicKey, signature, verify) import Data.Aeson +import Data.Aeson.Encode.Pretty import Data.Bifunctor (first, second) import Data.Foldable (for_) import Data.HashMap.Strict (HashMap) @@ -55,7 +56,7 @@ import Data.Text.Lazy.Encoding (decodeUtf8) import Data.Time.Clock (UTCTime, getCurrentTime) import Data.Time.Interval (TimeInterval, toTimeUnit) import Data.Time.Units (Second) -import Database.Persist (Entity (..), getBy, insertBy, insert_) +import Database.Persist import Network.HTTP.Client (Manager, HttpException, requestFromURI) import Network.HTTP.Simple (httpJSONEither, getResponseBody, setRequestManager, addRequestHeader) import Network.HTTP.Types.Header (hDate, hHost) @@ -71,14 +72,16 @@ import Yesod.Core.Handler import Yesod.Form.Fields (Textarea (..), textField, textareaField) import Yesod.Form.Functions import Yesod.Form.Types -import Yesod.Persist.Core (runDB, get404) +import Yesod.Persist.Core import qualified Data.ByteString.Char8 as BC (unpack) import qualified Data.CaseInsensitive as CI (mk) import qualified Data.HashMap.Strict as M (lookup, insert, adjust, fromList) import qualified Data.Text as T (pack, unpack, concat) import qualified Data.Text.Lazy as TL (toStrict) +import qualified Data.Text.Lazy.Builder as TLB import qualified Data.Vector as V +import qualified Database.Esqueleto as E import qualified Network.Wai as W (requestMethod, rawPathInfo, requestHeaders) import Network.HTTP.Signature hiding (Algorithm (..)) @@ -86,20 +89,25 @@ import Yesod.HttpSignature (verifyRequestSignature) import qualified Network.HTTP.Signature as S (Algorithm (..)) -import Data.Aeson.Encode.Pretty -import Data.Aeson.Local -import Database.Persist.Local +import Database.Persist.JSON import Network.FedURI import Web.ActivityPub import Yesod.Auth.Unverified import Yesod.FedURI import Yesod.Hashids +import qualified Data.Aeson.Encode.Pretty.ToEncoding as AEP + +import Data.Aeson.Local +import Database.Persist.Local +import Yesod.Persist.Local + import Vervis.ActorKey import Vervis.Federation import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident +import Vervis.Paginate import Vervis.RemoteActorStore import Vervis.Settings @@ -129,7 +137,50 @@ getInboxR = do |] getSharerInboxR :: ShrIdent -> Handler TypedContent -getSharerInboxR _ = error "TODO implement getSharerInboxR" +getSharerInboxR shr = do + (items, navModel) <- getPageAndNav $ \ off lim -> runDB $ do + sid <- getKeyBy404 $ UniqueSharer shr + pid <- getKeyBy404 $ UniquePersonIdent sid + (,) <$> countItems pid + <*> (map adaptItem <$> getItems pid off lim) + let pageNav = navWidget navModel + selectRep $ provideRep $ defaultLayout $(widgetFile "person/inbox") + where + countItems pid = + (+) <$> count [InboxItemLocalPerson ==. pid] + <*> count [InboxItemRemotePerson ==. pid] + getItems pid off lim = + E.select $ E.from $ + \ (ib `E.LeftOuterJoin` (ibl `E.InnerJoin` ob) `E.LeftOuterJoin` (ibr `E.InnerJoin` ract)) -> do + E.on $ ibr E.?. InboxItemRemoteActivity E.==. ract E.?. RemoteActivityId + E.on $ E.just (ib E.^. InboxItemId) E.==. ibr E.?. InboxItemRemoteItem + E.on $ ibl E.?. InboxItemLocalActivity E.==. ob E.?. OutboxItemId + E.on $ E.just (ib E.^. InboxItemId) E.==. ibl E.?. InboxItemLocalItem + E.where_ + $ ( E.isNothing (ibr E.?. InboxItemRemotePerson) E.||. + ibr E.?. InboxItemRemotePerson E.==. E.just (E.val pid) + ) + E.&&. + ( E.isNothing (ibl E.?. InboxItemLocalPerson) E.||. + ibl E.?. InboxItemLocalPerson E.==. E.just (E.val pid) + ) + E.orderBy [E.desc $ ib E.^. InboxItemId] + E.offset $ fromIntegral off + E.limit $ fromIntegral lim + return + ( ib E.^. InboxItemId + , ob E.?. OutboxItemActivity + , ract E.?. RemoteActivityContent + ) + 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) -> Left $ persistJSONValue act + (Nothing, Just obj) -> Right $ persistJSONValue obj getProjectInboxR :: ShrIdent -> PrjIdent -> Handler TypedContent getProjectInboxR _ _ = error "TODO implement getProjectInboxR" diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 833b2d1..fedc964 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -46,7 +46,8 @@ import Text.Email.Validate (unsafeEmailAddress) import Web.PathPieces (toPathPiece) import qualified Database.Esqueleto as E -import qualified Database.Persist.Schema as U (addEntity, unsetFieldDefault) +import qualified Database.Persist.Schema as S +import qualified Database.Persist.Schema.Types as ST import Vervis.Migration.Model @@ -70,13 +71,13 @@ changes = [ -- 1 addEntities model_2016_08_04 -- 2 - , unchecked $ U.unsetFieldDefault "Sharer" "created" + , unchecked $ S.unsetFieldDefault "Sharer" "created" -- 3 - , unchecked $ U.unsetFieldDefault "Project" "nextTicket" + , unchecked $ S.unsetFieldDefault "Project" "nextTicket" -- 4 - , unchecked $ U.unsetFieldDefault "Repo" "vcs" + , unchecked $ S.unsetFieldDefault "Repo" "vcs" -- 5 - , unchecked $ U.unsetFieldDefault "Repo" "mainBranch" + , unchecked $ S.unsetFieldDefault "Repo" "mainBranch" -- 6 , removeField "Ticket" "done" -- 7 @@ -263,6 +264,16 @@ changes = , addFieldPrimRequired "Follow" False "manual" -- 68 , addFieldPrimRequired "RemoteFollow" False "manual" + -- 69 + , addEntity $ ST.Entity "InboxItem" [] [] + -- 70 + , addFieldRefRequiredEmpty "InboxItemLocal" "item" "InboxItem" + -- 71 + , addFieldRefRequiredEmpty "InboxItemRemote" "item" "InboxItem" + -- 72 + , addUnique "InboxItemLocal" $ Unique "UniqueInboxItemLocalItem" ["item"] + -- 73 + , addUnique "InboxItemRemote" $ Unique "UniqueInboxItemRemoteItem" ["item"] ] migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int)) diff --git a/templates/person/inbox.hamlet b/templates/person/inbox.hamlet new file mode 100644 index 0000000..b0b4f31 --- /dev/null +++ b/templates/person/inbox.hamlet @@ -0,0 +1,31 @@ +$# This file is part of Vervis. +$# +$# Written in 2019 by fr33domlover . +$# +$# ♡ Copying is an act of love. Please copy, reuse and share. +$# +$# The author(s) have dedicated all copyright and related and neighboring +$# rights to this software to the public domain worldwide. This software is +$# distributed without any warranty. +$# +$# You should have received a copy of the CC0 Public Domain Dedication along +$# with this software. If not, see +$# . + +

+ This is your personal inbox. It's basically like your personal social + overview page. It corresponds to the "Home" column in Mastodon, and displays + the items in your ActivityPub inbox collection. + +^{pageNav} + +

+ $forall item <- items + 
+      $case item
+        $of Left doc
+          #{AEP.encodePrettyToLazyText doc}
+        $of Right obj
+          #{TLB.toLazyText $ encodePrettyToTextBuilder obj}
+
+^{pageNav}