{-# LANGUAGE Safe #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Passman.Core.Config
-- Copyright   : Matthew Harm Bekkema 2016
-- License     : GPL-2
-- Maintainer  : mbekkema97@gmail.com
-- Stability   : experimental
-- Portability : POSIX
-----------------------------------------------------------------------------

module Passman.Core.Config
(
-- * Data Structures
  Config(..)
, ConfigError(..)
-- * File IO
, loadConfig
, saveConfig
) where

import Passman.Core.Config.Optional (OptionalConfig)

import Safe (readMay)
import System.Directory (getHomeDirectory)
import System.PosixCompat.Files (fileMode, getFileStatus, setFileMode, intersectFileModes, ownerModes)
import Control.Monad.List (guard)
import Control.Exception (tryJust)
import System.IO (IOMode(WriteMode, ReadMode), hPutStr, hGetContents, openFile, hClose)
import System.IO.Error (isDoesNotExistError)
import Data.Functor ((<$>))
import Control.Monad.Trans (liftIO)
import Control.Monad.Trans.Error (ErrorT(..), Error(..), runErrorT)

-- | The persistent configuration of the password manager
data Config = Config {
                       -- | Hash of the master password generated by
                       -- `Passman.Core.Hash.hashMasterPassword`
                       masterPasswordHash :: String
                       -- | The optional portion of the configuration file
                     , optionalConfig     :: OptionalConfig
                     } deriving (Show, Read)

-- | Possible config file errors
data ConfigError =
    -- | There is currently no configuration file.
    ConfigFileNotFound |
    -- | A configuration file was found but its contents are invalid. The
    -- `FilePath` points to the found configuration file so that the error may
    -- be reported to the user
    InvalidConfig FilePath

instance Error ConfigError where
    noMsg = ConfigFileNotFound
    strMsg = const ConfigFileNotFound

configFile :: IO FilePath
configFile = (++"/.passman") <$> getHomeDirectory

-- | Corrects the permissions on the specified config file such that only the
-- file owner may read the file.
correctPermissions :: FilePath -> IO ()
correctPermissions fp = do
    currentMode <- fileMode <$> getFileStatus fp
    let newMode = intersectFileModes currentMode ownerModes
    setFileMode fp newMode

-- | Saves the specified config to file, overwriting an existing config file.
saveConfig :: Config -> IO ()
saveConfig config = do
    f <- configFile
    out <- openFile f WriteMode
    hPutStr out $ show config
    hClose out
    correctPermissions f

-- | Loads a config from file.
loadConfig :: IO (Either ConfigError Config)
loadConfig = runErrorT $ do
    f <- liftIO configFile
    h <- ErrorT $ tryJust fileNotFound $ openFile f ReadMode
    contents <- liftIO $ hGetContents h
    ErrorT $ return $ maybe (Left $ InvalidConfig f) Right $ readMay contents

fileNotFound :: IOError -> Maybe ConfigError
fileNotFound = fmap (const ConfigFileNotFound) . guard . isDoesNotExistError