From 2cc621e3a5b42ff3366ddfb042f43fd55a7fb223 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Sat, 19 Jan 2019 05:56:58 +0000 Subject: [PATCH] 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 ++++++++++++++++++ src/Vervis/ActorKey.hs | 19 ++++++++++++------- src/Vervis/Handler/Person.hs | 32 ++++++++++++++++++++++++++++---- 3 files changed, 58 insertions(+), 11 deletions(-) diff --git a/src/Vervis/ActivityPub.hs b/src/Vervis/ActivityPub.hs index 1caa91b..b725ccf 100644 --- a/src/Vervis/ActivityPub.hs +++ b/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 diff --git a/src/Vervis/ActorKey.hs b/src/Vervis/ActorKey.hs index cafa143..699b82e 100644 --- a/src/Vervis/ActorKey.hs +++ b/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 diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index 89b8d93..c291282 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -1,6 +1,6 @@ {- This file is part of Vervis. - - - Written in 2016, 2018 by fr33domlover . + - Written in 2016, 2018, 2019 by fr33domlover . - - ♡ 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