Merge pull request #4240 from NorfairKing/unit-to-property

Turned unit tests into property tests

subs/pantry/package.yaml

@@ -83,3 +83,4 @@ tests:
     - hspec
     - exceptions
     - hedgehog
+    - QuickCheck

subs/pantry/test/Pantry/Internal/StaticBytesSpec.hs

@@ -5,12 +5,14 @@ module Pantry.Internal.StaticBytesSpec (spec) where
 
 import RIO
 import Pantry.Internal.StaticBytes
+import Control.Monad (replicateM)
 import qualified Data.ByteString as B
 import qualified Data.Vector.Unboxed as VU
 import qualified Data.Vector.Primitive as VP
 import qualified Data.Vector.Storable as VS
 import Test.Hspec
 import Test.Hspec.QuickCheck
+import Test.QuickCheck
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 
@@ -23,41 +25,42 @@ spec = do
 
 tests :: (Eq dbytes, Show dbytes, DynamicBytes dbytes) => ([Word8] -> dbytes) -> Spec
 tests pack = do
-  it "disallows 4 bytes" $ do
-    toStaticExact (pack [1..4]) `shouldBe` (Left NotEnoughBytes :: Either StaticBytesException Bytes8)
-  it "toStaticExact matches ByteString" $ do
-    let octets = [1..8]
+  it "disallows 4 bytes" $ property $ \(w1,w2,w3,w4) ->
+    toStaticExact (pack [w1,w2,w3,w4]) `shouldBe` (Left NotEnoughBytes :: Either StaticBytesException Bytes8)
+  it "toStaticExact matches ByteString" $ property $ \(w1,w2,w3,w4) -> property $ \(w5,w6,w7,w8) -> do
+    let octets =  [w1,w2,w3,w4,w5,w6,w7,w8]
         (expected :: Bytes8) = either impureThrow id $ toStaticExact (B.pack octets)
         actual = either impureThrow id $ toStaticExact (pack octets)
     actual `shouldBe` expected
 
-  it "fromStatic round trips" $ do
-    let octets = [1..8]
+  it "fromStatic round trips" $ property $ \(w1,w2,w3,w4) -> property $ \(w5,w6,w7,w8) -> do
+    let octets = [w1,w2,w3,w4,w5,w6,w7,w8]
         v1 = pack octets
         (b8 :: Bytes8) = either impureThrow id $ toStaticExact v1
         v2 = fromStatic b8
     v2 `shouldBe` v1
 
-  it "allows 8 bytes" $ do
-    let bs = pack [1..8]
+  it "allows 8 bytes" $ property $ \(w1,w2,w3,w4) -> property $ \(w5,w6,w7,w8) -> do
+    let bs = pack [w1,w2,w3,w4,w5,w6,w7,w8]
     case toStaticExact bs of
       Left e -> throwIO e
       Right b8 -> fromStatic (b8 :: Bytes8) `shouldBe` bs
     toStaticExact bs `shouldBe` (Left NotEnoughBytes :: Either StaticBytesException Bytes16)
-  it "padding is the same as trailing nulls" $ do
-    let bs1 = pack $ [1..4] ++ replicate 4 0
-        bs2 = pack [1..4]
+  it "padding is the same as trailing nulls" $ property $ \(w1,w2,w3,w4) -> do
+    let ws = [w1,w2,w3,w4]
+        bs1 = pack $ ws ++ replicate 4 0
+        bs2 = pack ws
     Right (toStaticPadTruncate bs2 :: Bytes8) `shouldBe` toStaticExact bs1
 
   prop "handles bytes16" $ \octets -> do
     let bs = pack $ take 16 octets
         (b16 :: Bytes16) = either impureThrow id $ toStaticPad bs
     fromStatic b16 `shouldBe` pack (take 16 (octets ++ replicate 16 0))
 
-  it "spot check bytes16" $ do
-    let bs = pack $ replicate 16 0
+  it "spot check bytes16" $ forAll (replicateM 16 arbitrary) $ \ws -> do
+    let bs = pack ws
         (b16 :: Bytes16) = either impureThrow id $ toStaticPad bs
-    fromStatic b16 `shouldBe` pack (replicate 16 0)
+    fromStatic b16 `shouldBe` pack ws
 
   prop "handles bytes32" $ \octets -> do
     let bs = pack $ take 32 octets