don't allow overwrite of object file

1 files changed, 12 insertions, 8 deletions

diff --git a/Storage/LocalFiles.hs b/Storage/LocalFiles.hs
index fd77ba1..f34a8b5 100644
--- a/Storage/LocalFiles.hs
+++ b/Storage/LocalFiles.hs
@@ -36,14 +36,18 @@ store i s = onError (StoreFailure . show) $ do
 	dir <- shardDir
 	createDirectoryIfMissing True dir
 	let dest = dir </> shardFile i
-	let tmp = dest ++ ".tmp"
-	fd <- openFd tmp WriteOnly (Just 0o666)
-		(defaultFileFlags { exclusive = True } )
-	h <- fdToHandle fd
-	B.hPut h (toByteString s)
-	hClose h
-	renameFile tmp dest
-	return StoreSuccess
+	exists <- doesFileExist dest
+	if exists
+		then return $ StoreFailure "file already exists"
+		else do
+			let tmp = dest ++ ".tmp"
+			fd <- openFd tmp WriteOnly (Just 0o666)
+				(defaultFileFlags { exclusive = True } )
+			h <- fdToHandle fd
+			B.hPut h (toByteString s)
+			hClose h
+			renameFile tmp dest
+			return StoreSuccess
 
 retrieve :: ShardNum -> StorableObjectIdent -> IO RetrieveResult
 retrieve n i = onError (RetrieveFailure . show) $ do