Store remote actor keys in the DB, reuse them instead of GETing every time

This commit is contained in:
fr33domlover 2019-02-03 13:58:14 +00:00
parent 21c8df1251
commit b0b2aa83c5
8 changed files with 113 additions and 38 deletions

View file

@ -39,6 +39,12 @@ Person
UniquePersonLogin login
UniquePersonEmail email
VerifKey
ident URI
public PublicKey
UniqueVerifKey ident
SshKey
ident KyIdent
person PersonId

View file

@ -0,0 +1,5 @@
VerifKey
ident String
public ByteString
UniqueVerifKey ident

View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- Copying is an act of love. Please copy, reuse and share.
-
@ -13,7 +13,6 @@
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
-- | 'PersistField' instance for 'CI', for easy case-insensitive DB fields.
module Database.Persist.Class.Local
(
)
@ -21,11 +20,46 @@ where
import Prelude
import Control.Exception (displayException)
import Control.Monad ((<=<))
import Crypto.Error (CryptoFailable, eitherCryptoError)
import Crypto.PubKey.Ed25519 (PublicKey, publicKey)
import Data.Bifunctor (first)
import Data.ByteArray (convert)
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import Database.Persist.Class
import Network.URI (URI, uriScheme, parseURI)
import qualified Data.CaseInsensitive as CI
import qualified Data.Text as T (pack)
import Data.Aeson.Local (renderURI)
instance (PersistField s, CI.FoldCase s) => PersistField (CI s) where
toPersistValue = toPersistValue . CI.original
fromPersistValue = fmap CI.mk . fromPersistValue
instance PersistField URI where
toPersistValue = toPersistValue . renderURI
fromPersistValue = parseHttpsURI <=< fromPersistValue
where
parseHttpsURI s =
case parseURI s of
Nothing -> Left "Invalid absolute URI"
Just u ->
if uriScheme u == "https:"
then Right u
else Left "URI scheme isn't https"
instance PersistField PublicKey where
toPersistValue = toPersistValue . convert'
where
convert' :: PublicKey -> ByteString
convert' = convert
fromPersistValue = toKey <=< fromPersistValue
where
publicKey' :: ByteString -> CryptoFailable PublicKey
publicKey' = publicKey
toKey =
first (T.pack . displayException) . eitherCryptoError . publicKey'

View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- Copying is an act of love. Please copy, reuse and share.
-
@ -20,12 +20,26 @@ where
import Prelude
import Crypto.PubKey.Ed25519 (PublicKey)
import Data.ByteArray (convert)
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import Database.Persist.Sql
import Network.URI (URI)
import qualified Data.CaseInsensitive as CI
import Data.Aeson.Local (renderURI)
import Database.Persist.Class.Local ()
instance (PersistFieldSql s, CI.FoldCase s) => PersistFieldSql (CI s) where
sqlType = sqlType . fmap CI.original
instance PersistFieldSql URI where
sqlType = sqlType . fmap renderURI
instance PersistFieldSql PublicKey where
sqlType = sqlType . fmap convert'
where
convert' :: PublicKey -> ByteString
convert' = convert

View file

@ -576,10 +576,15 @@ instance YesodHttpSig App where
u <- ExceptT . pure $ case parseURI $ BC.unpack keyid of
Nothing -> Left "keyId in Sig header isn't a valid absolute URI"
Just uri -> Right uri
let uActor = u { uriFragment = "" }
(fromDB, key) <- do
ment <- lift $ runDB $ getBy $ UniqueVerifKey u
case ment of
Just (Entity _ vk) -> return (True, verifKeyPublic vk)
Nothing -> do
manager <- getsYesod appHttpManager
actor <- ExceptT $ bimap displayException responseBody <$> httpGetAP manager u
ExceptT . pure $ do
let uActor = u { uriFragment = "" }
if uActor == actorId actor
then Right ()
else Left "Actor ID doesn't match the keyid URI we fetched"
@ -607,15 +612,18 @@ instance YesodHttpSig App where
case malgo of
Nothing -> "No algo in Sig, unsupported algo in actor"
Just _ -> "Algo mismatch, Ed25519 in Sig but unsupported algo in actor"
key <- case publicKey $ pemContent $ publicKeyPem pkey of
CryptoPassed k -> Right k
case publicKey $ pemContent $ publicKeyPem pkey of
CryptoPassed k -> Right (False, k)
CryptoFailed e -> Left "Parsing Ed25519 public key failed"
ExceptT . pure $ do
signature <- case signature sig of
CryptoPassed s -> Right s
CryptoFailed e -> Left "Parsing Ed25519 signature failed"
if verify key input signature
then Right uActor
then Right ()
else Left "Ed25519 sig verification says not valid"
unless fromDB $ lift $ runDB $ insert_ $ VerifKey u key
return uActor
instance YesodBreadcrumbs App where
breadcrumb route = return $ case route of

View file

@ -187,6 +187,8 @@ changes =
, removeEntity "RepoRoleInherit"
-- 40
, removeEntity "RepoRole"
-- 41
, addEntities model_2019_02_03_verifkey
]
migrateDB :: MonadIO m => ReaderT SqlBackend m (Either Text (Int, Int))

View file

@ -20,6 +20,7 @@ module Vervis.Migration.Model
, Workflow2016Generic (..)
, Workflow2016
, model_2016_09_01_rest
, model_2019_02_03_verifkey
)
where
@ -57,3 +58,6 @@ model_2016_09_01_rest = $(schema "2016_09_01_rest")
makeEntitiesMigration "2018"
$(modelFile "migrations/2019_01_28_project_collabs.model")
model_2019_02_03_verifkey :: [Entity SqlBackend]
model_2019_02_03_verifkey = $(schema "2019_02_03_verifkey")

View file

@ -1,6 +1,6 @@
{- This file is part of Vervis.
-
- Written in 2016, 2018 by fr33domlover <fr33domlover@riseup.net>.
- Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- Copying is an act of love. Please copy, reuse and share.
-
@ -20,8 +20,10 @@ module Vervis.Model where
import ClassyPrelude.Conduit
import Yesod hiding (Header, parseTime)
import Crypto.PubKey.Ed25519 (PublicKey)
import Database.Persist.Quasi
import Database.Persist.Sql (fromSqlKey)
import Network.URI (URI)
import Text.Email.Validate (EmailAddress)
import Yesod.Auth.Account (PersistUserCredentials (..))