Public ActivityPub actor in PersonR

It already had one, but it didn't have a public key and it was using the old
mess of the Vervis.ActivityStreams module, which I'll possibly remove soon.
It's hopefully more elegant now.

src/Vervis/ActivityPub.hs

@@ -18,17 +18,22 @@ module Vervis.ActivityPub
     , Algorithm (..)
     , PublicKey (..)
     , Actor (..)
+    , provideAP
     )
 where
 
 import Prelude
 
+import Control.Monad.Trans.Writer (Writer)
 import Data.Aeson
 import Data.Aeson.Types (Parser)
 import Data.PEM
+import Data.Semigroup (Endo)
 import Data.Text (Text)
 import Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import Network.URI
+import Yesod.Core.Content (ContentType)
+import Yesod.Core.Handler (ProvidedRep, provideRepType)
 
 import qualified Data.Text as T (unpack)
 import qualified Data.Vector as V (fromList)
@@ -144,3 +149,16 @@ instance ToJSON Actor where
             <> "preferredUsername" .= username
             <> "inbox"             .= renderURI inbox
             <> "publicKey"         .= pkey
+
+typeActivityStreams2 :: ContentType
+typeActivityStreams2 = "application/activity+json"
+
+typeActivityStreams2LD :: ContentType
+typeActivityStreams2LD =
+    "application/ld+json; profile=\"https://www.w3.org/ns/activitystreams\""
+
+provideAP :: (Monad m, ToJSON a) => a -> Writer (Endo [ProvidedRep m]) ()
+provideAP v = do
+    let enc = toEncoding v
+    provideRepType typeActivityStreams2   $ return enc
+    provideRepType typeActivityStreams2LD $ return enc

src/Vervis/ActorKey.hs

@@ -17,7 +17,7 @@ module Vervis.ActorKey
     ( ActorKey ()
     , generateActorKey
     , actorKeyRotator
-    -- , actorPublicKey
+    , actorKeyPublicBin
     )
 where
 
@@ -41,7 +41,7 @@ data ActorKey = ActorKey
       -- ^ Secret key in binary form.
     , actorKeyPublic :: PublicKey
       -- ^ Public key in binary form.
-    , actorKeyPubPEM :: ByteString
+    -- , actorKeyPubPEM :: ByteString
       -- ^ Public key in PEM format. This can be generated from the binary
       --   form, but we keep it here because it's used for sending the public
       --   key to whoever wishes to verify our signatures. So, we generate a
@@ -127,10 +127,10 @@ generateActorKey = mk <$> generateSecretKey
         in  ActorKey
                 { actorKeySecret = secret
                 , actorKeyPublic = public
-                , actorKeyPubPEM = renderPEM public
+                -- , actorKeyPubPEM = renderPEM public
                 }
-    renderPEM :: PublicKey -> ByteString
-    renderPEM = pemWriteBS . PEM "PUBLIC KEY" [] . convert
+    -- renderPEM :: PublicKey -> ByteString
+    -- renderPEM = pemWriteBS . PEM "PUBLIC KEY" [] . convert
 
 -- | A loop that runs forever and periodically generates a new actor key,
 -- storing it in a 'TVar'.
@@ -148,5 +148,10 @@ actorKeyRotator interval key =
                     "actorKeyRotator: interval out of range: " ++ show micros
 
 -- | The public key in PEM format, can be directly placed in responses.
---actorPublicKey :: ActorKey -> ByteString
---actorPublicKey = actorKeyPublicPem
+--
+-- Well, right now it's actually just the public key in binary form, because
+-- the type of publicKeyPem is PEM, so, I need to figure out etc. to see if
+-- there's a nice way to reuse the PEM that is worth it. Even if not, that's
+-- probably okay because the PEM rendering is hopefully trivial.
+actorKeyPublicBin :: ActorKey -> ByteString
+actorKeyPublicBin = convert . actorKeyPublic

src/Vervis/Handler/Person.hs

@@ -1,6 +1,6 @@
 {- This file is part of Vervis.
  -
- - Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
+ - Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
  -
  - ♡ Copying is an act of love. Please copy, reuse and share.
  -
@@ -27,18 +27,24 @@ where
 import Vervis.Import hiding ((==.))
 --import Prelude
 
+import Data.PEM (PEM (..))
 import Database.Esqueleto hiding (isNothing, count)
+import Network.URI (uriFragment, parseAbsoluteURI)
 import Vervis.Form.Person
 --import Model
 import Text.Blaze.Html (toHtml)
 import Yesod.Auth.Account (newAccountR, resendVerifyEmailWidget, username)
 import Yesod.Auth.Account.Message (AccountMsg (MsgEmailUnverified))
 
+import qualified Data.Text as T (unpack)
+
 import Yesod.Auth.Unverified (requireUnverifiedAuth)
 
 import Text.Email.Local
 
-import Vervis.ActivityStreams
+--import Vervis.ActivityStreams
+import Vervis.ActivityPub
+import Vervis.ActorKey
 import Vervis.Model.Ident
 import Vervis.Secure
 import Vervis.Widget (avatarW)
@@ -129,12 +135,30 @@ getPersonR shr = do
         Entity sid _s <- getBy404 $ UniqueSharer shr
         Entity _pid p <- getBy404 $ UniquePersonIdent sid
         return p
-    ur <- getUrlRender
+    renderUrl <- getUrlRender
+    let route2uri route =
+            case parseAbsoluteURI $ T.unpack $ renderUrl route of
+                Nothing -> error "getRenderUrl produced invalid URI!!!"
+                Just u  -> u
+        me = route2uri $ PersonR shr
+    actorKey <-
+        liftIO . fmap actorKeyPublicBin . readTVarIO =<< getsYesod appActorKey
     selectRep $ do
         provideRep $ do
             secure <- getSecure
             defaultLayout $(widgetFile "person")
-        provideAS2 $ ActivityPubActor $ makeActor ur shr
+        provideAP Actor
+            { actorId        = me
+            , actorType      = ActorTypePerson
+            , actorUsername  = shr2text shr
+            , actorInbox     = route2uri InboxR
+            , actorPublicKey = PublicKey
+                { publicKeyId    = me { uriFragment = "#key" }
+                , publicKeyOwner = me
+                , publicKeyPem   = PEM "PUBLIC KEY" [] actorKey
+                , publicKeyAlgo  = Just AlgorithmEd25519
+                }
+            }
 
 postPersonR :: ShrIdent -> Handler TypedContent
 postPersonR _ = notFound