packstream-bolt 0.1.0.0 → 0.1.0.1

raw patch · 2 files changed

+235/−2 lines, 2 filesdep +QuickCheckdep +packstream-boltdep +sandwichPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: QuickCheck, packstream-bolt, sandwich

API changes (from Hackage documentation)

Files

• packstream-bolt.cabal +44/−2
• test/Main.hs +191/−0

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1.+-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack  name:           packstream-bolt-version:        0.1.0.0+version:        0.1.0.1 synopsis:       PackStream binary serialization format description:    Implementation of the PackStream binary serialization format,                 used as the wire format by Neo4j's BOLT protocol.@@ -85,6 +85,48 @@     , text >=2.0 && <2.2     , text-show >=3.10 && <3.12     , time >=1.11 && <1.15+    , unordered-containers ==0.2.*+    , vector ==0.13.*+  default-language: GHC2021+  if flag(dev)+    ghc-options: -Werror++test-suite packstream-bolt-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Paths_packstream_bolt+  hs-source-dirs:+      test+  default-extensions:+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DerivingVia+      DuplicateRecordFields+      FunctionalDependencies+      GADTs+      LambdaCase+      MultiWayIf+      OverloadedRecordDot+      OverloadedStrings+      PartialTypeSignatures+      RecordWildCards+      RoleAnnotations+      TypeFamilies+      UnboxedSums+      UnboxedTuples+      UnliftedDatatypes+      UnliftedNewtypes+      ViewPatterns+  ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-safe-haskell-mode -Wno-name-shadowing -Wno-overlapping-patterns -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N -Wno-missing-export-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-orphans+  build-depends:+      QuickCheck+    , base >=4.18 && <5+    , bytestring >=0.11 && <0.13+    , packstream-bolt+    , sandwich+    , text >=2.0 && <2.2     , unordered-containers ==0.2.*     , vector ==0.13.*   default-language: GHC2021

