getPersonR respond with minimal ActivityPub actor

This commit is contained in:
fr33domlover 2018-03-25 19:26:30 +00:00
parent 981b1c0df0
commit f149da8ec6
5 changed files with 248 additions and 9 deletions

View file

@ -44,7 +44,8 @@
/p PeopleR GET POST /p PeopleR GET POST
/p/!new PersonNewR GET /p/!new PersonNewR GET
/p/#ShrIdent PersonR GET /p/#ShrIdent PersonR GET POST
/p/#ShrIdent/activities PersonActivitiesR GET
/g GroupsR GET POST /g GroupsR GET POST
/g/!new GroupNewR GET /g/!new GroupNewR GET

View file

@ -0,0 +1,224 @@
{- This file is part of Vervis.
-
- Written in 2018 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.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
}

View file

@ -19,6 +19,8 @@ module Vervis.Handler.Person
, postPeopleR , postPeopleR
, getPersonNewR , getPersonNewR
, getPersonR , getPersonR
, postPersonR
, getPersonActivitiesR
) )
where where
@ -36,6 +38,7 @@ import Yesod.Auth.Unverified (requireUnverifiedAuth)
import Text.Email.Local import Text.Email.Local
import Vervis.ActivityStreams
import Vervis.Model.Ident import Vervis.Model.Ident
import Vervis.Secure import Vervis.Secure
import Vervis.Widget (avatarW) import Vervis.Widget (avatarW)
@ -120,11 +123,21 @@ getPersonNewR = redirect $ AuthR newAccountR
else notFound else notFound
-} -}
getPersonR :: ShrIdent -> Handler Html getPersonR :: ShrIdent -> Handler TypedContent
getPersonR ident = do getPersonR shr = do
person <- runDB $ do person <- runDB $ do
Entity sid _s <- getBy404 $ UniqueSharer ident Entity sid _s <- getBy404 $ UniqueSharer shr
Entity _pid p <- getBy404 $ UniquePersonIdent sid Entity _pid p <- getBy404 $ UniquePersonIdent sid
return p return p
secure <- getSecure ur <- getUrlRender
defaultLayout $(widgetFile "person") 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

View file

@ -16,8 +16,8 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
<ul> <ul>
<li> <li>
<a href=@{ProjectsR ident}>Projects <a href=@{ProjectsR shr}>Projects
<li> <li>
<a href=@{ReposR ident}>Repositories <a href=@{ReposR shr}>Repositories
<li> <li>
<a href=@{WorkflowsR ident}>Workflows <a href=@{WorkflowsR shr}>Workflows

View file

@ -95,6 +95,7 @@ library
Yesod.Paginate.Local Yesod.Paginate.Local
Yesod.SessionEntity Yesod.SessionEntity
Vervis.ActivityStreams
Vervis.Application Vervis.Application
Vervis.Avatar Vervis.Avatar
Vervis.BinaryBody Vervis.BinaryBody