diff --git a/config/settings-default.yaml b/config/settings-default.yaml index 6ce9db7..7f8e8a6 100644 --- a/config/settings-default.yaml +++ b/config/settings-default.yaml @@ -116,3 +116,10 @@ max-accounts: 3 # name: "_env:SENDERNAME:vervis" # email: "_env:SENDEREMAIL:vervis@vervis.vervis" # allow-reply: false + +############################################################################### +# Federation +############################################################################### + +# Signing key file for signing object capabilities sent to remote users +capability-signing-key: config/capability_signing_key diff --git a/src/Vervis/ActorKey.hs b/src/Vervis/ActorKey.hs index 22aab7b..533e784 100644 --- a/src/Vervis/ActorKey.hs +++ b/src/Vervis/ActorKey.hs @@ -17,8 +17,10 @@ module Vervis.ActorKey ( ActorKey () , generateActorKey , actorKeyRotator + , loadActorKey , actorKeyPublicBin , actorKeySign + , actorKeyVerify ) where @@ -28,12 +30,16 @@ import Control.Concurrent (threadDelay) import Control.Concurrent.STM (TVar, writeTVar) import Control.Monad (forever) import Control.Monad.STM (atomically) +import Crypto.Error (throwCryptoErrorIO) import Crypto.PubKey.Ed25519 hiding (Signature) import Data.ByteArray (convert) import Data.ByteString (ByteString) import Data.Time.Interval (TimeInterval, microseconds) import Data.PEM import Network.HTTP.Signature (Signature (..)) +import System.Directory (doesFileExist) + +import qualified Data.ByteString as B (writeFile, readFile) -- | Ed25519 signing key, we generate it on the server and use for signing. We -- also make its public key available to whoever wishes to verify our @@ -149,6 +155,24 @@ actorKeyRotator interval key = error $ "actorKeyRotator: interval out of range: " ++ show micros +-- | If a key file exists, load the key from there. Otherwise, generate a new +-- key, write it to the file and return it. +loadActorKey :: FilePath -> IO ActorKey +loadActorKey path = do + e <- doesFileExist path + if e + then do + b <- B.readFile path + secret <- throwCryptoErrorIO $ secretKey b + return ActorKey + { actorKeySecret = secret + , actorKeyPublic = toPublic secret + } + else do + akey <- generateActorKey + B.writeFile path $ convert $ actorKeySecret akey + return akey + -- | The public key in PEM format, can be directly placed in responses. -- -- Well, right now it's actually just the public key in binary form, because diff --git a/src/Vervis/Application.hs b/src/Vervis/Application.hs index 6067e8f..17f7927 100644 --- a/src/Vervis/Application.hs +++ b/src/Vervis/Application.hs @@ -57,7 +57,7 @@ import qualified Data.Text as T (unpack) import Control.Concurrent.Local (forkCheck) -import Vervis.ActorKey (generateActorKey, actorKeyRotator) +import Vervis.ActorKey (generateActorKey, actorKeyRotator, loadActorKey) -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file! @@ -113,6 +113,8 @@ makeFoundation appSettings = do appActorKey <- newTVarIO =<< generateActorKey + appCapSignKey <- loadActorKey $ appCapabilitySigningKeyFile appSettings + appActivities <- newTVarIO mempty -- We need a log function to create a connection pool. We need a connection diff --git a/src/Vervis/Foundation.hs b/src/Vervis/Foundation.hs index cf3bbd5..41e0f1e 100644 --- a/src/Vervis/Foundation.hs +++ b/src/Vervis/Foundation.hs @@ -81,6 +81,7 @@ data App = App , appMailQueue :: Maybe (Chan (MailRecipe App)) , appSvgFont :: PreparedFont Double , appActorKey :: TVar ActorKey + , appCapSignKey :: ActorKey , appActivities :: TVar (Vector (UTCTime, Either String (ByteString, BL.ByteString))) } diff --git a/src/Vervis/Settings.hs b/src/Vervis/Settings.hs index d6bcdc6..e4df6b5 100644 --- a/src/Vervis/Settings.hs +++ b/src/Vervis/Settings.hs @@ -102,6 +102,9 @@ data AppSettings = AppSettings -- | SMTP server details for sending email, and other email related -- details. If set to 'Nothing', no email will be sent. , appMail :: Maybe MailSettings + + -- Signing key file for signing object capabilities sent to remote users + , appCapabilitySigningKeyFile :: FilePath } instance FromJSON AppSettings where @@ -141,6 +144,8 @@ instance FromJSON AppSettings where appAccounts <- o .: "max-accounts" appMail <- o .:? "mail" + appCapabilitySigningKeyFile <- o .: "capability-signing-key" + return AppSettings {..} -- | Settings for 'widgetFile', such as which template languages to support and