From e450d7a2d1bdde57d01f027b2e5b8080095f1380 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 11 Aug 2016 17:40:23 -0400
Subject: pluggable object storage layer

---
 Storage/LocalFiles.hs | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 Storage/LocalFiles.hs

(limited to 'Storage')

diff --git a/Storage/LocalFiles.hs b/Storage/LocalFiles.hs
new file mode 100644
index 0000000..a9496da
--- /dev/null
+++ b/Storage/LocalFiles.hs
@@ -0,0 +1,62 @@
+{- Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Storage.LocalFiles (localFiles) where
+
+import Types
+import Storage
+import Serialization ()
+import qualified Data.ByteString as B
+import qualified Data.ByteString.UTF8 as U8
+import Data.Monoid
+import System.Posix.User
+import System.IO
+import System.Directory
+import System.Posix
+import System.FilePath
+import Raaz.Core.Encode
+import Control.DeepSeq
+
+localFiles :: Storage
+localFiles = Storage
+	{ storeShard = store
+	, retrieveShard = retrieve
+	}
+
+store :: StorableObjectIdent -> Shard -> IO StoreResult
+store i s = do
+	dir <- shardDir
+	createDirectoryIfMissing True dir
+	fd <- openFd (dir </> shardFile i) WriteOnly (Just 0o666)
+		(defaultFileFlags { exclusive = True } )
+	h <- fdToHandle fd
+	B.hPut h (toByteString s)
+	hClose h
+	return StoreSuccess
+
+retrieve :: ShardNum -> StorableObjectIdent -> IO RetrieveResult
+retrieve n i = do
+	dir <- shardDir
+	fd <- openFd (dir </> shardFile i) ReadOnly Nothing defaultFileFlags
+	h <- fdToHandle fd
+	b <- B.hGetContents h
+	b `deepseq` hClose h
+	return $ RetrieveSuccess $ Shard n (StorableObject b)
+
+shardDir :: IO FilePath
+shardDir = do
+	u <- getUserEntryForID =<< getEffectiveUserID
+	return $ homeDirectory u </> dotdir
+
+shardFile :: StorableObjectIdent -> String
+shardFile i = U8.toString (toByteString i) <> ext
+
+ext :: String
+ext = ".keysafe"
+
+dotdir :: FilePath
+dotdir = ".keysafe" </> "objects"
-- 
cgit v1.2.3