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

module Storage.Local
	( localStorage
	, storageDir
	, testStorageDir
	, localDiskUsage
	) where

import Types
import Types.Storage
import Serialization ()
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as U8
import Data.Monoid
import Data.List
import Data.Maybe
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
import Control.Monad
import System.DiskSpace

type GetShareDir = Section -> IO FilePath

newtype Section = Section String

localStorage :: GetShareDir -> String -> Storage
localStorage getsharedir n = Storage
	{ storeShare = store section getsharedir
	, retrieveShare = retrieve section getsharedir
	, obscureShares = obscure section getsharedir
	, countShares = count section getsharedir
	, moveShares = move section getsharedir
	, uploadQueue = Nothing
	}
  where
	section = Section n

store :: Section -> GetShareDir -> StorableObjectIdent -> Share -> IO StoreResult
store section getsharedir i s = onError (StoreFailure . show) $ do
	dir <- getsharedir section
	createDirectoryIfMissing True dir
	let dest = dir </> shareFile i
	exists <- doesFileExist dest
	if exists
		then return StoreAlreadyExists
		else do
			let tmp = dest ++ ".tmp"
			fd <- openFd tmp WriteOnly (Just 0o400)
				(defaultFileFlags { exclusive = True } )
			h <- fdToHandle fd
			B.hPut h (toByteString s)
			hClose h
			renameFile tmp dest
			return StoreSuccess

retrieve :: Section -> GetShareDir -> ShareNum -> StorableObjectIdent -> IO RetrieveResult
retrieve section getsharedir n i = onError (RetrieveFailure . show) $ do
	dir <- getsharedir section
	fd <- openFd (dir </> shareFile i) ReadOnly Nothing defaultFileFlags
	h <- fdToHandle fd
	b <- B.hGetContents h
	b `deepseq` hClose h
	return $ RetrieveSuccess $ Share 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 shares is never changed, so it's ok to set the
-- mtime to the epoch; backup programs won't be confused.
obscure :: Section -> GetShareDir -> IO ObscureResult
obscure section getsharedir = onError (ObscureFailure . show) $ do
	dir <- getsharedir section
	fs <- filter isShareFile <$> getDirectoryContents dir
	mapM_ (\f -> setFileTimes (dir </> f) 0 0) fs
	return ObscureSuccess

count :: Section -> GetShareDir -> IO CountResult
count section getsharedir = onError (CountFailure . show) $ do
	dir <- getsharedir section
	CountResult . genericLength . filter isShareFile
		<$> getDirectoryContents dir

move :: Section -> GetShareDir -> Storage -> IO [StoreResult]
move section getsharedir storage = do
	dir <- getsharedir section
	fs <- map (dir </>) <$> getDirectoryContents dir
	rs <- forM fs $ \f -> case fromShareFile f of
		Nothing -> return Nothing
		Just i -> Just <$> go f i
	return (catMaybes rs)
  where
	-- Use a dummy share number of 0; it doesn't
	-- matter because we're not going to be
	-- recombining the share here.
	sharenum = 0

	go f i = do
		r <- retrieve section getsharedir sharenum i
		case r of
			RetrieveFailure e -> return (StoreFailure e)
			RetrieveSuccess share -> do
				s <- storeShare storage i share
				case s of
					StoreSuccess -> movesuccess f
					StoreAlreadyExists -> alreadyexists share i f
					StoreFailure e -> return (StoreFailure e)

	movesuccess f = do
		removeFile f
		return StoreSuccess

	-- Detect case where the same data is already
	-- stored on the other storage.
	alreadyexists share i f = do
		check <- retrieveShare storage sharenum i
		case check of
			RetrieveSuccess share'
				| share' == share -> movesuccess f
			_ -> return StoreAlreadyExists

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

storageDir :: Maybe LocalStorageDirectory -> GetShareDir
storageDir Nothing (Section section) = do
	u <- getUserEntryForID =<< getEffectiveUserID
	return $ homeDirectory u </> dotdir </> section
storageDir (Just (LocalStorageDirectory d)) (Section section) =
	pure $ d </> section

testStorageDir :: FilePath -> GetShareDir
testStorageDir tmpdir = storageDir (Just (LocalStorageDirectory tmpdir))

localDiskUsage :: Maybe LocalStorageDirectory -> IO DiskUsage
localDiskUsage lsd = do
	dir <- storageDir lsd (Section ".")
	getDiskUsage dir

-- | The takeFileName ensures that, if the StorableObjectIdent somehow
-- contains a path (eg starts with "../" or "/"), it is not allowed
-- to point off outside the shareDir.
shareFile :: StorableObjectIdent -> FilePath
shareFile i = takeFileName (U8.toString (toByteString i)) <> ext

fromShareFile :: FilePath -> Maybe StorableObjectIdent
fromShareFile f
	| isShareFile f = fromByteString $ U8.fromString $ takeFileName $ dropExtension f
	| otherwise = Nothing

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

ext :: String
ext = ".keysafe"

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