getPersonR respond with minimal ActivityPub actor

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

src/Vervis/ActivityStreams.hs

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

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

templates/person.hamlet

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

vervis.cabal

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