From 87e83462bc010e7da3fb01e9dbd3183825988edf Mon Sep 17 00:00:00 2001 From: Rodney Lorrimar Date: Tue, 4 Jun 2019 16:39:23 +1000 Subject: [PATCH] wip: Rebase and clean up tests --- lib/core/src/Cardano/Wallet/DB/Sqlite.hs | 11 ++- .../Cardano/Wallet/DB/SqliteCorruptionSpec.hs | 73 +++++++++++++------ .../test/unit/Cardano/Wallet/DB/SqliteSpec.hs | 4 +- 3 files changed, 62 insertions(+), 26 deletions(-) diff --git a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs index bb8bf6f3cc3..aa9b9cbc61e 100644 --- a/lib/core/src/Cardano/Wallet/DB/Sqlite.hs +++ b/lib/core/src/Cardano/Wallet/DB/Sqlite.hs @@ -15,6 +15,7 @@ module Cardano.Wallet.DB.Sqlite ( newDBLayer + , newDBLayer' , DummyState(..) ) where @@ -180,8 +181,16 @@ newDBLayer :: forall s t. (W.IsOurs s, NFData s, Show s, PersistState s, W.TxId t) => Maybe FilePath -- ^ Database file location, or Nothing for in-memory database + -> IO (DBLayer IO s t) +newDBLayer = fmap snd . newDBLayer' + +-- | Variant of 'newDBLayer' that also returns a handle to the database +-- connection. +newDBLayer' + :: forall s t. (W.IsOurs s, NFData s, Show s, PersistState s, W.TxId t) + => Maybe FilePath -> IO (Sqlite.Connection, DBLayer IO s t) -newDBLayer fp = do +newDBLayer' fp = do lock <- newMVar () bigLock <- newMVar () (conn, backend) <- createSqliteBackend fp (dbLogs [LevelError]) diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteCorruptionSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteCorruptionSpec.hs index 9a8ef181a55..8e5a5f74d2b 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteCorruptionSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/SqliteCorruptionSpec.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -16,7 +17,7 @@ import Cardano.Wallet import Cardano.Wallet.DB ( DBLayer (..), ErrWalletAlreadyExists (..), PrimaryKey (..) ) import Cardano.Wallet.DB.Sqlite - ( newDBLayer ) + ( newDBLayer, newDBLayer' ) import Cardano.Wallet.DBSpec ( DummyTarget, KeyValPairs (..), cleanDB, withDB ) import Cardano.Wallet.Primitive.AddressDerivation @@ -50,7 +51,7 @@ import Cardano.Wallet.Primitive.Types , WalletState (..) ) import Control.Monad - ( forM_ ) + ( forM_, replicateM_ ) import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Except @@ -61,6 +62,8 @@ import Data.ByteString ( ByteString ) import Data.Coerce ( coerce ) +import Data.Functor + ( ($>) ) import Data.Quantity ( Quantity (..) ) import Data.Text.Class @@ -69,10 +72,22 @@ import Data.Time.Clock ( getCurrentTime ) import Database.Sqlite ( Connection, close ) +import System.Directory + ( doesFileExist, removeFile ) +import System.IO.Temp + ( emptySystemTempFile ) import System.IO.Unsafe ( unsafePerformIO ) import Test.Hspec - ( Expectation, Spec, before, describe, it, shouldReturn ) + ( Expectation + , Spec + , SpecWith + , beforeAll + , beforeWith + , describe + , it + , shouldReturn + ) import Test.QuickCheck ( Property, choose, generate, property, (==>) ) import Test.QuickCheck.Monadic @@ -83,20 +98,18 @@ import qualified Data.Map.Strict as Map import qualified Data.Set as Set spec :: Spec -spec = do - describe "Check db opening/closing" $ do - it "opening and closing of db works" $ do - (conn, db) <- fileDBLayer - _ <- cleanDB db +spec = do + withFileDBLayer $ describe "Check db opening/closing" $ do + it "opening and closing of db works" $ \(conn, db) -> do + cleanDB db unsafeRunExceptT $ createWallet db testPk testCp testMetadata listWallets db `shouldReturn` [testPk] close conn - forM_ [1..25] openCloseDB + replicateM_ 25 openCloseDB - before ((snd <$> fileDBLayer) >>= cleanDB) $ - describe "Check db reading/writing from/to file and cleaning" $ do + withFileDBLayer $ describe "Check db reading/writing from/to file and cleaning" $ do - it "create and list wallet works" $ \db -> do + it "create and list wallet works" $ \(conn, db) -> do unsafeRunExceptT $ createWallet db testPk testCp testMetadata listWallets db `shouldReturn` [testPk] (_, db1) <- fileDBLayer @@ -107,7 +120,7 @@ spec = do [testPk] [] ) - it "create and get meta works" $ \db -> do + it "create and get meta works" $ \(_, db) -> do now <- getCurrentTime let md = testMetadata { passphraseInfo = Just $ WalletPassphraseInfo now } unsafeRunExceptT $ createWallet db testPk testCp md @@ -117,7 +130,7 @@ spec = do (Just md) Nothing ) - it "create and get private key" $ \db -> do + it "create and get private key" $ \(_, db) -> do unsafeRunExceptT $ createWallet db testPk testCp testMetadata readPrivateKey db testPk `shouldReturn` Nothing let Right phr = fromText "simplephrase" @@ -130,7 +143,7 @@ spec = do (Just (k, h)) Nothing ) - it "put and read tx history" $ \db -> do + it "put and read tx history" $ \(_, db) -> do unsafeRunExceptT $ createWallet db testPk testCp testMetadata runExceptT (putTxHistory db testPk testTxs) `shouldReturn` Right () readTxHistory db testPk `shouldReturn` testTxs @@ -139,7 +152,7 @@ spec = do testTxs Map.empty ) - it "put and read checkpoint" $ \db -> do + it "put and read checkpoint" $ \(_, db) -> do unsafeRunExceptT $ createWallet db testPk testCp testMetadata runExceptT (putCheckpoint db testPk testCp) `shouldReturn` Right () readCheckpoint db testPk `shouldReturn` Just testCp @@ -168,8 +181,8 @@ spec = do (_,db2) <- fileDBLayer call db2 `shouldReturn` expectedAfterClean - openCloseDB :: Int -> IO () - openCloseDB _ = do + openCloseDB :: IO () + openCloseDB = do (conn, db) <- fileDBLayer listWallets db `shouldReturn` [testPk] close conn @@ -230,14 +243,30 @@ prop_randomOpChunks inMemoryDB (KeyValPairs pairs) = readWalletMeta db2 walId `shouldReturn` expectedMetas +withFileDBLayer + :: SpecWith (Connection, DBLayer IO (SeqState DummyTarget) DummyTarget) + -> Spec +withFileDBLayer = beforeAll fileDBLayer' . beforeWith clean + where clean (f, (conn, db)) = cleanDB db $> (conn, db) fileDBLayer :: IO (Connection, DBLayer IO (SeqState DummyTarget) DummyTarget) -fileDBLayer = newDBLayer (Just "backup/test.db") +fileDBLayer = snd <$> fileDBLayer' + +fileDBLayer' :: IO (FilePath, (Connection, DBLayer IO (SeqState DummyTarget) DummyTarget)) +fileDBLayer' = do + f <- emptySystemTempFile "bench.db" + db <- newDBLayer' (Just f) + pure (f, db) + +removeDB :: FilePath -> IO () +removeDB f = mapM_ remove [f, f <> "-shm", f <> "-wal"] + where + remove f = doesFileExist f >>= \case + True -> removeFile f + False -> pure () inMemoryDBLayer :: IO (DBLayer IO (SeqState DummyTarget) DummyTarget) -inMemoryDBLayer = do - (_, db) <- newDBLayer Nothing - pure db +inMemoryDBLayer = newDBLayer Nothing testCp :: Wallet (SeqState DummyTarget) DummyTarget testCp = initWallet initDummyState diff --git a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs index 37d4474e469..9dd02840591 100644 --- a/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs +++ b/lib/core/test/unit/Cardano/Wallet/DB/SqliteSpec.hs @@ -125,9 +125,7 @@ simpleSpec = do readCheckpoint db testPk `shouldReturn` Just testCp newMemoryDBLayer :: IO (DBLayer IO (SeqState DummyTarget) DummyTarget) -newMemoryDBLayer = do - (_, db) <- newDBLayer Nothing - pure db +newMemoryDBLayer = newDBLayer Nothing testCp :: Wallet (SeqState DummyTarget) DummyTarget testCp = initWallet initDummyState