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.hs            | 17 ++++++++++++++
 Storage/LocalFiles.hs | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++
 Types.hs              |  4 +++-
 keysafe.cabal         |  2 ++
 keysafe.hs            | 29 +++++-------------------
 5 files changed, 89 insertions(+), 25 deletions(-)
 create mode 100644 Storage.hs
 create mode 100644 Storage/LocalFiles.hs

diff --git a/Storage.hs b/Storage.hs
new file mode 100644
index 0000000..3e5707f
--- /dev/null
+++ b/Storage.hs
@@ -0,0 +1,17 @@
+{- Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module Storage where
+
+import Types
+
+data Storage = Storage
+	{ storeShard :: StorableObjectIdent -> Shard -> IO StoreResult
+	, retrieveShard :: ShardNum -> StorableObjectIdent -> IO RetrieveResult
+	}
+
+data StoreResult = StoreSuccess | StoreFailure String
+
+data RetrieveResult = RetrieveSuccess Shard | RetrieveFailure String
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"
diff --git a/Types.hs b/Types.hs
index 06bfbe2..20ec63e 100644
--- a/Types.hs
+++ b/Types.hs
@@ -34,7 +34,9 @@ newtype StorableObjectIdent = StorableObjectIdent B.ByteString
 	deriving (Show)
 
 -- | A shard, with a known number (N of M).
-data Shard = Shard Int StorableObject
+data Shard = Shard ShardNum StorableObject
+
+type ShardNum = Int
 
 -- | A password used to encrypt a key stored in keysafe.
 newtype Password = Password B.ByteString
diff --git a/keysafe.cabal b/keysafe.cabal
index a9ae1da..bebc882 100644
--- a/keysafe.cabal
+++ b/keysafe.cabal
@@ -31,6 +31,8 @@ Executable keysafe
     , text == 1.2.*
     , utf8-string == 1.0.*
     , unix == 2.7.*
+    , filepath == 1.4.*
+    , directory == 1.2.*
 
     -- secret-sharing == 1.0.*
     , dice-entropy-conduit >= 1.0.0.0
diff --git a/keysafe.hs b/keysafe.hs
index 32361ab..962f10f 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -11,11 +11,8 @@ import Types
 import Tunables
 import Encryption
 import Shard
-import Raaz.Core.Encode
-import System.IO
-import System.Posix.ByteString
-import qualified Data.ByteString as B
-import Control.DeepSeq
+import Storage
+import Storage.LocalFiles
 
 main :: IO ()
 main = do
@@ -28,7 +25,7 @@ storedemo = do
 	let esk = encrypt kek secretkey
 	let sis = shardIdents tunables name keyid
 	shards <- genShards esk tunables
-	mapM_ (uncurry storeShard) (zip (getIdents sis) shards)
+	mapM_ (uncurry (storeShard localFiles)) (zip (getIdents sis) shards)
   where
 	password = Password "foo"
 	name = Name "bar"
@@ -41,7 +38,8 @@ retrievedemo = do
 	let sis = shardIdents tunables name keyid
 	-- we drop 1 to simulate not getting all shards from the servers
 	let l = drop 1 $ zip [1..] (getIdents sis)
-	shards <- mapM (uncurry retrieveShard) l
+	shards <- map (\(RetrieveSuccess s) -> s)
+		<$> mapM (uncurry (retrieveShard localFiles)) l
 	let esk = combineShards tunables shards
 	kek <- genKeyEncryptionKey tunables name password
 	-- TODO: need to solve the encryption puzzle
@@ -53,20 +51,3 @@ retrievedemo = do
 	name = Name "bar"
 	tunables = testModeTunables -- defaultTunables
 	keyid = KeyId gpgKey "foobar"
-
-storeShard :: StorableObjectIdent -> Shard -> IO ()
-storeShard i s = do
-	print $ toByteString i
-	fd <- openFd (toByteString i) WriteOnly (Just 0o666)
-		(defaultFileFlags { exclusive = True } )
-	h <- fdToHandle fd
-	B.hPut h (toByteString s)
-	hClose h
-
-retrieveShard :: Int -> StorableObjectIdent -> IO Shard
-retrieveShard n i = do
-	fd <- openFd (toByteString i) ReadOnly Nothing defaultFileFlags
-	h <- fdToHandle fd
-	b <- B.hGetContents h
-	b `deepseq` hClose h
-	return (Shard n (StorableObject b))
-- 
cgit v1.2.3