From f149da8ec664b6bbe89ba7a11d9e76dbda5ac894 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sun, 25 Mar 2018 19:26:30 +0000 Subject: [PATCH] getPersonR respond with minimal ActivityPub actor --- config/routes | 3 +- src/Vervis/ActivityStreams.hs | 224 ++++++++++++++++++++++++++++++++++ src/Vervis/Handler/Person.hs | 23 +++- templates/person.hamlet | 6 +- vervis.cabal | 1 + 5 files changed, 248 insertions(+), 9 deletions(-) create mode 100644 src/Vervis/ActivityStreams.hs diff --git a/config/routes b/config/routes index a2be10e..91f0a74 100644 --- a/config/routes +++ b/config/routes @@ -44,7 +44,8 @@ /p PeopleR GET POST /p/!new PersonNewR GET -/p/#ShrIdent PersonR GET +/p/#ShrIdent PersonR GET POST +/p/#ShrIdent/activities PersonActivitiesR GET /g GroupsR GET POST /g/!new GroupNewR GET diff --git a/src/Vervis/ActivityStreams.hs b/src/Vervis/ActivityStreams.hs new file mode 100644 index 0000000..886212e --- /dev/null +++ b/src/Vervis/ActivityStreams.hs @@ -0,0 +1,224 @@ +{- This file is part of Vervis. + - + - Written in 2018 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 + - . + -} + +module Vervis.ActivityStreams + ( Actor (..) + , ActivityStreams2 (..) + , provideAS2 + , makeActor + ) +where + +import Control.Monad.Trans.Writer +import Data.Aeson (pairs) +import Data.Monoid + +import Vervis.Import +import Vervis.Model.Ident + +-- AS2 is divided into core and extensions-for-common-social-web-use-cases, I'm +-- starting with the core, looking at the AS2 vocab spec + +{- +data Object = Object + { objectAttachment :: + , objectAttributedTo :: + , objectAudience :: + , objectContent :: + , objectContext :: + , objectName :: + , objectEndTime :: + , objectGenerator :: + , objectIcon :: + , objectImage :: + , objectInReplyTo :: + , objectLocation :: + , objectPreview :: + , objectPublished :: + , objectReplies :: + , objectStartTime :: + , objectSummary :: + , objectTag :: + , objectUpdated :: + , objectUrl :: + , objectTo :: + , objectBto :: + , objectCc :: + , objectBcc :: + , objectMediaType :: + , objectDuration :: + } + +data Link = Link + { linkHref :: + , linkRel :: + , linkMediaType :: + , linkName :: + , linkHrefLang :: + , linkHeight :: + , linkWidth :: + , linkPreview :: + } + +data Activity = Activity + { activityAsObject :: Object + , activityActor :: + , activityObject :: + , activityTarget :: + , activityResult :: + , activityOrigin :: + , activityInstrument :: + } + +data IntransitiveActivity = IntransitiveActivity + { iactivityAsObject :: Object + , iactivityActor :: + , iactivityTarget :: + , iactivityResult :: + , iactivityOrigin :: + , iactivityInstrument :: + } + +data Collection = Collection + { collectionAsObject :: Object + , collectionTotalItems :: + , collectionCurrent :: + , collectionFirst :: + , collectionLast :: + , collectionItems :: + } + +data OrderedCollection = OrderedCollection + { ocollectionAsCollection :: Collection + } + +data CollectionPage = CollectionPage + { collectionPageAsCollection :: Collection + , collectionPagePartOf :: + , collectionPageNext :: + , collectionPagePrev :: + } + +data OrderedCollectionPage = OrderedCollectionPage + { orderedCollectionPageAsCollectionPage :: CollectionPage + , orederdCollectionPageStartIndex :: + } + +-- Now come the extended types + +-- Activity types - I'm skipping them for now + +-- Actor types + +data Application = Application + { applicationAsObject :: Object + } + +data Group = Group + { groupAsObject :: Object + } + +data Organization = Organization + { organizationAsObject :: Object + } + +data Person = Person + { personAsObject :: Object + } + +data Service = Service + { serviceAsObject :: Object + } +-} + +-- Actor objects in AP + +data Actor = Actor + { -- Requirements + actorId :: Text + , actorType :: Text + -- Must + , actorInbox :: Text + , actorOutbox :: Text + -- Should + --, actorFollowing + --, actorFollowers + -- May + --, actorLiked + --, actorStreams + --, actorPreferredUsername + --, actorEndpoints + } + +fields a = + [ "@context" .= ("https://www.w3.org/ns/activitystreams" :: Text) + , "id" .= actorId a + , "type" .= actorType a + , "inbox" .= actorInbox a + , "outbox" .= actorOutbox a + ] + +instance ToJSON Actor where + toJSON = object . fields + toEncoding = pairs . mconcat . fields + +-- NEXT: +-- +-- * Figure out how to detect the client wanting AS2 / AP +-- * Send minimal simple actor per user + +typeActivityStreams2 :: ContentType +typeActivityStreams2 = "application/activity+json" + +typeActivityStreams2LD :: ContentType +typeActivityStreams2LD = + "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\"" + +data ActivityStreams2 = ActivityPubActor Actor + +instance ToContent ActivityStreams2 where + toContent (ActivityPubActor a) = toContent $ toEncoding a + +{- +instance ToTypedContent ActivityStreams2 where + toTypedContent = TypedContent typeActivityStreams2 . toContent + +instance HasContentType ActivityStreams2 where + getContentType _ = typeActivityStreams2 + +data ActivityStreams2LD = ActivityStreams2LD ActivityStreams2 + +instance ToContent ActivityStreams2LD where + toContent (ActivityStreams2LD a) = toContent a + +instance ToTypedContent ActivityStreams2LD where + toTypedContent = TypedContent typeActivityStreams2LD . toContent + +instance HasContentType ActivityStreams2LD where + getContentType _ = typeActivityStreams2LD +-} + +provideAS2 :: Monad m => ActivityStreams2 -> Writer (Endo [ProvidedRep m]) () +provideAS2 as2 = do + provideRepType typeActivityStreams2 $ return as2 + provideRepType typeActivityStreams2LD $ return as2 + +makeActor ur shr = + Actor + { actorId = ur $ PersonR shr + , actorType = "Person" + , actorInbox = ur $ PersonR shr + , actorOutbox = ur $ PersonActivitiesR shr + } diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index d76bf92..89b8d93 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -19,6 +19,8 @@ module Vervis.Handler.Person , postPeopleR , getPersonNewR , getPersonR + , postPersonR + , getPersonActivitiesR ) where @@ -36,6 +38,7 @@ import Yesod.Auth.Unverified (requireUnverifiedAuth) import Text.Email.Local +import Vervis.ActivityStreams import Vervis.Model.Ident import Vervis.Secure import Vervis.Widget (avatarW) @@ -120,11 +123,21 @@ getPersonNewR = redirect $ AuthR newAccountR else notFound -} -getPersonR :: ShrIdent -> Handler Html -getPersonR ident = do +getPersonR :: ShrIdent -> Handler TypedContent +getPersonR shr = do person <- runDB $ do - Entity sid _s <- getBy404 $ UniqueSharer ident + Entity sid _s <- getBy404 $ UniqueSharer shr Entity _pid p <- getBy404 $ UniquePersonIdent sid return p - secure <- getSecure - defaultLayout $(widgetFile "person") + ur <- getUrlRender + selectRep $ do + provideRep $ do + secure <- getSecure + defaultLayout $(widgetFile "person") + provideAS2 $ ActivityPubActor $ makeActor ur shr + +postPersonR :: ShrIdent -> Handler TypedContent +postPersonR _ = notFound + +getPersonActivitiesR :: ShrIdent -> Handler TypedContent +getPersonActivitiesR _ = notFound diff --git a/templates/person.hamlet b/templates/person.hamlet index cccf595..41f0d07 100644 --- a/templates/person.hamlet +++ b/templates/person.hamlet @@ -16,8 +16,8 @@ $# .