Directory storage engine; Switch to cryptonite base conversion functions

CHANGELOG.md

@@ -5,6 +5,27 @@ All major changes to Constellation will be recorded here.
 The format is based on [Keep a Changelog](http://keepachangelog.com/)
 and this project adheres to [Semantic Versioning](http://semver.org/).
 
+## [Unreleased]
+### Added
+- A `dir` storage engine which stores payloads as individual files in
+  a folder, suitable for use with FUSE connectors. (Note that, if used
+  with Quorum and a distributed file system, it should have strong
+  read-after-create consistency to avoid unexpected behavior. In other
+  words, after a file is created, other nodes should immediately be
+  able to read it.)
+
+  The `dir` storage engine uses Base32-encoded filenames to ensure
+  compatibility with most file systems.
+
+- Ability to choose a storage engine in configs and on the command
+  line:
+    - `--storage=dir:path`: `dir` storage engine using the `path`
+      folder.
+    - `--storage=bdb:path`: `bdb` storage engine using the `path`
+      folder.
+    - `--storage=path`: Default storage engine (`bdb`) using the
+      `path` folder.
+
 ## [0.1.0] - 2017-06-06
 
 This release includes changes to the configuration file

Constellation/Enclave/Key.hs

@@ -8,10 +8,10 @@ module Constellation.Enclave.Key where
 import Prelude (putStrLn)
 import ClassyPrelude hiding (hash, putStrLn)
 import Control.Monad.Trans.Either (EitherT(EitherT), runEitherT)
+import Data.ByteArray.Encoding (Base(Base64), convertToBase)
 import qualified Crypto.Saltine.Class as S
 import qualified Crypto.Saltine.Core.Box as Box
 import qualified Data.Aeson as AE
-import qualified Data.ByteString.Base64.Lazy as B64L
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 
@@ -27,8 +27,8 @@ newKeyPair = do
     (priv, pub) <- Box.newKeypair
     return (PublicKey pub, priv)
 
-b64EncodePublicKey :: PublicKey -> BL.ByteString
-b64EncodePublicKey = B64L.encode . BL.fromStrict . S.encode . unPublicKey
+b64EncodePublicKey :: PublicKey -> ByteString
+b64EncodePublicKey = convertToBase Base64 . S.encode . unPublicKey
 
 -- | Optionally takes a password to lock the private key.
 jsonEncodePrivateKey :: Maybe String -> Box.SecretKey -> IO BL.ByteString

Constellation/Enclave/Keygen/Main.hs

@@ -8,6 +8,7 @@ import ClassyPrelude hiding (getArgs, writeFile)
 import System.Console.Haskeline (runInputT, defaultSettings, getPassword)
 import System.Environment (getArgs, getProgName)
 import Text.Printf (printf)
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 
 import Constellation.Enclave.Key
@@ -24,7 +25,7 @@ generateKeyPair name = do
     mpwd <- runInputT defaultSettings $
         getPassword (Just '*') (printf "Lock key pair %s with password [none]: " name)
     (pub, priv) <- newKeyPair
-    BL.writeFile (name ++ ".pub") $ b64EncodePublicKey pub
+    B.writeFile (name ++ ".pub") $ b64EncodePublicKey pub
     json <- jsonEncodePrivateKey mpwd priv
     BL.writeFile (name ++ ".key") json
 

Constellation/Enclave/Types.hs

@@ -7,20 +7,21 @@ module Constellation.Enclave.Types where
 import ClassyPrelude
 import Data.Aeson (FromJSON(parseJSON))
 import Data.Binary (Binary(put, get))
+import Data.ByteArray.Encoding (Base(Base64), convertToBase)
 import Data.Hashable (Hashable(hashWithSalt))
 import Data.Maybe (fromJust)
 import qualified Crypto.Saltine.Class as S
 import qualified Crypto.Saltine.Core.Box as Box
 import qualified Data.Aeson as AE
-import qualified Data.ByteString.Base64 as B64
 
 import Constellation.Util.ByteString (b64TextDecodeBs)
 
 newtype PublicKey = PublicKey { unPublicKey :: Box.PublicKey }
                   deriving (Eq)
 
 instance Show PublicKey where
-    show (PublicKey pub) = show $ B64.encode $ S.encode pub
+    show (PublicKey pub) =
+        show (convertToBase Base64 (S.encode pub) :: ByteString)
 
 instance Binary PublicKey where
     put = put . S.encode . unPublicKey

Constellation/Node/Api.hs

@@ -9,6 +9,7 @@ import Control.Monad (void)
 import Data.Aeson
     (FromJSON(parseJSON), ToJSON(toJSON), Value(Object), (.:), (.=), object)
 import Data.Binary (encode, decodeOrFail)
+import Data.ByteArray.Encoding (Base(Base64), convertToBase)
 import Data.HashMap.Strict ((!))
 import Data.IP (IP(IPv4, IPv6), toHostAddress, toHostAddress6)
 import Data.Maybe (fromJust)
@@ -20,7 +21,6 @@ import Network.Socket
     (SockAddr(SockAddrInet, SockAddrInet6), HostAddress, HostAddress6)
 import Text.Read (read)
 import qualified Data.Aeson as AE
-import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.HashMap.Strict as HM
@@ -76,7 +76,7 @@ data ReceiveResponse = ReceiveResponse
 
 instance ToJSON ReceiveResponse where
     toJSON ReceiveResponse{..} = object
-        [ "payload" .= TE.decodeUtf8 (B64.encode rresPayload)
+        [ "payload" .= TE.decodeUtf8 (convertToBase Base64 rresPayload)
         ]
 
 data Delete = Delete

Constellation/Node/Main.hs

@@ -27,6 +27,7 @@ import Constellation.Enclave.Key (mustLoadKeyPairs, mustLoadPublicKeys)
 import Constellation.Enclave.Keygen.Main (generateKeyPair)
 import Constellation.Node (newNode, runNode)
 import Constellation.Node.Storage.BerkeleyDb (berkeleyDbStorage)
+import Constellation.Node.Storage.Directory (directoryStorage)
 -- import Constellation.Node.Storage.Memory (memoryStorage)
 import Constellation.Node.Types
     ( Node(nodeStorage)
@@ -86,7 +87,10 @@ run cfg@Config{..} = do
             }
     ast <- mustLoadPublicKeys cfgAlwaysSendTo
     logf' "Initializing storage {}" [cfgStorage]
-    storage <- berkeleyDbStorage cfgStorage
+    storage <- case break (== ':') cfgStorage of
+        ("bdb", ':':s) -> berkeleyDbStorage s
+        ("dir", ':':s) -> directoryStorage s
+        _              -> berkeleyDbStorage cfgStorage  -- Default
     -- storage <- memoryStorage
     nvar    <- newTVarIO =<<
         newNode crypt storage cfgUrl (map fst ks) ast cfgOtherNodes

Constellation/Node/Storage/BerkeleyDb.hs

@@ -8,9 +8,9 @@ import ClassyPrelude hiding (delete, hash)
 import Control.Logging (warn, warnS)
 import Crypto.Hash (Digest, SHA3_512, hash)
 import Data.Binary (encode, decode)
+import Data.ByteArray.Encoding (Base(Base64), convertToBase)
 import Database.Berkeley.Db
 import System.Directory (createDirectoryIfMissing)
-import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
@@ -21,7 +21,6 @@ import Constellation.Enclave.Types (PublicKey)
 import Constellation.Node.Types
     (Storage(Storage, savePayload, loadPayload, deletePayload,
              traverseStorage, closeStorage))
-import Constellation.Util.Memory (byteArrayToByteString)
 
 berkeleyDbStorage :: FilePath -> IO Storage
 berkeleyDbStorage fpath = do
@@ -108,7 +107,7 @@ save db mtx x@(EncryptedPayload{..}, _) =
     db_put [] db mtx dig (BL.toStrict $ encode x) >>
     return (Right $ TE.decodeUtf8 dig)
   where
-    dig = B64.encode $ byteArrayToByteString (hash eplCt :: Digest SHA3_512)
+    dig = convertToBase Base64 (hash eplCt :: Digest SHA3_512) :: ByteString
 
 load :: Db
      -> Maybe DbTxn
@@ -117,7 +116,7 @@ load :: Db
 load db mtx k = do
     mv <- db_get [DB_READ_UNCOMMITTED] db mtx (TE.encodeUtf8 k)
     return $ case mv of
-        Nothing -> Left "Key not found in BerkeleyDb payload.db"
+        Nothing -> Left "Payload not found in BerkeleyDb payload.db"
         Just v  -> Right $ decode $ BL.fromStrict v
 
 delete :: Db

Constellation/Node/Storage/Directory.hs

@@ -0,0 +1,83 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StrictData #-}
+module Constellation.Node.Storage.Directory where
+
+import ClassyPrelude hiding (delete, hash)
+import Crypto.Hash (Digest, SHA3_512, hash)
+import Data.Binary (encode, decode)
+import Data.ByteArray.Encoding
+    (Base(Base32, Base64), convertToBase, convertFromBase)
+import System.Directory (createDirectoryIfMissing, removeFile, listDirectory)
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text.Encoding as TE
+
+import Constellation.Enclave.Payload
+    (EncryptedPayload(EncryptedPayload, eplCt))
+import Constellation.Enclave.Types (PublicKey)
+import Constellation.Node.Types
+    (Storage(Storage, savePayload, loadPayload, deletePayload,
+             traverseStorage, closeStorage))
+import Constellation.Util.Exception (trys)
+import Constellation.Util.Logging (warnf)
+
+directoryStorage :: FilePath -> IO Storage
+directoryStorage dir = do
+    createDirectoryIfMissing True (dir </> "payloads")
+    return Storage
+        { savePayload     = save dir
+        , loadPayload     = load dir
+        , deletePayload   = delete dir
+        , traverseStorage = trav dir
+        , closeStorage    = return ()
+        }
+
+save :: FilePath -> (EncryptedPayload, [PublicKey]) -> IO (Either String Text)
+save dir x@(EncryptedPayload{..}, _) = trys $ do
+    let fname = BC.unpack $ convertToBase Base32 dig
+        k     = TE.decodeUtf8 $ convertToBase Base64 dig
+    -- TODO: Error out when the key already exists (collisions)
+    BL.writeFile (dir </> "payloads" </> fname) (encode x)
+    return k
+  where
+    dig = hash eplCt :: Digest SHA3_512
+
+load :: FilePath -> Text -> IO (Either String (EncryptedPayload, [PublicKey]))
+load dir k = case convertFromBase Base64 $ TE.encodeUtf8 k of
+    Left err  -> return $ Left err
+    Right dig -> load' dir (BC.unpack $ convertToBase Base32 (dig :: ByteString))
+
+load' :: FilePath
+      -> FilePath
+      -> IO (Either String (EncryptedPayload, [PublicKey]))
+load' dir fname = do
+    ex <- trys $ decode <$> BL.readFile (dir </> "payloads" </> fname)
+    return $ case ex of
+        Left err -> Left $ "Payload not found in directory " ++ dir ++ ": " ++ err
+        Right x  -> Right x
+
+delete :: FilePath -> Text -> IO ()
+delete dir k = case convertFromBase Base64 $ TE.encodeUtf8 k of
+    Left err  -> warnf "Invalid/non-Base64 key '{}' given to delete: {}" (k, err)
+    Right dig -> do
+        let fname = BC.unpack (convertToBase Base32 (dig :: ByteString))
+        removeFile (dir </> "payloads" </> fname)
+
+trav :: FilePath -> (Text -> (EncryptedPayload, [PublicKey]) -> IO Bool) -> IO ()
+trav dir f = listDirectory dir >>= loop
+  where
+    loop []         = return ()
+    loop (fname:xs) = case convertFromBase Base32 (BC.pack fname) of
+        Left err  -> do
+            warnf "Invalid/non-Base32 file '{}': {}" (fname, err)
+            loop xs
+        Right dig -> do
+            let k = TE.decodeUtf8 $ convertToBase Base64 (dig :: ByteString)
+            load' dir fname >>= \case
+                Left err -> do
+                    warnf "Failed to load payload {} during directory traversal: {}" (k, err)
+                    loop xs
+                Right x  -> f k x >>= \cont -> when cont $ loop xs

Constellation/Node/Storage/LevelDb.hs

@@ -4,12 +4,12 @@
 {-# LANGUAGE StrictData #-}
 module Constellation.Node.Storage.LevelDb where
 
-import ClassyPrelude hiding (hash)
+import ClassyPrelude hiding (delete, hash)
 import Control.Monad.Fix (fix)
 import Crypto.Hash (Digest, SHA3_512, hash)
 import Data.Binary (encode, decode)
+import Data.ByteArray.Encoding (Base(Base64), convertToBase)
 import Data.Default (def)
-import qualified Data.ByteString.Base64 as B64
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text.Encoding as TE
 import qualified Database.LevelDB.Base as L
@@ -18,9 +18,7 @@ import qualified Database.LevelDB.Internal as LI
 import Constellation.Enclave.Payload
     (EncryptedPayload(EncryptedPayload, eplCt))
 import Constellation.Enclave.Types (PublicKey)
-import Constellation.Node.Types
-    (Storage(Storage, savePayload, loadPayload, traverseStorage, closeStorage))
-import Constellation.Util.Memory (byteArrayToByteString)
+import Constellation.Node.Types (Storage(..))
 
 levelDbStorage :: FilePath -> IO Storage
 levelDbStorage fpath = do
@@ -30,6 +28,7 @@ levelDbStorage fpath = do
     return Storage
         { savePayload     = save db
         , loadPayload     = load db
+        , deletePayload   = delete db
         , traverseStorage = trav db
         , closeStorage    = LI.unsafeClose db
         }
@@ -40,13 +39,16 @@ save db x@(EncryptedPayload{..}, _) =
     L.put db def dig (BL.toStrict $ encode x) >>
     return (Right $ TE.decodeUtf8 dig)
   where
-    dig = B64.encode $ byteArrayToByteString (hash eplCt :: Digest SHA3_512)
+    dig = convertToBase Base64 (hash eplCt :: Digest SHA3_512)
 
 load :: L.DB -> Text -> IO (Either String (EncryptedPayload, [PublicKey]))
 load db = L.get db def . TE.encodeUtf8 >=> \mv -> return $ case mv of
-    Nothing -> Left "Key not found in LevelDB"
+    Nothing -> Left "Payload not found in LevelDB"
     Just v  -> Right $ decode $ BL.fromStrict v
 
+delete :: L.DB -> Text -> IO ()
+delete db = L.delete db def . TE.encodeUtf8
+
 trav :: L.DB -> (Text -> (EncryptedPayload, [PublicKey]) -> IO Bool) -> IO ()
 trav db f = L.withIter db def $ \it -> fix $ \loop -> do
     mk <- L.iterKey it

Constellation/Node/Storage/Memory.hs

@@ -6,7 +6,7 @@ module Constellation.Node.Storage.Memory where
 
 import ClassyPrelude hiding (delete, hash)
 import Crypto.Hash (Digest, SHA3_512, hash)
-import qualified Data.ByteString.Base64 as B64
+import Data.ByteArray.Encoding (Base(Base64), convertToBase)
 import qualified Data.HashMap.Strict as HM
 import qualified Data.Text.Encoding as TE
 
@@ -16,7 +16,6 @@ import Constellation.Enclave.Types (PublicKey)
 import Constellation.Node.Types
     (Storage(Storage, savePayload, loadPayload, deletePayload,
              traverseStorage, closeStorage))
-import Constellation.Util.Memory (byteArrayToByteString)
 
 type Db = TVar (HM.HashMap Text (EncryptedPayload, [PublicKey]))
 
@@ -36,14 +35,13 @@ save mvar x@(EncryptedPayload{..}, _) = atomically $
     -- TODO: Error out when the key already exists (collisions)
     modifyTVar mvar (HM.insert dig x) >> return (Right dig)
   where
-    dig = TE.decodeUtf8 $ B64.encode $
-        byteArrayToByteString (hash eplCt :: Digest SHA3_512)
+    dig = TE.decodeUtf8 $ convertToBase Base64 (hash eplCt :: Digest SHA3_512)
 
 load :: Db -> Text -> IO (Either String (EncryptedPayload, [PublicKey]))
 load mvar k = atomically $ do
     m <- readTVar mvar
     return $ case HM.lookup k m of
-        Nothing -> Left "Key not found in memory database"
+        Nothing -> Left "Payload not found in memory database"
         Just v  -> Right v
 
 delete :: Db -> Text -> IO ()