forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Support remote actors specifying 2 keys, and DB storage of these keys

Browse source 
It's now possible for activities we be attributed to actors that have more than
one key. We allow up to 2 keys. We also store in the DB. Scaling to support any
number of keys is trivial, but I'm limiting to 2 to avoid potential trouble and
because 2 is the actual number we need.

By having 2 keys, and replacing only one of them in each rotation, we avoid
race conditions. With 1 key, the following can happen:

1. We send an activity to another server
2. We rotate our key
3. The server reaches the activity in its processing queue, tries to verify our
   request signature, but fails because it can't fetch the key. It's the old
   key and we discarded it already, replaced it with the new one

When we use 2 keys, the previous key remains available and other servers have
time to finish processing our requests signed with that key. We can safely
rotate, without worrying about whether the user sent anything right before the
rotation time.

Caveat: With this feature, we allow OTHER servers to rotate freely. It's safe
because it's optional, but it's just Vervis right now. Once Vervis itself
starts using 2 keys, it will be able to rotate freely without race condition
risk, but probably Mastodon etc. won't accept its signatures because of the use
of 2 keys and because they're server-scope keys.

Maybe I can get these features adopted by the fediverse?
This commit is contained in:
fr33domlover 2019-02-04 19:38:50 +00:00
parent 02da508ed0
commit 37b3416a41
5 changed files with 114 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
config/models
View file

@ -41,11 +41,16 @@ Person
VerifKey
ident URI
actor URI
public PublicKey
sharer RemoteSharerId
UniqueVerifKey ident
RemoteSharer
ident URI
UniqueRemoteSharer ident
SshKey
ident KyIdent
person PersonId

7
migrations/2019_02_03_verifkey.model
View file

@ -1,6 +1,11 @@
VerifKey
ident String
actor String
public ByteString
sharer RemoteSharerId
UniqueVerifKey ident
RemoteSharer
ident String
UniqueRemoteSharer ident

37
src/Vervis/Foundation.hs
View file

