module Propellor.PrivData.Paths where

import Utility.Exception
import System.FilePath
import Control.Applicative
import Prelude

privDataDir :: FilePath
privDataDir :: FilePath
privDataDir = FilePath
"privdata"

privDataFile :: IO FilePath
privDataFile :: IO FilePath
privDataFile = FilePath -> IO FilePath
allowRelocate forall a b. (a -> b) -> a -> b
$ FilePath
privDataDir FilePath -> FilePath -> FilePath
</> FilePath
"privdata.gpg"

privDataKeyring :: IO FilePath
privDataKeyring :: IO FilePath
privDataKeyring = FilePath -> IO FilePath
allowRelocate forall a b. (a -> b) -> a -> b
$ FilePath
privDataDir FilePath -> FilePath -> FilePath
</> FilePath
"keyring.gpg"

privDataLocal :: FilePath
privDataLocal :: FilePath
privDataLocal = FilePath
privDataDir FilePath -> FilePath -> FilePath
</> FilePath
"local"

privDataRelay :: String -> FilePath
privDataRelay :: FilePath -> FilePath
privDataRelay FilePath
host = FilePath
privDataDir FilePath -> FilePath -> FilePath
</> FilePath
"relay" FilePath -> FilePath -> FilePath
</> FilePath
host

-- Allow relocating files in privdata, by checking for a file
-- privdata/relocate, which contains the path to a subdirectory that
-- contains the files.
allowRelocate :: FilePath -> IO FilePath
allowRelocate :: FilePath -> IO FilePath
allowRelocate FilePath
f = [FilePath] -> FilePath
reloc forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines
	forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO FilePath
"" (FilePath -> IO FilePath
readFile (FilePath
privDataDir FilePath -> FilePath -> FilePath
</> FilePath
"relocate"))
  where
	reloc :: [FilePath] -> FilePath
reloc (FilePath
p:[FilePath]
_) | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
p) = FilePath
privDataDir FilePath -> FilePath -> FilePath
</> FilePath
p FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
takeFileName FilePath
f
	reloc [FilePath]
_ = FilePath
f