@@ -0,0 +1,191 @@+module Main where++import           Test.Sandwich++import           Control.Monad.IO.Class           (liftIO)+import           Data.Int                         (Int64)+import qualified Data.ByteString                  as BS+import qualified Data.HashMap.Lazy                as H+import qualified Data.Text                        as T+import qualified Data.Vector                      as V++import           Data.PackStream                  (pack, unpack)+import           Data.PackStream.Ps               (Ps(..))+import           Data.PackStream.Integer          (ToPSInteger(..))+import           Test.QuickCheck                  (Arbitrary(..), Gen, oneof,+                                                   quickCheckResult, isSuccess,+                                                   withMaxSuccess, chooseInt)+++-- = Helpers++-- | Like 'listOf' but keeps the size small to avoid deep nesting.+listOfSmall :: Gen a -> Gen [a]+listOfSmall g = do+  n <- chooseInt (0, 3)+  sequence (replicate n g)++-- | Generate a finite (non-NaN, non-Infinite) Double.+arbitraryFiniteDouble :: Gen Double+arbitraryFiniteDouble = do+  d <- arbitrary+  pure $ if isNaN d || isInfinite d then 0.0 else d++-- | Arbitrary Ps value (no PsStructure — tag namespace is application-defined).+instance Arbitrary Ps where+  arbitrary = oneof+    [ pure PsNull+    , PsBoolean <$> arbitrary+    , PsInteger . toPSInteger <$> (arbitrary :: Gen Int64)+    , PsFloat <$> arbitraryFiniteDouble+    , PsString . T.pack <$> arbitrary+    , PsBytes . BS.pack <$> arbitrary+    , PsList . V.fromList <$> listOfSmall arbitrary+    , PsDictionary . H.fromList <$> listOfSmall ((,) <$> (T.pack <$> arbitrary) <*> arbitrary)+    ]++-- | Assert a QuickCheck result, failing the sandwich test on property failure.+assertQC r+  | isSuccess r = pure ()+  | otherwise   = expectationFailure $ "QuickCheck: " <> show r+++-- = Unit tests: PackStream round-trips++packstreamRoundTripTests :: TopSpec+packstreamRoundTripTests = describe "PackStream round-trips" $ do+  it "round-trips PsNull" $ do+    unpack (pack PsNull) `shouldBe` Right PsNull++  it "round-trips PsBoolean True" $ do+    unpack (pack (PsBoolean True)) `shouldBe` Right (PsBoolean True)++  it "round-trips PsBoolean False" $ do+    unpack (pack (PsBoolean False)) `shouldBe` Right (PsBoolean False)++  it "round-trips PsInteger small" $ do+    unpack (pack (PsInteger 42)) `shouldBe` Right (PsInteger 42)++  it "round-trips PsInteger negative" $ do+    unpack (pack (PsInteger (-100))) `shouldBe` Right (PsInteger (-100))++  it "round-trips PsInteger zero" $ do+    unpack (pack (PsInteger 0)) `shouldBe` Right (PsInteger 0)++  it "round-trips PsFloat" $ do+    unpack (pack (PsFloat 3.14)) `shouldBe` Right (PsFloat 3.14)++  it "round-trips PsString" $ do+    unpack (pack (PsString "hello world")) `shouldBe` Right (PsString "hello world")++  it "round-trips PsString empty" $ do+    unpack (pack (PsString "")) `shouldBe` Right (PsString "")++  it "round-trips PsString unicode" $ do+    unpack (pack (PsString "\x1F600 emoji")) `shouldBe` Right (PsString "\x1F600 emoji")++  it "round-trips PsList empty" $ do+    unpack (pack (PsList V.empty)) `shouldBe` Right (PsList V.empty)++  it "round-trips PsList with values" $ do+    let v = PsList $ V.fromList [PsInteger 1, PsString "two", PsBoolean True]+    unpack (pack v) `shouldBe` Right v++  it "round-trips PsDictionary empty" $ do+    unpack (pack (PsDictionary H.empty)) `shouldBe` Right (PsDictionary H.empty)++  it "round-trips PsDictionary with entries" $ do+    let d = PsDictionary $ H.fromList [("key", PsString "value"), ("num", PsInteger 42)]+    unpack (pack d) `shouldBe` Right d++  it "round-trips nested structures" $ do+    let nested = PsList $ V.fromList+          [ PsDictionary $ H.fromList [("a", PsInteger 1)]+          , PsList $ V.fromList [PsNull, PsBoolean False]+          ]+    unpack (pack nested) `shouldBe` Right nested++  -- Integer range boundary tests+  it "round-trips PsInteger tiny positive (127)" $ do+    unpack (pack (PsInteger 127)) `shouldBe` Right (PsInteger 127)++  it "round-trips PsInteger tiny negative (-16)" $ do+    unpack (pack (PsInteger (-16))) `shouldBe` Right (PsInteger (-16))++  it "round-trips PsInteger INT_8 range (128)" $ do+    unpack (pack (PsInteger 128)) `shouldBe` Right (PsInteger 128)++  it "round-trips PsInteger INT_8 range (-128)" $ do+    unpack (pack (PsInteger (-128))) `shouldBe` Right (PsInteger (-128))++  it "round-trips PsInteger INT_16 range (1000)" $ do+    unpack (pack (PsInteger 1000)) `shouldBe` Right (PsInteger 1000)++  it "round-trips PsInteger INT_32 range (100000)" $ do+    unpack (pack (PsInteger 100000)) `shouldBe` Right (PsInteger 100000)++  it "round-trips PsInteger INT_64 range (maxBound)" $ do+    let big = PsInteger 9223372036854775807+    unpack (pack big) `shouldBe` Right big++  it "round-trips PsInteger INT_64 range (minBound)" $ do+    let small = PsInteger (-9223372036854775808)+    unpack (pack small) `shouldBe` Right small++  -- Bytes tests+  it "round-trips PsBytes empty" $ do+    unpack (pack (PsBytes "")) `shouldBe` Right (PsBytes "")++  it "round-trips PsBytes with data" $ do+    let bs = PsBytes "\x00\x01\x02\xFF"+    unpack (pack bs) `shouldBe` Right bs++  -- Structure tests+  it "round-trips PsStructure empty fields" $ do+    let s = PsStructure 0x01 V.empty+    unpack (pack s) `shouldBe` Right s++  it "round-trips PsStructure with one field" $ do+    let s = PsStructure 0x01 $ V.singleton $ PsDictionary $ H.fromList+              [("user_agent", PsString "bolty/2.0"), ("scheme", PsString "none")]+    unpack (pack s) `shouldBe` Right s++  it "round-trips PsStructure with multiple fields" $ do+    let s = PsStructure 0x4E $ V.fromList+              [ PsInteger 1+              , PsList (V.fromList [PsString "Person"])+              , PsDictionary (H.fromList [("name", PsString "Alice")])+              , PsString "4:abc:1"+              ]+    unpack (pack s) `shouldBe` Right s++  -- Larger collection tests+  it "round-trips PsList with 16 elements (LIST_8)" $ do+    let v = PsList $ V.fromList [PsInteger (fromIntegral i) | i <- [0..15 :: Int]]+    unpack (pack v) `shouldBe` Right v++  it "round-trips Text via PackStream class" $ do+    let txt = "hello" :: T.Text+    unpack (pack txt) `shouldBe` Right (PsString txt)++  it "round-trips Bool via PackStream class" $ do+    unpack (pack True) `shouldBe` Right (PsBoolean True)+++-- = QuickCheck property tests++quickcheckTests :: TopSpec+quickcheckTests = describe "QuickCheck: pack/unpack round-trip" $ do++  it "Ps round-trips through pack/unpack (1000 cases)" $ do+    r <- liftIO $ quickCheckResult $ withMaxSuccess 1000 $ \(ps :: Ps) ->+      unpack (pack ps) == Right ps+    assertQC r+++-- = Main++main :: IO ()+main = runSandwichWithCommandLineArgs defaultOptions $ do+  packstreamRoundTripTests+  quickcheckTests