From 6f3df6d5690bf8e5c9819e05d5f72e9d8262da5d Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Wed, 20 Mar 2019 09:31:08 +0000 Subject: [PATCH] Allow actors not to list any public keys at all --- src/Vervis/Handler/Person.hs | 5 +++-- src/Web/ActivityPub.hs | 24 ++++++++++++------------ 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/src/Vervis/Handler/Person.hs b/src/Vervis/Handler/Person.hs index e81ccf8..2801119 100644 --- a/src/Vervis/Handler/Person.hs +++ b/src/Vervis/Handler/Person.hs @@ -145,6 +145,7 @@ getPerson shr person = do , actorUsername = shr2text shr , actorInbox = route2local InboxR , actorPublicKeys = - Left (route2local ActorKey1R) :| - [ Left $ route2local ActorKey2R ] + [ Left $ route2local ActorKey1R + , Left $ route2local ActorKey2R + ] } diff --git a/src/Web/ActivityPub.hs b/src/Web/ActivityPub.hs index e544726..bccaa18 100644 --- a/src/Web/ActivityPub.hs +++ b/src/Web/ActivityPub.hs @@ -238,17 +238,17 @@ instance ActivityPub PublicKey where mkOwner h OwnerInstance = FedURI h "" "" mkOwner h (OwnerActor lu) = l2f h lu -parsePublicKeySet :: Value -> Parser (Text, NonEmpty (Either LocalURI PublicKey)) +parsePublicKeySet :: Value -> Parser (Text, [Either LocalURI PublicKey]) parsePublicKeySet v = case v of Array a -> - case nonEmpty $ V.toList a of - Nothing -> fail "No public keys" - Just (k :| ks) -> do + case V.toList a of + [] -> fail "No public keys" + k : ks -> do (h, e) <- parseKey k es <- traverse (withHost h . parseKey) ks - return (h, e :| es) - _ -> second (:| []) <$> parseKey v + return (h, e : es) + _ -> second (: []) <$> parseKey v where parseKey (String t) = second Left . f2l <$> either fail return (parseFedURI t) parseKey (Object o) = second Right <$> parseObject o @@ -259,11 +259,11 @@ parsePublicKeySet v = then return v else fail "URI host mismatch" -encodePublicKeySet :: Text -> NonEmpty (Either LocalURI PublicKey) -> Encoding -encodePublicKeySet host (e :| es) = - if null es - then renderKey e - else listEncoding renderKey $ e : es +encodePublicKeySet :: Text -> [Either LocalURI PublicKey] -> Encoding +encodePublicKeySet host es = + case es of + [e] -> renderKey e + _ -> listEncoding renderKey es where renderKey (Left lu) = toEncoding $ l2f host lu renderKey (Right pk) = pairs $ toSeries host pk @@ -273,7 +273,7 @@ data Actor = Actor , actorType :: ActorType , actorUsername :: Text , actorInbox :: LocalURI - , actorPublicKeys :: NonEmpty (Either LocalURI PublicKey) + , actorPublicKeys :: [Either LocalURI PublicKey] } instance ActivityPub Actor where