Support actor key expiration
Allow keys to specify expiration time using w3c security vocabulary. If a key has expired, we treat it like sig validation failure and re-fetch the key from the other server. And we never accept a sig, even a valid sig, if the key has expired. Since servers keep actors and keys in the DB, expiration can be a nice way to ask that keys aren't used more than we want them to. The security vocab spec also recommends to set expiration time on keys, so it's nice to support this feature.
This commit is contained in:
parent
37b3416a41
commit
c2c4e24497
5 changed files with 51 additions and 33 deletions
|
@ -41,6 +41,7 @@ Person
|
|||
|
||||
VerifKey
|
||||
ident URI
|
||||
expires UTCTime Maybe
|
||||
public PublicKey
|
||||
sharer RemoteSharerId
|
||||
|
||||
|
|
|
@ -1,5 +1,6 @@
|
|||
VerifKey
|
||||
ident String
|
||||
expires UTCTime Maybe
|
||||
public ByteString
|
||||
sharer RemoteSharerId
|
||||
|
||||
|
|
|
@ -580,7 +580,7 @@ instance YesodHttpSig App where
|
|||
case signature sig of
|
||||
CryptoPassed s -> Right s
|
||||
CryptoFailed e -> Left "Parsing Ed25519 signature failed"
|
||||
(mvkid, key, uActor) <- do
|
||||
(mvkid, key, mexpires, uActor) <- do
|
||||
ments <- lift $ runDB $ do
|
||||
mvk <- getBy $ UniqueVerifKey u
|
||||
for mvk $ \ vk@(Entity _ verifkey) -> do
|
||||
|
@ -591,27 +591,37 @@ instance YesodHttpSig App where
|
|||
return
|
||||
( Just vkid
|
||||
, verifKeyPublic vk
|
||||
, verifKeyExpires vk
|
||||
, remoteSharerIdent remote
|
||||
)
|
||||
Nothing -> do
|
||||
(k, ua) <- fetchKey' u
|
||||
return (Nothing, k, ua)
|
||||
(k, mexp, ua) <- fetchKey' u
|
||||
return (Nothing, k, mexp, ua)
|
||||
let verify' k = verify k input signature
|
||||
err = throwE "Ed25519 sig verification says not valid"
|
||||
errSig = throwE "Ed25519 sig verification says not valid"
|
||||
errTime = throwE "Key expired"
|
||||
existsInDB = isJust mvkid
|
||||
(write, key') <-
|
||||
if verify' key
|
||||
then return (not existsInDB, key)
|
||||
now <- liftIO getCurrentTime
|
||||
let stillValid Nothing = True
|
||||
stillValue (Just expires) = expires > now
|
||||
(write, key', mexpires') <-
|
||||
if verify' key && stillValid mexpires
|
||||
then return (not existsInDB, key, mexpires)
|
||||
else if existsInDB
|
||||
then do
|
||||
(newKey, newActor) <- fetchKey' u
|
||||
(newKey, newExp, newActor) <- fetchKey' u
|
||||
if newActor == uActor
|
||||
then return ()
|
||||
else throwE "Key owner changed, we reject that"
|
||||
if stillValid newExp
|
||||
then return ()
|
||||
else errTime
|
||||
if verify' newKey
|
||||
then return (True, newKey)
|
||||
else err
|
||||
else err
|
||||
then return (True, newKey, newExp)
|
||||
else errSig
|
||||
else if stillValid mexpires
|
||||
then errSig
|
||||
else errTime
|
||||
when write $ ExceptT $ runDB $
|
||||
case mvkid of
|
||||
Nothing -> do
|
||||
|
@ -619,17 +629,18 @@ instance YesodHttpSig App where
|
|||
case ment of
|
||||
Nothing -> do
|
||||
rsid <- insert $ RemoteSharer uActor
|
||||
insert_ $ VerifKey u key' rsid
|
||||
insert_ $ VerifKey u mexpires' key' rsid
|
||||
return $ Right ()
|
||||
Just (Entity rsid rs) -> do
|
||||
n <- count [VerifKeySharer ==. rsid]
|
||||
if n < 2
|
||||
then do
|
||||
insert_ $ VerifKey u key' rsid
|
||||
insert_ $ VerifKey u mexpires' key' rsid
|
||||
return $ Right ()
|
||||
else return $ Left "We already store 2 keys"
|
||||
Just vkid -> do
|
||||
update vkid [VerifKeyPublic =. key']
|
||||
update vkid
|
||||
[VerifKeyExpires =. mexpires', VerifKeyPublic =. key']
|
||||
return $ Right ()
|
||||
return uActor
|
||||
where
|
||||
|
|
|
@ -156,6 +156,7 @@ getPersonR shr = do
|
|||
, actorPublicKeys = PublicKeySet
|
||||
{ publicKey1 = Right PublicKey
|
||||
{ publicKeyId = me { uriFragment = "#key" }
|
||||
, publicKeyExpires = Nothing
|
||||
, publicKeyOwner = me
|
||||
, publicKeyPem = PEM "PUBLIC KEY" [] actorKey
|
||||
, publicKeyAlgo = Just AlgorithmEd25519
|
||||
|
|
|
@ -59,6 +59,7 @@ import Data.PEM
|
|||
import Data.Semigroup (Endo)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Encoding (encodeUtf8, decodeUtf8)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Client.Conduit.ActivityPub (httpAPEither)
|
||||
import Network.HTTP.Client.Signature (signRequest)
|
||||
|
@ -117,6 +118,7 @@ instance ToJSON Algorithm where
|
|||
|
||||
data PublicKey = PublicKey
|
||||
{ publicKeyId :: URI
|
||||
, publicKeyExpires :: Maybe UTCTime
|
||||
, publicKeyOwner :: URI
|
||||
, publicKeyPem :: PEM
|
||||
, publicKeyAlgo :: Maybe Algorithm
|
||||
|
@ -134,6 +136,7 @@ instance FromJSON PublicKey where
|
|||
else fail "PublicKey @type isn't Key"
|
||||
PublicKey
|
||||
<$> (parseHttpsURI =<< o .: "id")
|
||||
<*> o .:? "expires"
|
||||
<*> (parseHttpsURI =<< o .: "owner")
|
||||
<*> (parsePEM =<< o .: "publicKeyPem")
|
||||
<*> o .:? (frg <> "algorithm")
|
||||
|
@ -150,9 +153,10 @@ instance FromJSON PublicKey where
|
|||
|
||||
instance ToJSON PublicKey where
|
||||
toJSON = error "toJSON PublicKey"
|
||||
toEncoding (PublicKey id_ owner pem malgo shared) =
|
||||
toEncoding (PublicKey id_ mexpires owner pem malgo shared) =
|
||||
pairs
|
||||
$ "id" .= renderURI id_
|
||||
<> "expires" .=? mexpires
|
||||
<> "owner" .= renderURI owner
|
||||
<> "publicKeyPem" .= decodeUtf8 (pemWriteBS pem)
|
||||
<> (frg <> "algorithm") .=? malgo
|
||||
|
@ -362,7 +366,7 @@ fetchKey
|
|||
=> Manager
|
||||
-> Bool
|
||||
-> URI
|
||||
-> m (Either String (E.PublicKey, URI))
|
||||
-> m (Either String (E.PublicKey, Maybe UTCTime, URI))
|
||||
fetchKey manager sigAlgo u = runExceptT $ do
|
||||
let fetch :: (MonadIO m, FromJSON a) => URI -> ExceptT String m a
|
||||
fetch u = ExceptT $ bimap displayException responseBody <$> httpGetAP manager u
|
||||
|
@ -418,5 +422,5 @@ fetchKey manager sigAlgo u = runExceptT $ do
|
|||
then "Algo mismatch, Ed25519 in Sig but unsupported algo in actor"
|
||||
else "No algo in Sig, unsupported algo in actor"
|
||||
case E.publicKey $ pemContent $ publicKeyPem pkey of
|
||||
CryptoPassed k -> Right (k, actorId actor)
|
||||
CryptoPassed k -> Right (k, publicKeyExpires pkey, actorId actor)
|
||||
CryptoFailed e -> Left "Parsing Ed25519 public key failed"
|
||||
|
|
Loading…
Reference in a new issue