Tricu 2.0.0

Sorry for squashing all of this but 🤷

src/ContentStore/Filesystem.hs

@@ -0,0 +1,60 @@
+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