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)