hasql 1.10.2.4 → 1.10.3

raw patch · 13 files changed

+442/−4 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• hasql.cabal +45/−1
• src/engine-tests/Hasql/Engine/Structures/OidCacheSpec.hs +115/−0
• src/engine-tests/Hasql/Engine/Structures/StatementCacheSpec.hs +95/−0
• src/engine-tests/Main.hs +1/−0
• src/library-tests/Sharing/ByUnit/Decoders/CitextSpec.hs +85/−0
• src/library-tests/Sharing/ByUnit/Encoders/CitextSpec.hs +67/−0
• src/library/Hasql/Codecs/Decoders.hs +1/−0
• src/library/Hasql/Codecs/Decoders/Value.hs +9/−0
• src/library/Hasql/Codecs/Encoders.hs +1/−0
• src/library/Hasql/Codecs/Encoders/Value.hs +18/−0
• src/library/Hasql/Decoders.hs +1/−0
• src/library/Hasql/Encoders.hs +1/−0
• src/library/Hasql/Engine/Structures/StatementCache.hs +3/−3

@@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql-version: 1.10.2.4+version: 1.10.3 category: Hasql, Database, PostgreSQL synopsis: Fast PostgreSQL driver with a flexible mapping API description:@@ -250,6 +250,48 @@     vector >=0.10 && <0.14,     witherable >=0.5 && <0.6, +test-suite engine-tests+  import: test+  type: exitcode-stdio-1.0+  hs-source-dirs:+    src/engine-tests+    src/library++  main-is: Main.hs+  other-modules:+    Hasql.Engine.Structures.OidCache+    Hasql.Engine.Structures.OidCacheSpec+    Hasql.Engine.Structures.StatementCache+    Hasql.Engine.Structures.StatementCacheSpec+    Hasql.Platform.Prelude+    Hasql.Platform.Prelude.Text+    Hasql.Pq+    Hasql.Pq.Ffi+    Hasql.Pq.Mappings++  build-tool-depends:+    hspec-discover:hspec-discover ^>=2.11.12++  build-depends:+    base >=4.14 && <5,+    bytestring >=0.10 && <0.13,+    contravariant >=1.3 && <2,+    dlist >=0.8 && <0.9 || >=1 && <2,+    hashable >=1.2 && <2,+    hspec ^>=2.11.12,+    mtl >=2 && <3,+    postgresql-libpq >=0.10.1 && <0.12,+    profunctors >=5.1 && <6,+    scientific >=0.3 && <0.4,+    text >=1 && <3,+    text-builder >=1 && <1.1,+    time >=1.9 && <2,+    transformers >=0.5 && <0.7,+    unordered-containers >=0.2 && <0.3,+    uuid >=1.3 && <2,+    vector >=0.10 && <0.14,+    witherable >=0.5 && <0.6,+ test-suite library-tests   import: test   type: exitcode-stdio-1.0@@ -278,6 +320,7 @@     Sharing.ByFeature.PreparedStatementsSpec     Sharing.ByFeature.SyntaxErrorsSpec     Sharing.ByUnit.Connection.UseSpec+    Sharing.ByUnit.Decoders.CitextSpec     Sharing.ByUnit.Decoders.Composite.OidMismatchSpec     Sharing.ByUnit.Decoders.CompositeSpec     Sharing.ByUnit.Decoders.CustomSpec@@ -291,6 +334,7 @@     Sharing.ByUnit.Decoders.RecordSpec     Sharing.ByUnit.Decoders.UuidSpec     Sharing.ByUnit.Encoders.ArraySpec+    Sharing.ByUnit.Encoders.CitextSpec     Sharing.ByUnit.Encoders.Composite.OidMismatchSpec     Sharing.ByUnit.Encoders.CompositeSpec     Sharing.ByUnit.Encoders.CustomSpec

