forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Implement GETing the personal inbox

Browse source
This commit is contained in:
fr33domlover 2019-05-05 10:20:55 +00:00
parent f6eaca2fa8
commit 8303baa69d
6 changed files with 136 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
config/models
View file

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

36
src/Vervis/Federation.hs
View file

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

1
src/Vervis/Foundation.hs
View file

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

63
src/Vervis/Handler/Inbox.hs
View file

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

21
src/Vervis/Migration.hs
View file

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

31
templates/person/inbox.hamlet Normal file
View file

@ -0,0 +1,31 @@
$# This file is part of Vervis.
$#
$# Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
$#
$# ♡ 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
$# <http://creativecommons.org/publicdomain/zero/1.0/>.
<p>
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}
<div>
$forall item <- items
<div><pre>
$case item
$of Left doc
#{AEP.encodePrettyToLazyText doc}
$of Right obj
#{TLB.toLazyText $ encodePrettyToTextBuilder obj}
^{pageNav}