From 8424c76de74ab96405349bfc5e7f1c0862e11121 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Wed, 12 Oct 2022 18:01:52 +0000 Subject: [PATCH] Link to per-actor keys from actor documents Per-actor keys are now fully supported in Vervis! Caveats: - The HTTP Signature keys produced by Vervis are Ed25519 keys; software that expects only RSA keys will fail here - Like instance keys, per-actor keys are currently served in separate documents, not embedded in the actor document; so software that expects embedded keys will fail here --- src/Vervis/Handler/Deck.hs | 16 +++++++++++----- src/Vervis/Handler/Group.hs | 18 +++++++++++++----- src/Vervis/Handler/Loom.hs | 16 +++++++++++----- src/Vervis/Handler/Person.hs | 19 ++++++++++++------- src/Vervis/Handler/Repo.hs | 16 +++++++++++----- 5 files changed, 58 insertions(+), 27 deletions(-) diff --git a/src/Vervis/Handler/Deck.hs b/src/Vervis/Handler/Deck.hs index 5726f62..6e6c2cd 100644 --- a/src/Vervis/Handler/Deck.hs +++ b/src/Vervis/Handler/Deck.hs @@ -118,12 +118,17 @@ import qualified Vervis.Client as C getDeckR :: KeyHashid Deck -> Handler TypedContent getDeckR deckHash = do deckID <- decodeKeyHashid404 deckHash - (deck, repoIDs, actor) <- runDB $ do + (deck, repoIDs, actor, sigKeyIDs) <- runDB $ do d <- get404 deckID rs <- selectKeysList [RepoProject ==. Just deckID] [Asc RepoId] - (d,rs,) <$> getJust (deckActor d) + let aid = deckActor d + a <- getJust aid + sigKeys <- selectKeysList [SigKeyActor ==. aid] [Asc SigKeyId] + return (d, rs, a, sigKeys) encodeRouteLocal <- getEncodeRouteLocal + hashSigKey <- getEncodeKeyHashid + perActor <- asksSite $ appPerActorKeys . appSettings let deckAP = AP.TicketTracker { AP.ticketTrackerActor = AP.Actor { AP.actorLocal = AP.ActorLocal @@ -135,9 +140,10 @@ getDeckR deckHash = do Just $ encodeRouteLocal $ DeckFollowersR deckHash , AP.actorFollowing = Nothing , AP.actorPublicKeys = - [ Left $ encodeRouteLocal ActorKey1R - , Left $ encodeRouteLocal ActorKey2R - ] + map (Left . encodeRouteLocal) $ + if perActor + then map (DeckStampR deckHash . hashSigKey) sigKeyIDs + else [ActorKey1R, ActorKey2R] , AP.actorSshKeys = [] } , AP.actorDetail = AP.ActorDetail diff --git a/src/Vervis/Handler/Group.hs b/src/Vervis/Handler/Group.hs index 70cd969..39e90be 100644 --- a/src/Vervis/Handler/Group.hs +++ b/src/Vervis/Handler/Group.hs @@ -56,6 +56,7 @@ import Network.FedURI import Yesod.ActivityPub import Yesod.FedURI import Yesod.Hashids +import Yesod.MonadSite import qualified Web.ActivityPub as AP @@ -64,16 +65,22 @@ import Vervis.FedURI import Vervis.Foundation import Vervis.Model import Vervis.Recipient +import Vervis.Settings import Vervis.Web.Actor getGroupR :: KeyHashid Group -> Handler TypedContent getGroupR groupHash = do groupID <- decodeKeyHashid404 groupHash - (group, actor) <- runDB $ do + (group, actor, sigKeyIDs) <- runDB $ do g <- get404 groupID - (g,) <$> getJust (groupActor g) + let aid = groupActor g + a <- getJust aid + sigKeys <- selectKeysList [SigKeyActor ==. aid] [Asc SigKeyId] + return (g, a, sigKeys) encodeRouteLocal <- getEncodeRouteLocal + hashSigKey <- getEncodeKeyHashid + perActor <- asksSite $ appPerActorKeys . appSettings let route mk = encodeRouteLocal $ mk groupHash groupAP = AP.Actor @@ -84,9 +91,10 @@ getGroupR groupHash = do , AP.actorFollowers = Just $ route GroupFollowersR , AP.actorFollowing = Nothing , AP.actorPublicKeys = - [ Left $ encodeRouteLocal ActorKey1R - , Left $ encodeRouteLocal ActorKey2R - ] + map (Left . encodeRouteLocal) $ + if perActor + then map (GroupStampR groupHash . hashSigKey) sigKeyIDs + else [ActorKey1R, ActorKey2R] , AP.actorSshKeys = [] } , AP.actorDetail = AP.ActorDetail diff --git a/src/Vervis/Handler/Loom.hs b/src/Vervis/Handler/Loom.hs index d9f3f59..ce8bde2 100644 --- a/src/Vervis/Handler/Loom.hs +++ b/src/Vervis/Handler/Loom.hs @@ -94,11 +94,16 @@ import qualified Vervis.Client as C getLoomR :: KeyHashid Loom -> Handler TypedContent getLoomR loomHash = do loomID <- decodeKeyHashid404 loomHash - (loom, actor) <- runDB $ do + (loom, actor, sigKeyIDs) <- runDB $ do l <- get404 loomID - (l,) <$> getJust (loomActor l) + let aid = loomActor l + a <- getJust aid + sigKeys <- selectKeysList [SigKeyActor ==. aid] [Asc SigKeyId] + return (l, a, sigKeys) encodeRouteLocal <- getEncodeRouteLocal + hashSigKey <- getEncodeKeyHashid + perActor <- asksSite $ appPerActorKeys . appSettings let route mk = encodeRouteLocal $ mk loomHash loomAP = AP.Actor { AP.actorLocal = AP.ActorLocal @@ -108,9 +113,10 @@ getLoomR loomHash = do , AP.actorFollowers = Just $ route LoomFollowersR , AP.actorFollowing = Nothing , AP.actorPublicKeys = - [ Left $ encodeRouteLocal ActorKey1R - , Left $ encodeRouteLocal ActorKey2R - ] + map (Left . encodeRouteLocal) $ + if perActor + then map (LoomStampR loomHash . hashSigKey) sigKeyIDs + else [ActorKey1R, ActorKey2R] , AP.actorSshKeys = [] } , AP.actorDetail = AP.ActorDetail diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index 0858d58..3985046 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -90,13 +90,17 @@ import Vervis.Widget.Person getPersonR :: KeyHashid Person -> Handler TypedContent getPersonR personHash = do personID <- decodeKeyHashid404 personHash - (person, actor, sshKeyIDs) <- runDB $ do + (person, actor, sigKeyIDs, sshKeyIDs) <- runDB $ do p <- get404 personID - a <- getJust $ personActor p - ks <- selectKeysList [SshKeyPerson ==. personID] [Asc SshKeyId] - return (p, a, ks) + let aid = personActor p + a <- getJust aid + sigKeys <- selectKeysList [SigKeyActor ==. aid] [Asc SigKeyId] + sshKeys <- selectKeysList [SshKeyPerson ==. personID] [Asc SshKeyId] + return (p, a, sigKeys, sshKeys) encodeRouteLocal <- getEncodeRouteLocal + hashSigKey <- getEncodeKeyHashid hashSshKey <- getEncodeKeyHashid + perActor <- asksSite $ appPerActorKeys . appSettings let personAP = AP.Actor { AP.actorLocal = AP.ActorLocal @@ -106,9 +110,10 @@ getPersonR personHash = do , AP.actorFollowers = Just $ encodeRouteLocal $ PersonFollowersR personHash , AP.actorFollowing = Just $ encodeRouteLocal $ PersonFollowingR personHash , AP.actorPublicKeys = - [ Left $ encodeRouteLocal ActorKey1R - , Left $ encodeRouteLocal ActorKey2R - ] + map (Left . encodeRouteLocal) $ + if perActor + then map (PersonStampR personHash . hashSigKey) sigKeyIDs + else [ActorKey1R, ActorKey2R] , AP.actorSshKeys = map (encodeRouteLocal . SshKeyR personHash . hashSshKey) sshKeyIDs } diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index 046e5d4..1d2d79f 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -181,12 +181,17 @@ import qualified Vervis.Hook as H getRepoR :: KeyHashid Repo -> Handler TypedContent getRepoR repoHash = do repoID <- decodeKeyHashid404 repoHash - (repo, actor) <- runDB $ do + (repo, actor, sigKeyIDs) <- runDB $ do r <- get404 repoID - (r,) <$> getJust (repoActor r) + let aid = repoActor r + a <- getJust aid + sigKeys <- selectKeysList [SigKeyActor ==. aid] [Asc SigKeyId] + return (r, a, sigKeys) encodeRouteLocal <- getEncodeRouteLocal hashLoom <- getEncodeKeyHashid + hashSigKey <- getEncodeKeyHashid + perActor <- asksSite $ appPerActorKeys . appSettings let repoAP = AP.Repo { AP.repoActor = AP.Actor { AP.actorLocal = AP.ActorLocal @@ -198,9 +203,10 @@ getRepoR repoHash = do Just $ encodeRouteLocal $ RepoFollowersR repoHash , AP.actorFollowing = Nothing , AP.actorPublicKeys = - [ Left $ encodeRouteLocal ActorKey1R - , Left $ encodeRouteLocal ActorKey2R - ] + map (Left . encodeRouteLocal) $ + if perActor + then map (RepoStampR repoHash . hashSigKey) sigKeyIDs + else [ActorKey1R, ActorKey2R] , AP.actorSshKeys = [] } , AP.actorDetail = AP.ActorDetail