From 9536d870e52490f9bf8fbb177f61e6b15dff4e35 Mon Sep 17 00:00:00 2001 From: fr33domlover Date: Fri, 8 Feb 2019 03:13:56 +0000 Subject: [PATCH] Add utility for loading permanent key files, and use it for ocap signing key --- src/Vervis/ActorKey.hs | 31 ++++++--------- src/Vervis/Application.hs | 19 ++++++--- src/Vervis/KeyFile.hs | 82 +++++++++++++++++++++++++++++++++++++++ vervis.cabal | 1 + 4 files changed, 108 insertions(+), 25 deletions(-) create mode 100644 src/Vervis/KeyFile.hs diff --git a/src/Vervis/ActorKey.hs b/src/Vervis/ActorKey.hs index aca85f8..2734e3d 100644 --- a/src/Vervis/ActorKey.hs +++ b/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 diff --git a/src/Vervis/Application.hs b/src/Vervis/Application.hs index a33bd45..7654679 100644 --- a/src/Vervis/Application.hs +++ b/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. diff --git a/src/Vervis/KeyFile.hs b/src/Vervis/KeyFile.hs new file mode 100644 index 0000000..a3d45e9 --- /dev/null +++ b/src/Vervis/KeyFile.hs @@ -0,0 +1,82 @@ +{- This file is part of Vervis. + - + - Written in 2019 by fr33domlover . + - + - ♡ 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 + - . + -} + +-- | 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 diff --git a/vervis.cabal b/vervis.cabal index 9157543..f393ef9 100644 --- a/vervis.cabal +++ b/vervis.cabal @@ -143,6 +143,7 @@ library Vervis.Handler.Workflow Vervis.Import Vervis.Import.NoFoundation + Vervis.KeyFile Vervis.MediaType Vervis.Migration Vervis.Migration.Model