add basic property tests for checking new pool db functions.

lib/core/src/Cardano/Pool/DB.hs

@@ -128,7 +128,7 @@ data DBLayer m = forall stm. (MonadFail stm, MonadIO stm) => DBLayer
         -> stm ()
         -- ^ Remove pool metadata references from the database.
 
-    , peekPoolMetadataRef
+    , readPoolMetadataRef
         :: Int
         -> stm [(PoolId, StakePoolMetadataRef)]
         -- ^ Peek at some pool metadata ref. Returns at most 'n' elements, where

lib/core/src/Cardano/Pool/DB/MVar.hs

@@ -26,12 +26,12 @@ import Cardano.Pool.DB.Model
     , mCleanPoolProduction
     , mDeletePoolMetadataRef
     , mListRegisteredPools
-    , mPeekPoolMetadataRef
     , mPutPoolMetadataRef
     , mPutPoolProduction
     , mPutPoolRegistration
     , mPutStakeDistribution
     , mReadCursor
+    , mReadPoolMetadataRef
     , mReadPoolProduction
     , mReadPoolRegistration
     , mReadStakeDistribution
@@ -93,8 +93,8 @@ newDBLayer = do
         , deletePoolMetadataRef =
             void . alterPoolDB (const Nothing) db . mDeletePoolMetadataRef
 
-        , peekPoolMetadataRef = \a0 ->
-            modifyMVar db (pure . swap . mPeekPoolMetadataRef a0)
+        , readPoolMetadataRef = \a0 ->
+            modifyMVar db (pure . swap . mReadPoolMetadataRef a0)
 
         , readSystemSeed =
             modifyMVar db (fmap swap . mReadSystemSeed)

lib/core/src/Cardano/Pool/DB/Model.hs

@@ -43,7 +43,7 @@ module Cardano.Pool.DB.Model
     , mListRegisteredPools
     , mPutPoolMetadataRef
     , mDeletePoolMetadataRef
-    , mPeekPoolMetadataRef
+    , mReadPoolMetadataRef
     , mReadSystemSeed
     , mRollbackTo
     , mReadCursor
@@ -225,8 +225,8 @@ mDeletePoolMetadataRef pid db@PoolDatabase{metadataRef} =
     , db { metadataRef = filter ((/= pid) . fst) metadataRef }
     )
 
-mPeekPoolMetadataRef :: Int -> PoolDatabase -> ([(PoolId, StakePoolMetadataRef)], PoolDatabase)
-mPeekPoolMetadataRef n db@PoolDatabase{metadataRef} =
+mReadPoolMetadataRef :: Int -> PoolDatabase -> ([(PoolId, StakePoolMetadataRef)], PoolDatabase)
+mReadPoolMetadataRef n db@PoolDatabase{metadataRef} =
     ( take n metadataRef, db )
 
 mReadSystemSeed

lib/core/src/Cardano/Pool/DB/Sqlite.hs

@@ -222,7 +222,7 @@ newDBLayer trace fp = do
         , deletePoolMetadataRef = \poolId -> do
             deleteWhere [PoolMetadataQueuePoolId ==. poolId]
 
-        , peekPoolMetadataRef = \n -> do
+        , readPoolMetadataRef = \n -> do
             fmap (fromPoolMetadataQueue . entityVal) <$> selectList [] [ LimitTo n ]
 
         , rollbackTo = \point -> do
@@ -251,6 +251,8 @@ newDBLayer trace fp = do
             deleteWhere ([] :: [Filter PoolOwner])
             deleteWhere ([] :: [Filter PoolRegistration])
             deleteWhere ([] :: [Filter StakeDistribution])
+            deleteWhere ([] :: [Filter PoolMetadata])
+            deleteWhere ([] :: [Filter PoolMetadataQueue])
 
         , atomically = runQuery
         })

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -590,7 +590,7 @@ data StakePoolMetadataRef = StakePoolMetadataRef
         -- ^ A URL location where to find pools metadata
     , metadataHash :: ByteString
         -- ^ A blake2b_256 hash of the pools' metadata. For verification.
-    } deriving (Eq, Show, Generic)
+    } deriving (Eq, Ord, Show, Generic)
 
 -- | Information about a stake pool, published by a stake pool owner in the
 -- stake pool registry.

lib/core/test/unit/Cardano/Pool/DB/Arbitrary.hs

@@ -26,6 +26,7 @@ import Cardano.Wallet.Primitive.Types
     , SlotId (..)
     , SlotNo (..)
     , SlotParameters (..)
+    , StakePoolMetadataRef (..)
     , slotSucc
     , unsafeEpochNo
     )
@@ -58,6 +59,7 @@ import Test.QuickCheck
     , vector
     )
 
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as B8
 import qualified Data.List as L
 
