diff options
| -rw-r--r-- | Storage.hs | 17 | ||||
| -rw-r--r-- | Storage/LocalFiles.hs | 62 | ||||
| -rw-r--r-- | Types.hs | 4 | ||||
| -rw-r--r-- | keysafe.cabal | 2 | ||||
| -rw-r--r-- | keysafe.hs | 29 |
5 files changed, 89 insertions, 25 deletions
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" @@ -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 @@ -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)) |