{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Storage.LocalFiles (localFiles) where

import Types
import Storage
import Serialization ()
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as U8
import Data.Monoid
import Data.List
import System.Posix.User
import System.IO
import System.Directory
import System.Posix
import System.FilePath
import Raaz.Core.Encode
import Control.DeepSeq
import Control.Exception

localFiles :: Storage
localFiles = Storage
	{ storeShard = store
	, retrieveShard = retrieve
	, obscureShards = obscure
	, countShards = count
	}

store :: StorableObjectIdent -> Shard -> IO StoreResult
store i s = onError (StoreFailure . show) $ do
	dir <- shardDir
	createDirectoryIfMissing True dir
	let dest = dir </> shardFile i
	exists <- doesFileExist dest
	if exists
		then return $ StoreFailure "file already exists"
		else do
			let tmp = dest ++ ".tmp"
			fd <- openFd tmp WriteOnly (Just 0o666)
				(defaultFileFlags { exclusive = True } )
			h <- fdToHandle fd
			B.hPut h (toByteString s)
			hClose h
			renameFile tmp dest
			return StoreSuccess

retrieve :: ShardNum -> StorableObjectIdent -> IO RetrieveResult
retrieve n i = onError (RetrieveFailure . show) $ do
	dir <- shardDir
	fd <- openFd (dir </> shardFile i) ReadOnly Nothing defaultFileFlags
	h <- fdToHandle fd
	b <- B.hGetContents h
	b `deepseq` hClose h
	return $ RetrieveSuccess $ Shard n (StorableObject b)

-- | Set atime and mtime to epoch, to obscure access and modification
-- patterns.
--
-- There is no way to set the ctime to the epoch, but setting the other
-- times does at least set it to the current time, which makes all
-- currently stored files look alike.
--
-- Note that the contents of shards is never changed, so it's ok to set the
-- mtime to the epoch; backup programs won't be confused.
obscure :: IO ObscureResult
obscure = onError (ObscureFailure . show) $ do
	dir <- shardDir
	fs <- filter isShardFile <$> getDirectoryContents dir
	mapM_ (\f -> setFileTimes (dir </> f) 0 0) fs
	return ObscureSuccess

count :: IO CountResult
count = onError (CountFailure . show) $ do
	dir <- shardDir
	CountResult . genericLength . filter isShardFile
		<$> getDirectoryContents dir

onError :: (IOException -> a) -> IO a -> IO a
onError f a = do
	v <- try a
	return $ case v of
		Left e -> f e
		Right r -> r

shardDir :: IO FilePath
shardDir = do
	u <- getUserEntryForID =<< getEffectiveUserID
	return $ homeDirectory u </> dotdir

shardFile :: StorableObjectIdent -> String
shardFile i = U8.toString (toByteString i) <> ext

ext :: String
ext = ".keysafe"

isShardFile :: FilePath -> Bool
isShardFile f = ext `isSuffixOf` f

dotdir :: FilePath
dotdir = ".keysafe" </> "objects"