diff --git a/src/Data/KeyFile.hs b/src/Data/KeyFile.hs index 0a64e04..556f835 100644 --- a/src/Data/KeyFile.hs +++ b/src/Data/KeyFile.hs @@ -15,14 +15,17 @@ module Data.KeyFile ( KeyFile (..) + , KeyFileLoadMode () + , determineKeyFileLoadMode , loadKeyFile ) where import Prelude +import Control.Monad import Data.ByteString (ByteString) -import System.Directory (doesFileExist) +import System.Directory import qualified Data.ByteString as B (readFile, writeFile) @@ -31,16 +34,46 @@ class KeyFile a where parseKey :: ByteString -> IO a renderKey :: a -> ByteString -loadKeyFile :: KeyFile a => Bool -> FilePath -> IO a -loadKeyFile setup path = do +data KeyFileLoadMode + = WriteAll + | ImportExisting + | LoadAll + | WriteMissing + +determineKeyFileLoadMode :: Bool -> IO KeyFileLoadMode +determineKeyFileLoadMode setup = do + laxSetup <- checkSwitch "_keyfile_import_existing" + laxLater <- checkSwitch "_keyfile_write_missing" + if setup + then do + when laxLater $ fail "Non-setup switch present during setup" + return $ if laxSetup then ImportExisting else WriteAll + else do + when laxSetup $ fail "Setup switch present after initial setup" + return $ if laxLater then WriteMissing else LoadAll + where + checkSwitch file = do + exists <- doesFileExist file + if exists + then do + blank <- (== 0) <$> getFileSize file + if blank + then do + removeFile file + return True + else fail $ "Switch file " ++ file ++ "isn't empty!" + else return False + +loadKeyFile :: KeyFile a => KeyFileLoadMode -> FilePath -> IO a +loadKeyFile mode 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 + then case mode of + WriteAll -> fail $ "loadKeyFile: Initial setup but file already exists: " ++ path + _ -> parseKey =<< B.readFile path + else case mode of + LoadAll -> fail $ "loadKeyFile: File not found: " ++ path + _ -> do k <- generateKey B.writeFile path $ renderKey k return k - else fail $ "loadKeyFile: File not found: " ++ path diff --git a/src/Vervis/Application.hs b/src/Vervis/Application.hs index 75eec1c..34bf1cc 100644 --- a/src/Vervis/Application.hs +++ b/src/Vervis/Application.hs @@ -60,7 +60,7 @@ import Control.Concurrent.Local (forkCheck) import Database.Persist.Schema.PostgreSQL (schemaBackend) -import Data.KeyFile (loadKeyFile) +import Data.KeyFile import Web.Hashids.Local import Vervis.ActorKey (generateActorKey, actorKeyRotator) @@ -155,8 +155,10 @@ makeFoundation appSettings = do (pgPoolSize $ appDatabaseConf appSettings) setup <- isInitialSetup pool schemaBackend - capSignKey <- loadKeyFile setup $ appCapabilitySigningKeyFile appSettings - hashidsSalt <- loadKeyFile setup $ appHashidsSaltFile appSettings + loadMode <- determineKeyFileLoadMode setup + + capSignKey <- loadKeyFile loadMode $ appCapabilitySigningKeyFile appSettings + hashidsSalt <- loadKeyFile loadMode $ appHashidsSaltFile appSettings let hashidsCtx = hashidsContext hashidsSalt hashidEncode = decodeUtf8 . encodeInt64 hashidsCtx hashidDecode = decodeInt64 hashidsCtx . encodeUtf8