change backup log format so it can also log when backup of a key was skipped

This will be used later when keysafe --autostart prompts if the user wants
to back up their gpg key. Making the change now before the backup log
format gets frozen.

This commit was sponsored by Josh Taylor on Patreon.

1 files changed, 89 insertions, 0 deletions

diff --git a/BackupLog.hs b/BackupLog.hs
new file mode 100644
index 0000000..8e48bcd
--- /dev/null
+++ b/BackupLog.hs
@@ -0,0 +1,89 @@
+{- Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE DeriveGeneric, BangPatterns #-}
+
+module BackupLog where
+
+import Types
+import Types.Server
+import Types.Cost
+import Utility.UserInfo
+import GHC.Generics
+import Data.Time.Clock.POSIX
+import Data.Aeson
+import Data.Maybe
+import System.FilePath
+import System.Directory
+import System.Posix.Files
+import qualified Data.ByteString.Lazy as B
+
+data BackupLog = BackupLog POSIXTime BackupEvent
+	deriving (Show, Generic)
+
+instance ToJSON BackupLog
+instance FromJSON BackupLog
+
+-- | Log of a backup.
+--
+-- If an attacker cracks the user's system and finds this stored
+-- on it, it should not help them recover keys from keysafe.
+-- 
+-- That's why the Name used is not included; as knowing the name lets
+-- an attacker download shards and start password cracking.
+--
+-- Including the password entropy does let an attacker avoid trying
+-- weak passwords and go right to passwords that are strong enough, but
+-- this should only half the password crack time at worst.
+data BackupEvent = BackupSkipped SecretKeySource | BackupMade
+	{ backupServers :: [ServerName]
+	, backupSecretKeySource :: SecretKeySource
+	, backupPasswordEntropy :: Int
+	}
+	deriving (Show, Generic)
+
+instance ToJSON BackupEvent
+instance FromJSON BackupEvent
+
+mkBackupLog :: BackupEvent -> IO BackupLog
+mkBackupLog evt = BackupLog
+	<$> getPOSIXTime
+	<*> pure evt
+
+backupMade :: [Server] -> SecretKeySource -> Entropy UnknownPassword -> BackupEvent
+backupMade servers sks (Entropy n) = BackupMade
+	{ backupServers = map serverName servers
+	, backupSecretKeySource = sks
+	, backupPasswordEntropy = n
+	}
+
+backupLogFile :: IO FilePath
+backupLogFile = do
+	home <- myHomeDir
+	return $ home </> ".keysafe/backup.log"
+
+readBackupLogs :: IO [BackupLog]
+readBackupLogs = do
+	f <- backupLogFile
+	e <- doesFileExist f
+	if e
+		then fromMaybe [] . decode <$> B.readFile f
+		else return []
+
+storeBackupLog :: BackupLog -> IO ()
+storeBackupLog r = do
+	!rs <- readBackupLogs
+	f <- backupLogFile
+	let d = takeDirectory f
+	createDirectoryIfMissing True d
+	setFileMode d $
+		ownerReadMode
+			`unionFileModes` ownerWriteMode
+			`unionFileModes` ownerExecuteMode
+	setPermissions d 
+		$ setOwnerReadable True 
+			$ setOwnerWritable True 
+				$ setOwnerExecutable True emptyPermissions
+	B.writeFile f $ encode (r:rs)