Eventually-decentralized project hosting and management platform
Clone
HTTPS:
darcs clone https://vervis.peers.community/repos/WvWbo
SSH:
darcs clone USERNAME@vervis.peers.community:WvWbo
Tags
TODO
Push.hs
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 | {- This file is part of Vervis.
-
- Written in 2019, 2020 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/>.
-}
module Vervis.Federation.Push
( sharerPushF
)
where
--import Control.Exception hiding (Handler)
--import Control.Monad
--import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Control.Monad.Trans.Except
--import Control.Monad.Trans.Maybe
--import Data.Aeson
--import Data.Bifunctor
import Data.ByteString (ByteString)
--import Data.Foldable
--import Data.Function
--import Data.List (nub, union)
--import Data.List.NonEmpty (NonEmpty (..))
import Data.Maybe
import Data.Text (Text)
--import Data.Time.Calendar
import Data.Time.Clock
--import Data.Traversable
import Database.Persist
--import Text.Blaze.Html (preEscapedToHtml)
--import Text.Blaze.Html.Renderer.Text
--import Yesod.Core hiding (logError, logWarn, logInfo, logDebug)
--import Yesod.Core.Handler
import Yesod.Persist.Core
--import qualified Data.List.NonEmpty as NE
--import qualified Data.List.Ordered as LO
--import qualified Data.Text as T
--import qualified Data.Text.Lazy as TL
import Database.Persist.JSON
import Network.FedURI
import Web.ActivityPub
--import Yesod.ActivityPub
import Yesod.FedURI
--import Yesod.Hashids
--import Yesod.MonadSite
import Control.Monad.Trans.Except.Local
--import Data.Tuple.Local
import Database.Persist.Local
import Yesod.Persist.Local
import Vervis.ActivityPub.Recipient
import Vervis.FedURI
import Vervis.Federation.Auth
import Vervis.Foundation
import Vervis.Model
import Vervis.Model.Ident
sharerPushF
:: KeyHashid Person
-> UTCTime
-> RemoteAuthor
-> ActivityBody
-> Maybe (LocalRecipientSet, ByteString)
-> LocalURI
-> Push URIMode
-> ExceptT Text Handler Text
sharerPushF recipHash now author body mfwd luPush push = do
error "sharerPushF temporarily disabled"
{-
lift $ runDB $ do
Entity pidRecip recip <- do
sid <- getKeyBy404 $ UniqueSharer shr
getBy404 $ UniquePersonIdent sid
let hAuthor = objUriAuthority $ remoteAuthorURI author
luRepo = pushContext push
mfr <- getBy $ UniqueFollowRemote pidRecip (ObjURI hAuthor luRepo)
if isNothing mfr
then return "Got a Push to a repo unrelated to me; ignoring"
else do
mractid <- insertToInbox luPush $ personInbox recip
encodeRouteLocal <- getEncodeRouteLocal
let me = localUriPath $ encodeRouteLocal $ SharerR shr
return $
case mractid of
Nothing ->
"Activity already exists in inbox of " <> me
Just ractid ->
"Activity inserted to inbox of " <> me
where
insertToInbox luPush ibidRecip = do
let iidAuthor = remoteAuthorInstance author
roid <-
either entityKey id <$> insertBy' (RemoteObject iidAuthor luPush)
let jsonObj = persistJSONFromBL $ actbBL body
ract = RemoteActivity roid jsonObj now
ractid <- either entityKey id <$> insertBy' ract
ibiid <- insert $ InboxItem True
mibrid <- insertUnique $ InboxItemRemote ibidRecip ractid ibiid
encodeRouteLocal <- getEncodeRouteLocal
case mibrid of
Nothing -> do
delete ibiid
return Nothing
Just _ -> return $ Just ractid
-}
|