@@ -0,0 +1,115 @@+module Hasql.Engine.Structures.OidCacheSpec (spec) where++import Data.HashSet qualified as HashSet+import Hasql.Engine.Structures.OidCache qualified as OidCache+import Test.Hspec+import Prelude++spec :: Spec+spec = do+  describe "empty" do+    it "returns Nothing on scalar lookup" do+      OidCache.lookupScalar Nothing "int4" OidCache.empty+        `shouldBe` Nothing++    it "returns Nothing on array lookup" do+      OidCache.lookupArray Nothing "int4" OidCache.empty+        `shouldBe` Nothing++  describe "insertScalar and lookup" do+    it "can insert and lookup a scalar OID" do+      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty+      OidCache.lookupScalar Nothing "int4" cache+        `shouldBe` Just 23++    it "can insert and lookup an array OID" do+      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty+      OidCache.lookupArray Nothing "int4" cache+        `shouldBe` Just 1007++    it "returns Nothing for a non-inserted type" do+      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty+      OidCache.lookupScalar Nothing "int8" cache+        `shouldBe` Nothing++    it "handles schema-qualified names" do+      let cache = OidCache.insertScalar (Just "public") "my_type" 100 200 OidCache.empty+      OidCache.lookupScalar (Just "public") "my_type" cache+        `shouldBe` Just 100+      OidCache.lookupScalar Nothing "my_type" cache+        `shouldBe` Nothing++    it "distinguishes same type name in different schemas" do+      let cache =+            OidCache.insertScalar+              (Just "schema_a")+              "my_type"+              100+              200+              (OidCache.insertScalar (Just "schema_b") "my_type" 300 400 OidCache.empty)+      OidCache.lookupScalar (Just "schema_a") "my_type" cache+        `shouldBe` Just 100+      OidCache.lookupScalar (Just "schema_b") "my_type" cache+        `shouldBe` Just 300++  describe "selectUnknownNames" do+    it "returns all names when cache is empty" do+      let names = HashSet.fromList [(Nothing, "int4"), (Nothing, "int8")]+      OidCache.selectUnknownNames names OidCache.empty+        `shouldBe` names++    it "returns empty when all names are known" do+      let cache =+            OidCache.insertScalar+              Nothing+              "int4"+              23+              1007+              (OidCache.insertScalar Nothing "int8" 20 1016 OidCache.empty)+          names = HashSet.fromList [(Nothing, "int4"), (Nothing, "int8")]+      OidCache.selectUnknownNames names cache+        `shouldBe` HashSet.empty++    it "returns only unknown names" do+      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty+          names = HashSet.fromList [(Nothing, "int4"), (Nothing, "int8")]+      OidCache.selectUnknownNames names cache+        `shouldBe` HashSet.fromList [(Nothing, "int8")]++  describe "Semigroup" do+    it "right operand takes precedence for duplicate keys" do+      let cacheA = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty+          cacheB = OidCache.insertScalar Nothing "int4" 99 999 OidCache.empty+          merged = cacheA <> cacheB+      OidCache.lookupScalar Nothing "int4" merged+        `shouldBe` Just 99+      OidCache.lookupArray Nothing "int4" merged+        `shouldBe` Just 999++    it "preserves entries from both sides when no conflict" do+      let cacheA = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty+          cacheB = OidCache.insertScalar Nothing "int8" 20 1016 OidCache.empty+          merged = cacheA <> cacheB+      OidCache.lookupScalar Nothing "int4" merged+        `shouldBe` Just 23+      OidCache.lookupScalar Nothing "int8" merged+        `shouldBe` Just 20++    it "is associative" do+      let a = OidCache.insertScalar Nothing "t1" 1 2 OidCache.empty+          b = OidCache.insertScalar Nothing "t1" 3 4 (OidCache.insertScalar Nothing "t2" 5 6 OidCache.empty)+          c = OidCache.insertScalar Nothing "t2" 7 8 (OidCache.insertScalar Nothing "t3" 9 10 OidCache.empty)+      OidCache.toHashMap ((a <> b) <> c)+        `shouldBe` OidCache.toHashMap (a <> (b <> c))++  describe "Monoid" do+    it "mempty is identity for Semigroup" do+      let cache = OidCache.insertScalar Nothing "int4" 23 1007 OidCache.empty+      OidCache.toHashMap (cache <> mempty)+        `shouldBe` OidCache.toHashMap cache+      OidCache.toHashMap (mempty <> cache)+        `shouldBe` OidCache.toHashMap cache++    it "empty equals mempty" do+      OidCache.toHashMap OidCache.empty+        `shouldBe` OidCache.toHashMap mempty

