Hold a persistent server key for ocap signatures

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

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

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

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)))
     }

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