@ -581,10 +581,18 @@ instance YesodHttpSig App where
CryptoPassed s -> Right s
CryptoFailed e -> Left "Parsing Ed25519 signature failed"
(mvkid, key, uActor) <- do
ment <- lift $ runDB $ getBy $ UniqueVerifKey u
case ment of
Just (Entity vkid vk) ->
return (Just vkid, verifKeyPublic vk, verifKeyActor vk)
ments <- lift $ runDB $ do
mvk <- getBy $ UniqueVerifKey u
for mvk $ \ vk@(Entity _ verifkey) -> do
remote <- getJust $ verifKeySharer verifkey
return (vk, remote)
case ments of
Just (Entity vkid vk, remote) ->
return
( Just vkid
, verifKeyPublic vk
, remoteSharerIdent remote
)
Nothing -> do
(k, ua) <- fetchKey' u
return (Nothing, k, ua)
@ -604,10 +612,25 @@ instance YesodHttpSig App where
then return (True, newKey)
else err
else err
when write $ lift $ runDB $
when write $ ExceptT $ runDB $
case mvkid of
Nothing -> insert_ $ VerifKey u uActor key'
Just vkid -> update vkid [VerifKeyPublic =. key']
Nothing -> do
ment <- getBy $ UniqueRemoteSharer uActor
case ment of
Nothing -> do
rsid <- insert $ RemoteSharer uActor
insert_ $ VerifKey u key' rsid
return $ Right ()
Just (Entity rsid rs) -> do
n <- count [VerifKeySharer ==. rsid]
if n < 2
then do
insert_ $ VerifKey u key' rsid
return $ Right ()
else return $ Left "We already store 2 keys"
Just vkid -> do
update vkid [VerifKeyPublic =. key']
return $ Right ()
return uActor
where
fetchKey' u = do

23
src/Vervis/Handler/Person.hs
View file

@ -149,16 +149,19 @@ getPersonR shr = do
secure <- getSecure
defaultLayout $(widgetFile "person")
provideAP Actor
{ actorId = me
, actorType = ActorTypePerson
, actorUsername = shr2text shr
, actorInbox = route2uri InboxR
, actorPublicKey = Right PublicKey
{ publicKeyId = me { uriFragment = "#key" }
, publicKeyOwner = me
, publicKeyPem = PEM "PUBLIC KEY" [] actorKey
, publicKeyAlgo = Just AlgorithmEd25519
, publicKeyShared = False
{ actorId = me
, actorType = ActorTypePerson
, actorUsername = shr2text shr
, actorInbox = route2uri InboxR
, actorPublicKeys = PublicKeySet
{ publicKey1 = Right PublicKey
{ publicKeyId = me { uriFragment = "#key" }
, publicKeyOwner = me
, publicKeyPem = PEM "PUBLIC KEY" [] actorKey
, publicKeyAlgo = Just AlgorithmEd25519
, publicKeyShared = False
}
, publicKey2 = Nothing
}
}

83
src/Web/ActivityPub.hs
View file

@ -21,6 +21,7 @@ module Web.ActivityPub
ActorType (..)
, Algorithm (..)
, PublicKey (..)
, PublicKeySet (..)
, Actor (..)
-- * Activity
@ -43,6 +44,7 @@ import Prelude
import Control.Applicative ((<|>), optional)
import Control.Exception (Exception, displayException, try)
import Control.Monad ((<=<))
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Control.Monad.Trans.Writer (Writer)
@ -70,7 +72,7 @@ import Yesod.Core.Handler (ProvidedRep, provideRepType)
import qualified Crypto.PubKey.Ed25519 as E (PublicKey, publicKey)
import qualified Data.HashMap.Strict as M (lookup)
import qualified Data.Text as T (unpack)
import qualified Data.Vector as V (fromList)
import qualified Data.Vector as V (fromList, toList)
import Data.Aeson.Local
@ -156,12 +158,39 @@ instance ToJSON PublicKey where
<> (frg <> "algorithm") .=? malgo
<> (frg <> "shared") .= shared
data PublicKeySet = PublicKeySet
{ publicKey1 :: Either URI PublicKey
, publicKey2 :: Maybe (Either URI PublicKey)
}
instance FromJSON PublicKeySet where
parseJSON v =
case v of
Array a ->
case V.toList a of
[] -> fail "No public keys"
[k1] -> PublicKeySet <$> parseKey k1 <*> pure Nothing
[k1, k2] -> PublicKeySet <$> parseKey k1 <*> (Just <$> parseKey k2)
_ -> fail "More than 2 public keys isn't supported"
_ -> PublicKeySet <$> parseKey v <*> pure Nothing
where
parseKey = bitraverse parseHttpsURI pure . toEither <=< parseJSON
instance ToJSON PublicKeySet where
toJSON = error "toJSON PublicKeySet"
toEncoding (PublicKeySet k1 mk2) =
case mk2 of
Nothing -> toEncoding $ renderKey k1
Just k2 -> toEncodingList [renderKey k1, renderKey k2]
where
renderKey = fromEither . first renderURI
data Actor = Actor
{ actorId :: URI
, actorType :: ActorType
, actorUsername :: Text
, actorInbox :: URI
, actorPublicKey :: Either URI PublicKey
{ actorId :: URI
, actorType :: ActorType
, actorUsername :: Text
, actorInbox :: URI
, actorPublicKeys :: PublicKeySet
}
instance FromJSON Actor where
@ -171,18 +200,18 @@ instance FromJSON Actor where
<*> o .: "type"
<*> o .: "preferredUsername"
<*> (parseHttpsURI =<< o .: "inbox")
<*> (bitraverse parseHttpsURI pure . toEither =<< o .: "publicKey")
<*> o .: "publicKey"
instance ToJSON Actor where
toJSON = error "toJSON Actor"
toEncoding (Actor id_ typ username inbox pkey) =
toEncoding (Actor id_ typ username inbox pkeys) =
pairs
$ "@context" .= actorContext
<> "id" .= renderURI id_
<> "type" .= typ
<> "preferredUsername" .= username
<> "inbox" .= renderURI inbox
<> "publicKey" .= fromEither (first renderURI pkey)
<> "publicKey" .= pkeys
-- | This may seem trivial, but it exists for a good reason: In the 'FromJSON'
-- instance we perform sanity checks. We just don't need to remember the fields
@ -340,31 +369,37 @@ fetchKey manager sigAlgo u = runExceptT $ do
obj <- fetch u
(actor, pkey) <-
case obj of
Left' pkey ->
Left' pkey -> do
if publicKeyId pkey == u
then return ()
else throwE "Public key's ID doesn't match the keyid URI"
if uriAuthority (publicKeyOwner pkey) == uriAuthority u
then do
actor <- fetch $ publicKeyOwner pkey
case actorPublicKey actor of
Left uri ->
if uri == u
then return (actor, pkey)
else throwE "Mismatch between pkey @id and actor publicKey URI"
Right _ -> throwE "Actor publicKey is an object, not the pkey @id URI"
then return ()
else throwE "Actor and key on different domains, we reject"
actor <- fetch $ publicKeyOwner pkey
let PublicKeySet k1 mk2 = actorPublicKeys actor
match (Left uri) = uri == u
match (Right _) = False
if match k1 || maybe False match mk2
then return (actor, pkey)
else throwE "Actor publicKey has no URI matching pkey @id"
Right' actor -> do
if actorId actor == u { uriFragment = "" }
then return ()
else throwE "Actor ID doesn't match the keyid URI we fetched"
case actorPublicKey actor of
Left _ -> throwE "keyId resolved to document that has no key"
Right pk -> return (actor, pk)
let PublicKeySet k1 mk2 = actorPublicKeys actor
match (Left _) = Nothing
match (Right pk) =
if publicKeyId pk == u
then Just pk
else Nothing
case match k1 <|> (match =<< mk2) of
Nothing -> throwE "keyId resolved to actor which doesn't have a key object with that ID"
Just pk -> return (actor, pk)
ExceptT . pure $ do
if publicKeyShared pkey
then Left "Actor's publicKey is shared, we're rejecting it!"
else Right ()
if publicKeyId pkey == u
then Right ()
else Left "Actor's publicKey's ID doesn't match the keyid URI"
if publicKeyOwner pkey == actorId actor
then Right ()
else Left "Actor's publicKey's owner doesn't match the actor's ID"