@@ -0,0 +1,95 @@+module Hasql.Engine.Structures.StatementCacheSpec (spec) where++import Data.Maybe (isJust, isNothing)+import Database.PostgreSQL.LibPQ (Oid (..))+import Hasql.Engine.Structures.StatementCache qualified as StatementCache+import Test.Hspec+import Prelude++spec :: Spec+spec = do+  describe "empty" do+    it "returns Nothing on lookup" do+      StatementCache.lookup "SELECT 1" [] StatementCache.empty+        `shouldBe` Nothing++  describe "insert and lookup" do+    it "can insert and retrieve a statement" do+      let (remoteKey, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+      StatementCache.lookup "SELECT 1" [] cache+        `shouldBe` Just remoteKey++    it "generates unique remote keys for different SQL" do+      let (key1, cache1) = StatementCache.insert "SELECT 1" [] StatementCache.empty+          (key2, _cache2) = StatementCache.insert "SELECT 2" [] cache1+      key1 `shouldNotBe` key2++    it "generates unique remote keys for same SQL with different OIDs" do+      let oid23 = Oid 23+          oid25 = Oid 25+          (key1, cache1) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty+          (key2, _cache2) = StatementCache.insert "SELECT $1" [oid25] cache1+      key1 `shouldNotBe` key2++    it "distinguishes statements with same SQL but different OIDs" do+      let oid23 = Oid 23+          oid25 = Oid 25+          (_key1, cache1) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty+          (_key2, cache2) = StatementCache.insert "SELECT $1" [oid25] cache1+      -- Both should be findable+      StatementCache.lookup "SELECT $1" [oid23] cache2+        `shouldSatisfy` isJust+      StatementCache.lookup "SELECT $1" [oid25] cache2+        `shouldSatisfy` isJust+      -- And should have different remote keys+      let Just rk1 = StatementCache.lookup "SELECT $1" [oid23] cache2+          Just rk2 = StatementCache.lookup "SELECT $1" [oid25] cache2+      rk1 `shouldNotBe` rk2++    it "returns Nothing for a non-inserted SQL" do+      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+      StatementCache.lookup "SELECT 2" [] cache+        `shouldBe` Nothing++    it "returns Nothing for matching SQL but different OIDs" do+      let oid23 = Oid 23+          oid25 = Oid 25+          (_key, cache) = StatementCache.insert "SELECT $1" [oid23] StatementCache.empty+      StatementCache.lookup "SELECT $1" [oid25] cache+        `shouldBe` Nothing++    it "handles empty OID list" do+      let (key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+      StatementCache.lookup "SELECT 1" [] cache+        `shouldBe` Just key++    it "handles multiple OIDs" do+      let oids = [Oid 23, Oid 25, Oid 1043]+          (key, cache) = StatementCache.insert "SELECT $1, $2, $3" oids StatementCache.empty+      StatementCache.lookup "SELECT $1, $2, $3" oids cache+        `shouldBe` Just key++    it "distinguishes different OID ordering" do+      let oidsA = [Oid 23, Oid 25]+          oidsB = [Oid 25, Oid 23]+          (_keyA, cache1) = StatementCache.insert "SELECT $1, $2" oidsA StatementCache.empty+          (_keyB, cache2) = StatementCache.insert "SELECT $1, $2" oidsB cache1+      StatementCache.lookup "SELECT $1, $2" oidsA cache2+        `shouldSatisfy` isJust+      StatementCache.lookup "SELECT $1, $2" oidsB cache2+        `shouldSatisfy` isJust+      let Just rkA = StatementCache.lookup "SELECT $1, $2" oidsA cache2+          Just rkB = StatementCache.lookup "SELECT $1, $2" oidsB cache2+      rkA `shouldNotBe` rkB++  describe "reset" do+    it "clears all cached statements" do+      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+          resetCache = StatementCache.reset cache+      StatementCache.lookup "SELECT 1" [] resetCache+        `shouldBe` Nothing++    it "results in a cache equal to empty" do+      let (_key, cache) = StatementCache.insert "SELECT 1" [] StatementCache.empty+      StatementCache.reset cache+        `shouldBe` StatementCache.empty

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,85 @@+module Sharing.ByUnit.Decoders.CitextSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Test.Hspec+import Prelude++spec :: SpecWith (Text, Word16)+spec = do+  describe "Citext Decoders" do+    it "decodes a citext value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement ()+            $ Statement.preparable+              "select 'Hello World'::citext"+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))+        result `shouldBe` Right "Hello World"++    it "decodes a citext value preserving case" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement ()+            $ Statement.preparable+              "select 'HeLLo WoRLd'::citext"+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))+        result `shouldBe` Right "HeLLo WoRLd"++    it "decodes a nullable citext value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement ()+            $ Statement.preparable+              "select null::citext"+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nullable Decoders.citext)))+        result `shouldBe` Right (Nothing :: Maybe Text)++    it "decodes citext case-insensitive comparison in SQL" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement ()+            $ Statement.preparable+              "select 'hello'::citext = 'HELLO'::citext"+              mempty+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True

