postgres-haskell/postgres-wire
1
1
Fork 0
mirror of https://github.com/postgres-haskell/postgres-wire.git synced 2024-11-22 05:53:12 +03:00
Code Issues Projects Releases Wiki Activity

char type allows only 7bit values, tests for char encode/decode fixed

Browse Source
This commit is contained in:
qz 2019-01-24 10:11:59 +03:00
parent 96f9f1eba1
commit f2ea8b7687
2 changed files with 13 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Database/PostgreSQL/Protocol/Codecs/Encoders.hs
View File

@ -46,7 +46,9 @@ bytea = putByteString
{-# INLINE char #-}
char :: Char -> Encode
char = putWord8 . fromIntegral . ord
char c
| ord(c) >= 128 = error "Character code must be below 128"
| otherwise = (putWord8 . fromIntegral . ord) c
{-# INLINE date #-}
date :: Day -> Encode

13
tests/Codecs/QuickCheck.hs
View File

@ -95,7 +95,8 @@ testCodecsEncodeDecode :: TestTree
testCodecsEncodeDecode = testGroup "Codecs property 'encode . decode = id'"
[ mkCodecTest "bool" PGT.bool PE.bool PD.bool
, mkCodecTest "bytea" PGT.bytea PE.bytea PD.bytea
, mkCodecTest "char" PGT.char PE.char PD.char
, mkCodecTest "char" PGT.char (PE.char . unAsciiChar)
(fmap AsciiChar <$> PD.char)
, mkCodecTest "date" PGT.date PE.date PD.date
, mkCodecTest "float4" PGT.float4 PE.float4 PD.float4
, mkCodecTest "float8" PGT.float8 PE.float8 PD.float8
@ -103,9 +104,9 @@ testCodecsEncodeDecode = testGroup "Codecs property 'encode . decode = id'"
, mkCodecTest "int4" PGT.int4 PE.int4 PD.int4
, mkCodecTest "int8" PGT.int8 PE.int8 PD.int8
, mkCodecTest "interval" PGT.interval PE.interval PD.interval
, mkCodecTest "json" PGT.json (PE.bsJsonText . unJsonString )
, mkCodecTest "json" PGT.json (PE.bsJsonText . unJsonString)
(fmap JsonString <$> PD.bsJsonText)
, mkCodecTest "jsonb" PGT.jsonb (PE.bsJsonBytes .unJsonString)
, mkCodecTest "jsonb" PGT.jsonb (PE.bsJsonBytes . unJsonString)
(fmap JsonString <$> PD.bsJsonBytes)
, mkCodecTest "numeric" PGT.numeric PE.numeric PD.numeric
, mkCodecTest "text" PGT.text PE.bsText PD.bsText
@ -145,6 +146,12 @@ testCodecsEncodePrint = testGroup
-- Orphan instances
--
newtype AsciiChar = AsciiChar { unAsciiChar :: Char }
deriving (Show, Eq)
instance Arbitrary AsciiChar where
arbitrary = AsciiChar <$> choose ('\0', '\127')
-- Helper to generate valid json strings
newtype JsonString = JsonString { unJsonString :: B.ByteString }
deriving (Show, Eq, IsString)