@@ -170,3 +172,14 @@ instance Arbitrary StakePoolsFixture where
         appendPair pools pairs slot = do
             pool <- elements pools
             return $ (pool,slot):pairs
+
+instance Arbitrary StakePoolMetadataRef where
+    arbitrary = StakePoolMetadataRef <$> genURL <*> genHash
+      where
+        genHash = BS.pack <$> vector 32
+        genURL  = do
+            protocol <- elements [ "http", "https" ]
+            fstP <- elements [ "cardano", "ada", "pool", "staking", "reward" ]
+            sndP <- elements [ "rocks", "moon", "digital", "server", "fast" ]
+            extP <- elements [ ".io", ".dev", ".com", ".eu" ]
+            pure $ protocol <> "://" <> fstP <> "-" <> sndP <> extP

lib/core/test/unit/Cardano/Pool/DB/Properties.hs

@@ -27,6 +27,7 @@ import Cardano.Wallet.Primitive.Types
     , PoolId
     , PoolRegistrationCertificate (..)
     , SlotId (..)
+    , StakePoolMetadataRef
     )
 import Cardano.Wallet.Unsafe
     ( unsafeRunExceptT )
@@ -70,7 +71,13 @@ import Test.Hspec
     , shouldReturn
     )
 import Test.QuickCheck
-    ( Positive (..), Property, classify, counterexample, property )
+    ( NonEmptyList (..)
+    , Positive (..)
+    , Property
+    , classify
+    , counterexample
+    , property
+    )
 import Test.QuickCheck.Monadic
     ( assert, monadicIO, monitor, run )
 
@@ -140,6 +147,10 @@ properties = do
             (property . prop_listRegisteredPools)
         it "putPoolProduction* . readTotalProduction matches expectations"
             (property . prop_readTotalProduction)
+        it "putPoolMetadataRef . readPoolMetadataRef"
+            (property . prop_putReadMetadataRef)
+        it "propDeleteMetadataRef"
+            (property . prop_deleteMetadataRef)
 
 {-------------------------------------------------------------------------------
                                     Properties
@@ -452,6 +463,45 @@ prop_listRegisteredPools DBLayer {..} entries =
             ]
         assert (pools == (poolId <$> reverse entries))
 
+prop_putReadMetadataRef
+    :: DBLayer IO
+    -> [(PoolId, StakePoolMetadataRef)]
+    -> Property
+prop_putReadMetadataRef DBLayer{..} entries =
+    monadicIO (setup >> prop)
+  where
+    setup = run $ atomically cleanDB
+    prop  = do
+        run . atomically $ mapM_ (uncurry putPoolMetadataRef) entries
+        refs <- run . atomically $ readPoolMetadataRef (length entries)
+        monitor $ counterexample $ unlines
+            [ "Stored " <> show (length entries) <> " entries"
+            , "Read " <> show (length refs) <> " entries"
+            , "Read from DB: " <> show refs
+            ]
+        assert (L.sort refs == L.sort entries)
+
+prop_deleteMetadataRef
+    :: DBLayer IO
+    -> NonEmptyList (PoolId, StakePoolMetadataRef)
+    -> Property
+prop_deleteMetadataRef DBLayer{..} (NonEmpty entries) =
+    monadicIO (setup >> prop)
+  where
+    setup = run $ atomically cleanDB
+    prop  = do
+        let removed = fst $ head entries
+        run . atomically $ mapM_ (uncurry putPoolMetadataRef) entries
+        run . atomically $ deletePoolMetadataRef removed
+        refs <- run . atomically $ readPoolMetadataRef (length entries)
+        monitor $ counterexample $ unlines
+            [ "Stored " <> show (length entries) <> " entries"
+            , "Read " <> show (length refs) <> " entries"
+            , "Removed: " <> show removed
+            , "Read from DB: " <> show refs
+            ]
+        assert (removed `notElem` (fst <$> refs))
+
 -- | successive readSystemSeed yield the exact same value
 prop_readSystemSeedIdempotent
     :: DBLayer IO

lib/core/test/unit/Cardano/Pool/DB/SqliteSpec.hs

@@ -33,7 +33,7 @@ import Test.Utils.Trace
     ( captureLogging )
 
 spec :: Spec
-spec = describe "PATATE" $ do
+spec = do
     withDB newMemoryDBLayer $ do
         describe "Sqlite" properties
 

lib/core/test/unit/Cardano/Wallet/Primitive/AddressDerivationSpec.hs

@@ -92,7 +92,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 
 spec :: Spec
-spec = describe "PATATE" $ do
+spec = do
     describe "Bounded / Enum relationship" $ do
         it "The calls Index.succ maxBound should result in a runtime err (hard)"
             prop_succMaxBoundHardIx