@@ -0,0 +1,67 @@+module Sharing.ByUnit.Encoders.CitextSpec (spec) where++import Hasql.Connection qualified as Connection+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement qualified as Statement+import Helpers.Scripts qualified as Scripts+import Test.Hspec+import Prelude++spec :: SpecWith (Text, Word16)+spec = do+  describe "Citext Encoders" do+    it "encodes a citext value and compares with static value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement "hello"+            $ Statement.preparable+              "select $1 = 'hello'"+              (Encoders.param (Encoders.nonNullable Encoders.citext))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "encodes a citext value with case-insensitive comparison" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement "Hello"+            $ Statement.preparable+              "select $1 = 'hello'"+              (Encoders.param (Encoders.nonNullable Encoders.citext))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))+        result `shouldBe` Right True++    it "roundtrips a citext value" \config -> do+      Scripts.onPreparableConnection config \connection -> do+        result <- Connection.use connection do+          catchError+            ( Session.statement ()+                $ Statement.unpreparable+                  "CREATE EXTENSION IF NOT EXISTS citext"+                  Encoders.noParams+                  Decoders.noResult+            )+            (const (pure ()))+          Session.statement "Hello World"+            $ Statement.preparable+              "select $1"+              (Encoders.param (Encoders.nonNullable Encoders.citext))+              (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.citext)))+        result `shouldBe` Right "Hello World"

@@ -43,6 +43,7 @@     Value.tsmultirange,     Value.tstzmultirange,     Value.datemultirange,+    Value.citext,     array,     listArray,     vectorArray,

@@ -37,6 +37,7 @@     tsmultirange,     tstzmultirange,     datemultirange,+    citext,     custom,     refine,     hstore,@@ -339,6 +340,14 @@ {-# INLINEABLE datemultirange #-} datemultirange :: Value (R.Multirange Day) datemultirange = primitive "datemultirange" TypeInfo.datemultirange Binary.datemultirange++-- |+-- Decoder of the @CITEXT@ values.+--+-- Requires the @citext@ extension to be installed in the database.+{-# INLINEABLE citext #-}+citext :: Value Text+citext = Value Nothing "citext" Nothing Nothing 0 (RequestingOid.lift Binary.text_strict)  -- | -- Low level API for defining custom value decoders.

@@ -55,6 +55,7 @@     Value.tsmultirange,     Value.tstzmultirange,     Value.datemultirange,+    Value.citext,     Value.name,     Value.oid,     foldableArray,

@@ -312,6 +312,24 @@ datemultirange = primitive "datemultirange" False TypeInfo.datemultirange Binary.datemultirange (TextBuilder.string . show)  -- |+-- Encoder of @CITEXT@ values.+--+-- Requires the @citext@ extension to be installed in the database.+{-# INLINEABLE citext #-}+citext :: Value Text+citext =+  Value+    Nothing+    "citext"+    Nothing+    Nothing+    0+    False+    HashSet.empty+    (const Binary.text_strict)+    (TextBuilder.string . show)++-- | -- Given a function which maps a value into a textual enum label used on the DB side, -- produces an encoder of that value for a named enum type. {-# INLINEABLE enum #-}

@@ -64,6 +64,7 @@     tsmultirange,     tstzmultirange,     datemultirange,+    citext,     array,     listArray,     vectorArray,

@@ -55,6 +55,7 @@     tsmultirange,     tstzmultirange,     datemultirange,+    citext,     name,     oid,     foldableArray,

@@ -35,7 +35,7 @@   where     remoteKey = fromString $ show $ newCounter     newHashMap = HashMap.insert localKey remoteKey hashMap-    newCounter = succ counter+    newCounter = counter + 1     newState = StatementCache newHashMap newCounter     localKey = LocalKey sql oids @@ -52,5 +52,5 @@  instance Hashable LocalKey where   {-# INLINE hashWithSalt #-}-  hashWithSalt salt (LocalKey template _) =-    hashWithSalt salt template+  hashWithSalt salt (LocalKey template oids) =+    hashWithSalt (hashWithSalt salt template) (fmap Pq.oidToWord32 oids)