Add utility for loading permanent key files, and use it for ocap signing key

src/Vervis/ActorKey.hs

@@ -17,7 +17,6 @@ module Vervis.ActorKey
     ( ActorKey ()
     , generateActorKey
     , actorKeyRotator
-    , loadActorKey
     , actorKeyPublicBin
     , actorKeySign
     -- , actorKeyVerify
@@ -41,6 +40,8 @@ import System.Directory (doesFileExist)
 
 import qualified Data.ByteString as B (writeFile, readFile)
 
+import Vervis.KeyFile
+
 -- | 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
 -- signatures.
@@ -56,6 +57,16 @@ data ActorKey = ActorKey
       --   key once and potentially send the PEM many times.
     }
 
+instance KeyFile ActorKey where
+    generateKey = generateActorKey
+    parseKey b = do
+        secret <- throwCryptoErrorIO $ secretKey b
+        return ActorKey
+            { actorKeySecret = secret
+            , actorKeyPublic = toPublic secret
+            }
+    renderKey = convert . actorKeySecret
+
 {-
 -- | Ed25519 public key for signature verification. We receive these public
 -- keys from other servers and we use them to verify HTTP request signatures.
@@ -161,24 +172,6 @@ actorKeyRotator interval keys =
                 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,10 @@ import qualified Data.Text as T (unpack)
 
 import Control.Concurrent.Local (forkCheck)
 
-import Vervis.ActorKey (generateActorKey, actorKeyRotator, loadActorKey)
+import Database.Persist.Schema.PostgreSQL (schemaBackend)
+
+import Vervis.ActorKey (generateActorKey, actorKeyRotator)
+import Vervis.KeyFile (isInitialSetup, loadKeyFile)
 
 -- Import all relevant handler modules here.
 -- Don't forget to add new modules to your cabal file!
@@ -115,8 +118,6 @@ makeFoundation appSettings = do
         newTVarIO =<<
         (,,) <$> generateActorKey <*> generateActorKey <*> pure True
 
-    appCapSignKey <- loadActorKey $ appCapabilitySigningKeyFile appSettings
-
     appActivities <- newTVarIO mempty
 
     -- We need a log function to create a connection pool. We need a connection
@@ -124,11 +125,14 @@ makeFoundation appSettings = do
     -- logging function. To get out of this loop, we initially create a
     -- temporary foundation without a real connection pool, get a log function
     -- from there, and then create the real foundation.
-    let mkFoundation appConnPool = App {..}
+    let mkFoundation appConnPool appCapSignKey = App {..}
         -- The App {..} syntax is an example of record wild cards. For more
         -- information, see:
         -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
-        tempFoundation = mkFoundation $ error "connPool forced in tempFoundation"
+        tempFoundation =
+            mkFoundation
+                (error "connPool forced in tempFoundation")
+                (error "capSignKey forced in tempFoundation")
         logFunc = loggingFunction tempFoundation
 
     -- Create the database connection pool
@@ -136,6 +140,9 @@ makeFoundation appSettings = do
         (pgConnStr  $ appDatabaseConf appSettings)
         (pgPoolSize $ appDatabaseConf appSettings)
 
+    setup <- isInitialSetup pool schemaBackend
+    capSignKey <- loadKeyFile setup $ appCapabilitySigningKeyFile appSettings
+
     -- Perform database migration using our application's logging settings.
     --runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
     flip runLoggingT logFunc $
@@ -149,7 +156,7 @@ makeFoundation appSettings = do
                 Right (_from, _to) -> $logInfo "DB migration success"
 
     -- Return the foundation
-    return $ mkFoundation pool
+    return $ mkFoundation pool capSignKey
 
 -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
 -- applying some additional middlewares.

src/Vervis/KeyFile.hs

@@ -0,0 +1,82 @@
+{- This file is part of Vervis.
+ -
+ - Written in 2019 by fr33domlover <fr33domlover@riseup.net>.
+ -
+ - ♡ Copying is an act of love. Please copy, reuse and share.
+ -
+ - The author(s) have dedicated all copyright and related and neighboring
+ - rights to this software to the public domain worldwide. This software is
+ - distributed without any warranty.
+ -
+ - You should have received a copy of the CC0 Public Domain Dedication along
+ - with this software. If not, see
+ - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ -}
+
+-- | Initial generation of key files, and later loading them.
+--
+-- Some programs need to generate a file, such as a signing key, and later
+-- consistently use this file for program operation. And it's critical that
+-- this very same file remains available. For example, if that file is an
+-- encryption key used for encrypting all program state, then losing this file
+-- means losing all program state.
+--
+-- In such a case, you may wish to have the following behavior:
+--
+--   * If we're in the initial program setup step, generate key files and store
+--     them somewhere (file, database, etc.)
+--   * If we aren't in that step anymore, require that these files are present,
+--     and load them for use in the program. If a key file is missing, don't
+--     just blindly generate a new one, because we *need* it to consistently be
+--     the same file we originally generated. So if it's missing, report an
+--     error to the user.
+--   * Have a reliable way to determine whether we're in the initial setup
+--     step, and make sure it's not easy to accidentally break this detection
+--
+-- This module implements such a mechanism for Vervis. It's really simple:
+--
+--   * If there are no tables in the DB, it's the initial setup phase
+--   * If initial setup, require that key file doesn't exist, and generate one
+--   * If not initial setup, require that key file exists
+module Vervis.KeyFile
+    ( KeyFile (..)
+    , isInitialSetup
+    , loadKeyFile
+    )
+where
+
+import Prelude
+
+import Control.Monad.Trans.Reader (runReaderT)
+import Data.ByteString (ByteString)
+import Database.Persist.Schema (SchemaBackend, hasEntities)
+import Database.Persist.Schema.SQL ()
+import Database.Persist.Sql (SqlBackend, ConnectionPool, runSqlPool)
+import System.Directory (doesFileExist)
+
+import qualified Data.ByteString as B (readFile, writeFile)
+
+class KeyFile a where
+    generateKey :: IO a
+    parseKey    :: ByteString -> IO a
+    renderKey   :: a -> ByteString
+
+-- | Check whether we're in the initial setup step, in which we create keys.
+-- Otherwise, we'll only use existing keys loaded from files.
+isInitialSetup :: ConnectionPool -> SchemaBackend SqlBackend -> IO Bool
+isInitialSetup pool sb =
+    flip runSqlPool pool . flip runReaderT sb $ not <$> hasEntities
+
+loadKeyFile :: KeyFile a => Bool -> FilePath -> IO a
+loadKeyFile setup path = do
+    e <- doesFileExist path
+    if e
+        then if setup
+                then fail $ "loadKeyFile: Initial setup but file already exists: " ++ path
+                else parseKey =<< B.readFile path
+        else if setup
+                then do
+                    k <- generateKey
+                    B.writeFile path $ renderKey k
+                    return k
+                else fail $ "loadKeyFile: File not found: " ++ path

vervis.cabal

@@ -143,6 +143,7 @@ library
                        Vervis.Handler.Workflow
                        Vervis.Import
                        Vervis.Import.NoFoundation
+                       Vervis.KeyFile
                        Vervis.MediaType
                        Vervis.Migration
                        Vervis.Migration.Model