module ContentStore.Filesystem
  ( putObject
  , getObject
  , objectPath
  , ensureStore
  ) where

import ContentStore.Object

import Control.Monad    (unless, when)
import Data.Text        (unpack)
import System.Directory (createDirectoryIfMissing, doesFileExist, removeFile, renameFile)
import System.FilePath  ((</>))
import System.IO        (hClose, openBinaryTempFile)

import qualified Data.ByteString as BS

ensureStore :: StorePath -> IO ()
ensureStore (StorePath root) = do
  createDirectoryIfMissing True (root </> "objects")
  createDirectoryIfMissing True (root </> "aliases" </> "names")
  createDirectoryIfMissing True (root </> "aliases" </> "modules")
  createDirectoryIfMissing True (root </> "aliases" </> "packages")
  createDirectoryIfMissing True (root </> "manifests")
  createDirectoryIfMissing True (root </> "tmp")

objectPath :: StorePath -> ObjectHash -> FilePath
objectPath (StorePath root) h = root </> "objects" </> shardForHash h </> unpack h

putObject :: StorePath -> Domain -> BS.ByteString -> IO ObjectHash
putObject store@(StorePath root) domain payload = do
  ensureStore store
  let h = hashObject domain payload
      shardDir = root </> "objects" </> shardForHash h
      finalPath = objectPath store h
  createDirectoryIfMissing True shardDir
  exists <- doesFileExist finalPath
  if exists
    then verifyExisting finalPath
    else do
      let tmpDir = root </> "tmp"
      (tmpPath, handle) <- openBinaryTempFile tmpDir (unpack h ++ ".tmp")
      BS.hPut handle payload
      hClose handle
      raced <- doesFileExist finalPath
      if raced
        then removeFile tmpPath >> verifyExisting finalPath
        else renameFile tmpPath finalPath
  return h
  where
    verifyExisting path = do
      existing <- BS.readFile path
      when (existing /= payload) $
        fail $ "content-addressed object exists with mismatched bytes: " ++ path

getObject :: StorePath -> ObjectHash -> IO (Maybe BS.ByteString)
getObject store h = do
  let path = objectPath store h
  exists <- doesFileExist path
  if exists then Just <$> BS.readFile path else return Nothing