diff --git a/CHANGELOG.md b/CHANGELOG.md index 4918787..15ea94b 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/Constellation/Enclave/Key.hs b/Constellation/Enclave/Key.hs index 0165d00..4b79b6c 100644 --- a/Constellation/Enclave/Key.hs +++ b/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 diff --git a/Constellation/Enclave/Keygen/Main.hs b/Constellation/Enclave/Keygen/Main.hs index 0e331f9..9200153 100644 --- a/Constellation/Enclave/Keygen/Main.hs +++ b/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 diff --git a/Constellation/Enclave/Types.hs b/Constellation/Enclave/Types.hs index ca7bb47..25b30f2 100644 --- a/Constellation/Enclave/Types.hs +++ b/Constellation/Enclave/Types.hs @@ -7,12 +7,12 @@ 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) @@ -20,7 +20,8 @@ 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 diff --git a/Constellation/Node/Api.hs b/Constellation/Node/Api.hs index 2787bd3..be14a2b 100644 --- a/Constellation/Node/Api.hs +++ b/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 diff --git a/Constellation/Node/Main.hs b/Constellation/Node/Main.hs index d894798..7044d23 100644 --- a/Constellation/Node/Main.hs +++ b/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 diff --git a/Constellation/Node/Storage/BerkeleyDb.hs b/Constellation/Node/Storage/BerkeleyDb.hs index 13d31cd..1577d5f 100644 --- a/Constellation/Node/Storage/BerkeleyDb.hs +++ b/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 diff --git a/Constellation/Node/Storage/Directory.hs b/Constellation/Node/Storage/Directory.hs new file mode 100644 index 0000000..9840b09 --- /dev/null +++ b/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 diff --git a/Constellation/Node/Storage/LevelDb.hs b/Constellation/Node/Storage/LevelDb.hs index a76a027..f822708 100644 --- a/Constellation/Node/Storage/LevelDb.hs +++ b/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 diff --git a/Constellation/Node/Storage/Memory.hs b/Constellation/Node/Storage/Memory.hs index 9a57342..7bdb76d 100644 --- a/Constellation/Node/Storage/Memory.hs +++ b/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 () diff --git a/Constellation/Node/Storage/Sqlite.hs b/Constellation/Node/Storage/Sqlite.hs index 9ee436c..e001402 100644 --- a/Constellation/Node/Storage/Sqlite.hs +++ b/Constellation/Node/Storage/Sqlite.hs @@ -5,25 +5,23 @@ {-# LANGUAGE StrictData #-} module Constellation.Node.Storage.Sqlite where -import ClassyPrelude hiding (fold, hash) +import ClassyPrelude hiding (fold, delete, hash) import Control.Monad (void) import Crypto.Hash (Digest, SHA3_512, hash) import Data.Binary (encode, decode) -import Data.Pool (createPool, withResource) +import Data.ByteArray.Encoding (Base(Base64), convertToBase) +import Data.Pool (createPool, withResource, destroyAllResources) import Database.SQLite.Simple (Connection, Query, Only(..), open, close, execute, execute_, query, fold_) import System.Directory (doesFileExist) import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Base64 as B64 import qualified Data.Text.Encoding as TE import qualified Text.RawString.QQ as QQ import Constellation.Enclave.Payload (EncryptedPayload(EncryptedPayload, eplCt)) import Constellation.Enclave.Types (PublicKey) -import Constellation.Node.Types - (Storage(Storage, savePayload, loadPayload, deletePayload, traverseStorage)) -import Constellation.Util.Memory (byteArrayToByteString) +import Constellation.Node.Types (Storage(..)) createStmts :: [Query] createStmts = @@ -54,12 +52,12 @@ sqliteStorage fpath = do , loadPayload = \k -> withResource p $ \c -> load c k , deletePayload = \k -> withResource p $ \c -> delete c k , traverseStorage = \f -> withResource p $ \c -> trav c f + , closeStorage = destroyAllResources p } save :: Connection -> (EncryptedPayload, [PublicKey]) -> IO (Either String Text) save c x@(EncryptedPayload{..}, _) = do - let dig = TE.decodeUtf8 $ B64.encode $ - byteArrayToByteString (hash eplCt :: Digest SHA3_512) + let dig = TE.decodeUtf8 $ convertToBase Base64 (hash eplCt :: Digest SHA3_512) -- TODO: Error out when the key already exists (collisions) execute c "INSERT INTO payload (payloadKey, payloadBytes) VALUES (?, ?)" @@ -73,8 +71,11 @@ load c k = do (Only k) return $ case rs of [Only b] -> Right $ decode $ BL.fromStrict b - [] -> Left "load: No payload found" - _ -> Left "load: More than one payload found" + -- [] -> Left "load: No payload found" + -- _ -> Left "load: More than one payload found" + -- TODO: In testStorage, don't rely on the presence of the strings below + [] -> Left "Payload not found in SQLite" + _ -> Left "Payload not found in SQLite" delete :: Connection -> Text -> IO () delete c k = void $ diff --git a/Constellation/Util/ByteString.hs b/Constellation/Util/ByteString.hs index 8e1ab69..4972a15 100644 --- a/Constellation/Util/ByteString.hs +++ b/Constellation/Util/ByteString.hs @@ -4,19 +4,19 @@ module Constellation.Util.ByteString where import ClassyPrelude -import qualified Data.ByteString.Base64 as B64 +import Data.ByteArray.Encoding (Base(Base64), convertToBase, convertFromBase) import qualified Data.Text.Encoding as TE import Constellation.Util.Either (fromRight) b64TextEncodeBs :: ByteString -> Text -b64TextEncodeBs = TE.decodeUtf8 . B64.encode +b64TextEncodeBs = TE.decodeUtf8 . convertToBase Base64 b64TextDecodeBs :: Text -> Either String ByteString -b64TextDecodeBs = B64.decode . TE.encodeUtf8 +b64TextDecodeBs = convertFromBase Base64 . TE.encodeUtf8 mustB64TextDecodeBs :: Text -> ByteString mustB64TextDecodeBs = fromRight . b64TextDecodeBs mustB64DecodeBs :: ByteString -> ByteString -mustB64DecodeBs = fromRight . B64.decode +mustB64DecodeBs = fromRight . convertFromBase Base64 diff --git a/Constellation/Util/Memory.hs b/Constellation/Util/Memory.hs deleted file mode 100644 index eaae518..0000000 --- a/Constellation/Util/Memory.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StrictData #-} -module Constellation.Util.Memory where - -import ClassyPrelude - -import qualified Data.ByteArray as BA -import qualified Data.ByteString as B - --- | WARNING: This function is unsafe when used on any kind of Master Key, --- Private Key, etc. as the bytes will be copied all over memory. --- Appropriate/typical use is to convert a hash digest from cryptonite --- to a ByteString. -byteArrayToByteString :: BA.ByteArrayAccess a => a -> ByteString -byteArrayToByteString = B.pack . BA.unpack diff --git a/constellation.cabal b/constellation.cabal index db4d3f5..bd8bddb 100644 --- a/constellation.cabal +++ b/constellation.cabal @@ -27,6 +27,7 @@ library Constellation.Node.Config Constellation.Node.Main Constellation.Node.Storage.BerkeleyDb + Constellation.Node.Storage.Directory -- Constellation.Node.Storage.LevelDb Constellation.Node.Storage.Memory -- Constellation.Node.Storage.Sqlite @@ -37,7 +38,6 @@ library Constellation.Util.Exception Constellation.Util.Lockable Constellation.Util.Logging - Constellation.Util.Memory Constellation.Util.Network Constellation.Util.String Constellation.Util.Text @@ -47,7 +47,6 @@ library , aeson >= 0.11 , async >= 2.1 , auto-update >= 0.1.4 - , base64-bytestring >= 1.0.0.1 , BerkeleyDB >= 0.8.7 , binary >= 0.8.3 , byteable >= 0.1.1 @@ -101,6 +100,7 @@ test-suite constellation-test Constellation.Node.Main.Test Constellation.Node.Storage.BerkeleyDb.Test -- Constellation.Node.Storage.LevelDb.Test + Constellation.Node.Storage.Directory.Test Constellation.Node.Storage.Memory.Test -- Constellation.Node.Storage.Sqlite.Test Constellation.Node.Storage.TestUtil @@ -112,7 +112,6 @@ test-suite constellation-test Constellation.Util.Exception.Test Constellation.Util.Lockable.Test Constellation.Util.Logging.Test - Constellation.Util.Memory.Test Constellation.Util.Network.Test Constellation.Util.String.Test Constellation.Util.Text.Test diff --git a/test/Constellation/Node/Storage/Directory/Test.hs b/test/Constellation/Node/Storage/Directory/Test.hs new file mode 100644 index 0000000..dc51145 --- /dev/null +++ b/test/Constellation/Node/Storage/Directory/Test.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StrictData #-} +module Constellation.Node.Storage.Directory.Test where + +import ClassyPrelude +import System.IO.Temp (withSystemTempDirectory) +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCaseSteps) + +import Constellation.Node.Storage.Directory (directoryStorage) +import Constellation.Node.Storage.TestUtil (testStorage) + +tests :: TestTree +tests = testGroup "Node.Storage.Directory" + [ testDirectory + ] + +testDirectory :: TestTree +testDirectory = testCaseSteps "storage" $ \step -> + withSystemTempDirectory "constellation-test-storage-directory-XXX" $ \tempDir -> do + step "Setting up directory instance" + storage <- directoryStorage tempDir + testStorage storage "testDirectory" step diff --git a/test/Constellation/Node/Storage/LevelDb/Test.hs b/test/Constellation/Node/Storage/LevelDb/Test.hs index 155321c..e133904 100644 --- a/test/Constellation/Node/Storage/LevelDb/Test.hs +++ b/test/Constellation/Node/Storage/LevelDb/Test.hs @@ -1,8 +1,21 @@ {-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE StrictData #-} module Constellation.Node.Storage.LevelDb.Test where import ClassyPrelude import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCaseSteps) + +import Constellation.Node.Storage.LevelDb (levelDbStorage) +import Constellation.Node.Storage.TestUtil (testStorage) tests :: TestTree -tests = testGroup "Node.Storage.LevelDb" [] +tests = testGroup "Node.Storage.LevelDb" + [ testLevelDb + ] + +testLevelDb :: TestTree +testLevelDb = testCaseSteps "storage" $ \step -> do + step "Setting up LevelDb instance" + storage <- levelDbStorage "constellation-test-leveldb" + testStorage storage "testLevelDb" step diff --git a/test/Constellation/Node/Storage/Sqlite/Test.hs b/test/Constellation/Node/Storage/Sqlite/Test.hs index 13d33dd..4611781 100644 --- a/test/Constellation/Node/Storage/Sqlite/Test.hs +++ b/test/Constellation/Node/Storage/Sqlite/Test.hs @@ -2,7 +2,20 @@ {-# LANGUAGE StrictData #-} module Constellation.Node.Storage.Sqlite.Test where +import ClassyPrelude import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (testCaseSteps) + +import Constellation.Node.Storage.Sqlite (sqliteStorage) +import Constellation.Node.Storage.TestUtil (testStorage) tests :: TestTree -tests = testGroup "Node.Storage.Sqlite" [] +tests = testGroup "Node.Storage.Sqlite" + [ testSqlite + ] + +testSqlite :: TestTree +testSqlite = testCaseSteps "storage" $ \step -> do + step "Setting up sqlite instance" + storage <- sqliteStorage "constellation-test-sqlite" + testStorage storage "testSqlite" step diff --git a/test/Constellation/Node/Storage/TestUtil.hs b/test/Constellation/Node/Storage/TestUtil.hs index e19d7e6..f43ee7a 100644 --- a/test/Constellation/Node/Storage/TestUtil.hs +++ b/test/Constellation/Node/Storage/TestUtil.hs @@ -14,32 +14,28 @@ import Constellation.Node.Types (Storage(loadPayload, savePayload, deletePayload testStorage :: Storage -> String -> ((String -> IO ()) -> Assertion) testStorage storage testName = \step -> do - step "Saving payload" - (pub1, boxPriv1) <- newKeyPair - (pub2, _) <- newKeyPair - let boxPub1 = unPublicKey pub1 - let boxPub2 = unPublicKey pub2 - epl <- encrypt (BC.pack "payload") boxPub1 boxPriv1 [boxPub2] - let kv = (epl, [pub2]) - ek <- savePayload storage kv - key <- case ek of - Left err -> error $ testName ++ ": Saving of payload failed: " ++ err - Right key -> return key - - step "Retrieving payload" - ret <- loadPayload storage key - case ret of - Left err -> error $ testName ++ ": Retrieval of payload failed: " ++ err - Right r -> r @?= kv - - step "Deleting payload" - _ <- deletePayload storage key - - step "Verify deletion" - ver <- loadPayload storage key - case ver of - Left err -> "Key not found in " `isInfixOf` err @? testName ++ ": Key still present" - Right _ -> error $ testName ++ ": Deletion of payload failed" - - step "Cleaning up" - closeStorage storage + step "Saving payload" + (pub1, boxPriv1) <- newKeyPair + (pub2, _) <- newKeyPair + let boxPub1 = unPublicKey pub1 + boxPub2 = unPublicKey pub2 + epl <- encrypt (BC.pack "payload") boxPub1 boxPriv1 [boxPub2] + let kv = (epl, [pub2]) + ek <- savePayload storage kv + key <- case ek of + Left err -> error $ testName ++ ": Saving of payload failed: " ++ err + Right key -> return key + step "Retrieving payload" + ret <- loadPayload storage key + case ret of + Left err -> error $ testName ++ ": Retrieval of payload failed: " ++ err + Right r -> r @?= kv + step "Deleting payload" + _ <- deletePayload storage key + step "Verify deletion" + ver <- loadPayload storage key + case ver of + Left err -> "Payload not found in " `isInfixOf` err @? testName ++ ": Key still present" + Right _ -> error $ testName ++ ": Deletion of payload failed" + step "Cleaning up" + closeStorage storage diff --git a/test/Constellation/Util/Memory/Test.hs b/test/Constellation/Util/Memory/Test.hs deleted file mode 100644 index ab60ef7..0000000 --- a/test/Constellation/Util/Memory/Test.hs +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE StrictData #-} -module Constellation.Util.Memory.Test where - -import ClassyPrelude hiding (assert) -import Test.Tasty (TestTree, testGroup) -import Test.Tasty.QuickCheck (testProperty) -import qualified Data.ByteArray as BA -import qualified Data.ByteString as B - -import Constellation.Util.Memory (byteArrayToByteString) - -tests :: TestTree -tests = testGroup "Util.Memory" - [ testByteArrayToByteString - ] - -testByteArrayToByteString :: TestTree -testByteArrayToByteString = testProperty "byteArrayToByteString" $ \ws -> - B.unpack (byteArrayToByteString (BA.pack ws :: BA.Bytes)) == ws diff --git a/test/Main.hs b/test/Main.hs index fb678a4..cee69b5 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -19,16 +19,16 @@ import qualified Constellation.Node.Api.Test as NodeApi import qualified Constellation.Node.Config.Test as NodeConfig import qualified Constellation.Node.Main.Test as NodeMain import qualified Constellation.Node.Storage.BerkeleyDb.Test as NodeStorageBerkeley +import qualified Constellation.Node.Storage.Directory.Test as NodeStorageDirectory -- import qualified Constellation.Node.Storage.LevelDb.Test as NodeStorageLevelDb import qualified Constellation.Node.Storage.Memory.Test as NodeStorageMemory -import qualified Constellation.Node.Storage.Sqlite.Test as NodeStorageSqlite +-- import qualified Constellation.Node.Storage.Sqlite.Test as NodeStorageSqlite import qualified Constellation.Node.Types.Test as NodeTypes import qualified Constellation.Util.AtExit.Test as UtilAtExit import qualified Constellation.Util.ByteString.Test as UtilByteString import qualified Constellation.Util.Either.Test as UtilEither import qualified Constellation.Util.Exception.Test as UtilException import qualified Constellation.Util.Lockable.Test as UtilLockable -import qualified Constellation.Util.Memory.Test as UtilMemory import qualified Constellation.Util.Network.Test as UtilNetwork import qualified Constellation.Util.String.Test as UtilString import qualified Constellation.Util.Text.Test as UtilText @@ -45,16 +45,16 @@ tests = testGroup "" , NodeConfig.tests , NodeMain.tests , NodeStorageBerkeley.tests + , NodeStorageDirectory.tests -- , NodeStorageLevelDb.tests , NodeStorageMemory.tests - , NodeStorageSqlite.tests + -- , NodeStorageSqlite.tests , NodeTypes.tests , UtilAtExit.tests , UtilByteString.tests , UtilEither.tests , UtilException.tests , UtilLockable.tests - , UtilMemory.tests , UtilNetwork.tests , UtilString.tests , UtilText.tests