Skip to content

Commit

Permalink
Disallow NULL characters in Hedgehog generated text values
Browse files Browse the repository at this point in the history
These are not permitted by postgresql and they lead to a runtime error.
  • Loading branch information
TeofilC committed Aug 7, 2024
1 parent 72c2a69 commit 9848ce1
Showing 1 changed file with 9 additions and 4 deletions.
13 changes: 9 additions & 4 deletions tests/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -81,6 +81,7 @@ import Test.Tasty.Hedgehog ( testProperty )

-- text
import Data.Text ( Text, pack, unpack )
import qualified Data.Text as T
import qualified Data.Text.Lazy
import Data.Text.Encoding ( decodeUtf8 )

Expand Down Expand Up @@ -430,14 +431,18 @@ instance Rel8.DBComposite Composite where
compositeTypeName = "composite"
compositeFields = Rel8.namesFromLabels

-- | Postgres doesn't support the NULL character (not to be confused with a NULL value) inside strings.
removeNull :: Text -> Text
removeNull = T.filter (/='\0')


testDBType :: IO TmpPostgres.DB -> TestTree
testDBType getTestDatabase = testGroup "DBType instances"
[ dbTypeTest "Bool" Gen.bool
, dbTypeTest "ByteString" $ Gen.bytes (Range.linear 0 128)
, dbTypeTest "CalendarDiffTime" genCalendarDiffTime
, dbTypeTest "CI Lazy Text" $ mk . Data.Text.Lazy.fromStrict <$> Gen.text (Range.linear 0 10) Gen.unicode
, dbTypeTest "CI Text" $ mk <$> Gen.text (Range.linear 0 10) Gen.unicode
, dbTypeTest "CI Lazy Text" $ mk . Data.Text.Lazy.fromStrict . removeNull <$> Gen.text (Range.linear 0 10) Gen.unicode
, dbTypeTest "CI Text" $ mk .removeNull <$> Gen.text (Range.linear 0 10) Gen.unicode
, dbTypeTest "Composite" genComposite
, dbTypeTest "Day" genDay
, dbTypeTest "Double" $ (/ 10) . fromIntegral @Int @Double <$> Gen.integral (Range.linear (-100) 100)
Expand All @@ -446,10 +451,10 @@ testDBType getTestDatabase = testGroup "DBType instances"
, dbTypeTest "Int32" $ Gen.integral @_ @Int32 Range.linearBounded
, dbTypeTest "Int64" $ Gen.integral @_ @Int64 Range.linearBounded
, dbTypeTest "Lazy ByteString" $ Data.ByteString.Lazy.fromStrict <$> Gen.bytes (Range.linear 0 128)
, dbTypeTest "Lazy Text" $ Data.Text.Lazy.fromStrict <$> Gen.text (Range.linear 0 10) Gen.unicode
, dbTypeTest "Lazy Text" $ Data.Text.Lazy.fromStrict . removeNull <$> Gen.text (Range.linear 0 10) Gen.unicode
, dbTypeTest "LocalTime" genLocalTime
, dbTypeTest "Scientific" $ (/ 10) . fromIntegral @Int @Scientific <$> Gen.integral (Range.linear (-100) 100)
, dbTypeTest "Text" $ Gen.text (Range.linear 0 10) Gen.unicode
, dbTypeTest "Text" $ removeNull <$> Gen.text (Range.linear 0 10) Gen.unicode
, dbTypeTest "TimeOfDay" genTimeOfDay
, dbTypeTest "UTCTime" $ UTCTime <$> genDay <*> genDiffTime
, dbTypeTest "UUID" $ Data.UUID.fromWords <$> genWord32 <*> genWord32 <*> genWord32 <*> genWord32
Expand Down

0 comments on commit 9848ce1

Please sign in to comment.