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

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

import Types
import Types.Storage
import Output
import Serialization ()
import Utility.UserInfo
import Utility.Exception
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as U8
import Data.Monoid
import Data.List
import Data.Maybe
import System.IO
import System.Directory
import System.Posix
import System.FilePath
import Raaz.Core.Encode
import Control.DeepSeq
import Control.Monad
import System.DiskSpace
import Control.Exception (IOException)

type GetShareDir = Section -> IO FilePath

newtype Section = Section String

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

localStorageOverride :: FilePath -> IO (Maybe Storage)
localStorageOverride d = onError' accesserror $ do
	-- Check that the directory can be written to.
	createDirectoryIfMissing True d
	-- Use a filename as long as used for keysafe share files.
	let f = d </> "testtesttesttesttesttesttesttesttesttesttesttesttesttesttesttest.keysafe"
	writeFile f "test"
	_ <- readFile f
	removeFile f
	return $ Just $ localStorage LocallyPreferred (\_ -> pure d) ""
  where
	accesserror e = do
		warn $ "Unable to access local storage directory " ++ d ++ " (" ++ show e ++ ")"
		return Nothing

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
	exists <- doesDirectoryExist dir
	if exists
		then CountResult . genericLength . filter isShareFile
			<$> getDirectoryContents dir
		else return (CountResult 0)

move :: Section -> GetShareDir -> Storage -> IO [StoreResult]
move section getsharedir storage = do
	dir <- getsharedir section
	fs <- map (dir </>) <$> catchDefaultIO [] (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 = onError' (pure . f)

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

storageDir :: Maybe LocalStorageDirectory -> GetShareDir
storageDir Nothing (Section section) = do
	home <- myHomeDir
	return $ home </> dotdir </> section
storageDir (Just (LocalStorageDirectory d)) (Section section) =
	pure $ d </> section

storageTopDir :: Maybe LocalStorageDirectory -> IO FilePath
storageTopDir lsd = storageDir lsd (Section ".")

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

localDiskUsage :: Maybe LocalStorageDirectory -> IO DiskUsage
localDiskUsage lsd = getDiskUsage =<< storageTopDir lsd

-- | 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"