Fix negative integer decoding
Use Int and Word instead of Int64 and Word64 consistently
This commit is contained in:
parent
4f39966da2
commit
cf2055f39e
@ -66,10 +66,10 @@ getScoreByAge conn = do
|
|||||||
- [x] Implement `date -> Day` decoding
|
- [x] Implement `date -> Day` decoding
|
||||||
- [x] Implement `UTCTime`
|
- [x] Implement `UTCTime`
|
||||||
- [x] Implement `ByteString` decoding (`bytea`)
|
- [x] Implement `ByteString` decoding (`bytea`)
|
||||||
|
- [x] Test negative integer decoding, especially for `Integer`
|
||||||
- [ ] and zoned time decoding
|
- [ ] and zoned time decoding
|
||||||
- [ ] Implement `fetch` (`fetch_` but with parameter passing)
|
- [ ] Implement `fetch` (`fetch_` but with parameter passing)
|
||||||
- [ ] Implement JSON decoding
|
- [ ] Implement JSON decoding
|
||||||
- [ ] Implement (anonymous) composite types
|
- [ ] Implement (anonymous) composite types
|
||||||
- [ ] Catch [UnicodeException](https://hackage.haskell.org/package/text-2.1/docs/Data-Text-Encoding-Error.html#t:UnicodeException) when decoding text
|
- [ ] Catch [UnicodeException](https://hackage.haskell.org/package/text-2.1/docs/Data-Text-Encoding-Error.html#t:UnicodeException) when decoding text
|
||||||
- [ ] Implement array decoding
|
- [ ] Implement array decoding
|
||||||
- [ ] Test negative integer decoding, especially for `Integer`
|
|
||||||
|
@ -14,7 +14,7 @@ import Data.Attoparsec.ByteString (Parser)
|
|||||||
import Data.Bits (Bits (..))
|
import Data.Bits (Bits (..))
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import Data.Functor (($>))
|
import Data.Functor (($>))
|
||||||
import Data.Int (Int32)
|
import Data.Int (Int16, Int32)
|
||||||
import Data.Proxy (Proxy (..))
|
import Data.Proxy (Proxy (..))
|
||||||
import Data.Time
|
import Data.Time
|
||||||
( Day (..)
|
( Day (..)
|
||||||
@ -27,7 +27,7 @@ import Data.Time
|
|||||||
, timeToTimeOfDay
|
, timeToTimeOfDay
|
||||||
)
|
)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Word (Word32, Word64)
|
import Data.Word (Word16, Word32)
|
||||||
import Database.PostgreSQL.LibPQ (Oid)
|
import Database.PostgreSQL.LibPQ (Oid)
|
||||||
import Unsafe.Coerce (unsafeCoerce)
|
import Unsafe.Coerce (unsafeCoerce)
|
||||||
|
|
||||||
@ -77,25 +77,38 @@ instance FromField Char where
|
|||||||
[c] -> pure c
|
[c] -> pure c
|
||||||
_ -> fail "Char accepts single characters only"
|
_ -> fail "Char accepts single characters only"
|
||||||
|
|
||||||
intParser :: (Bits a, Num a) => Parser a
|
|
||||||
intParser = readBigEndian <$> AP.takeByteString
|
readBigEndian :: (Bits a, Num a) => ByteString -> a
|
||||||
where
|
|
||||||
readBigEndian = BS.foldl' (\x b -> x `shiftL` 8 .|. fromIntegral b) 0
|
readBigEndian = BS.foldl' (\x b -> x `shiftL` 8 .|. fromIntegral b) 0
|
||||||
|
|
||||||
|
readInt :: Num a => ByteString -> Parser a
|
||||||
|
readInt bs = case BS.length bs of
|
||||||
|
4 -> pure $ fromIntegral $ readBigEndian @Int32 bs
|
||||||
|
8 -> pure $ fromIntegral $ readBigEndian @Int bs
|
||||||
|
2 -> pure $ fromIntegral $ readBigEndian @Int16 bs
|
||||||
|
_ -> fail "Wrong number bytes for integer"
|
||||||
|
|
||||||
|
readWord :: Num a => ByteString -> Parser a
|
||||||
|
readWord bs = case BS.length bs of
|
||||||
|
4 -> pure $ fromIntegral $ readBigEndian @Word32 bs
|
||||||
|
8 -> pure $ fromIntegral $ readBigEndian @Word bs
|
||||||
|
2 -> pure $ fromIntegral $ readBigEndian @Word16 bs
|
||||||
|
_ -> fail "Wrong number bytes for word"
|
||||||
|
|
||||||
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
|
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
|
||||||
-- We assume that 'Int' has 64 bits. This is not guaranteed but reasonable enough.
|
-- We assume that 'Int' has 64 bits. This is not guaranteed but reasonable enough.
|
||||||
instance FromField Int where
|
instance FromField Int where
|
||||||
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
|
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
|
||||||
parseField = intParser
|
parseField = readInt =<< AP.takeByteString
|
||||||
|
|
||||||
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
|
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
|
||||||
instance FromField Integer where
|
instance FromField Integer where
|
||||||
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
|
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
|
||||||
parseField = intParser
|
parseField = readInt =<< AP.takeByteString
|
||||||
|
|
||||||
instance FromField Word where
|
instance FromField Word where
|
||||||
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
|
validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
|
||||||
parseField = intParser
|
parseField = readWord =<< AP.takeByteString
|
||||||
|
|
||||||
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
|
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
|
||||||
-- Accepts only @real@ fields, not @double precision@.
|
-- Accepts only @real@ fields, not @double precision@.
|
||||||
@ -107,13 +120,13 @@ instance FromField Float where
|
|||||||
-- union { float a; uint32_t b; } x;
|
-- union { float a; uint32_t b; } x;
|
||||||
-- x.b = ...;
|
-- x.b = ...;
|
||||||
-- return x.a;
|
-- return x.a;
|
||||||
parseField = unsafeCoerce <$> intParser @Word32
|
parseField = unsafeCoerce <$> readBigEndian @Word32 <$> AP.takeByteString
|
||||||
|
|
||||||
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
|
-- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
|
||||||
-- Accepts only @double precision@ fields, not @real@.
|
-- Accepts only @double precision@ fields, not @real@.
|
||||||
instance FromField Double where
|
instance FromField Double where
|
||||||
validOid Proxy = Oid.doublePrecision
|
validOid Proxy = Oid.doublePrecision
|
||||||
parseField = unsafeCoerce <$> intParser @Word64
|
parseField = unsafeCoerce <$> readBigEndian @Word <$> AP.takeByteString
|
||||||
|
|
||||||
boolParser :: Parser Bool
|
boolParser :: Parser Bool
|
||||||
boolParser = AP.choice
|
boolParser = AP.choice
|
||||||
@ -139,14 +152,14 @@ fromPostgresJulian x = addDays x postgresEpoch
|
|||||||
-- This means that working with negative dates will be different in Postgres and your application code.
|
-- This means that working with negative dates will be different in Postgres and your application code.
|
||||||
instance FromField Day where
|
instance FromField Day where
|
||||||
validOid Proxy = Oid.date
|
validOid Proxy = Oid.date
|
||||||
parseField = fromPostgresJulian . fromIntegral <$> intParser @Int32
|
parseField = fromPostgresJulian . fromIntegral <$> readBigEndian @Int32 <$> AP.takeByteString
|
||||||
|
|
||||||
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
|
-- | See https://www.postgresql.org/docs/current/datatype-datetime.html.
|
||||||
-- Binary format: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/date.c;h=ae0f24de2c3c54eb6d0405cdb212597c2407238e;hb=HEAD#l1542.
|
-- Binary format: https://git.postgresql.org/gitweb/?p=postgresql.git;a=blob;f=src/backend/utils/adt/date.c;h=ae0f24de2c3c54eb6d0405cdb212597c2407238e;hb=HEAD#l1542.
|
||||||
-- Accepts @time@.
|
-- Accepts @time@.
|
||||||
instance FromField DiffTime where
|
instance FromField DiffTime where
|
||||||
validOid Proxy = Oid.time
|
validOid Proxy = Oid.time
|
||||||
parseField = microsecondsToDiffTime <$> intParser
|
parseField = microsecondsToDiffTime . fromIntegral <$> readBigEndian @Int <$> AP.takeByteString
|
||||||
where
|
where
|
||||||
microsecondsToDiffTime :: Integer -> DiffTime
|
microsecondsToDiffTime :: Integer -> DiffTime
|
||||||
microsecondsToDiffTime ms = picosecondsToDiffTime $ ms * 1000000
|
microsecondsToDiffTime ms = picosecondsToDiffTime $ ms * 1000000
|
||||||
@ -165,7 +178,7 @@ instance FromField TimeOfDay where
|
|||||||
-- This means that working with negative dates will be different in Postgres and your application code.
|
-- This means that working with negative dates will be different in Postgres and your application code.
|
||||||
instance FromField LocalTime where
|
instance FromField LocalTime where
|
||||||
validOid Proxy = Oid.timestamp
|
validOid Proxy = Oid.timestamp
|
||||||
parseField = fromPostgresTimestamp <$> intParser @Int
|
parseField = fromPostgresTimestamp <$> readBigEndian @Int <$> AP.takeByteString
|
||||||
where
|
where
|
||||||
fromPostgresTimestamp :: Int -> LocalTime
|
fromPostgresTimestamp :: Int -> LocalTime
|
||||||
fromPostgresTimestamp ts =
|
fromPostgresTimestamp ts =
|
||||||
|
@ -132,6 +132,15 @@ spec = do
|
|||||||
it "Decodes bigint" $ \conn -> do
|
it "Decodes bigint" $ \conn -> do
|
||||||
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS int" [AnInt $ (2 :: Int) ^ (48 :: Int)]
|
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS int" [AnInt $ (2 :: Int) ^ (48 :: Int)]
|
||||||
|
|
||||||
|
it "Decodes smallint -42" $ \conn -> do
|
||||||
|
shouldFetch conn "SELECT -42::SMALLINT AS int" [AnInt (-42)]
|
||||||
|
|
||||||
|
it "Decodes integer -42" $ \conn -> do
|
||||||
|
shouldFetch conn "SELECT -42::INTEGER AS int" [AnInt (-42)]
|
||||||
|
|
||||||
|
it "Decodes bigint -42" $ \conn -> do
|
||||||
|
shouldFetch conn "SELECT -42::BIGINT AS int" [AnInt (-42)]
|
||||||
|
|
||||||
describe "FromField Integer" $ do
|
describe "FromField Integer" $ do
|
||||||
it "Decodes smallint" $ \conn -> do
|
it "Decodes smallint" $ \conn -> do
|
||||||
shouldFetch conn "SELECT 42::SMALLINT AS integer" [AnInteger 42]
|
shouldFetch conn "SELECT 42::SMALLINT AS integer" [AnInteger 42]
|
||||||
@ -142,6 +151,9 @@ spec = do
|
|||||||
it "Decodes bigint" $ \conn -> do
|
it "Decodes bigint" $ \conn -> do
|
||||||
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS integer" [AnInteger $ (2 :: Integer) ^ (48 :: Integer)]
|
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS integer" [AnInteger $ (2 :: Integer) ^ (48 :: Integer)]
|
||||||
|
|
||||||
|
it "Decodes -42" $ \conn -> do
|
||||||
|
shouldFetch conn "SELECT -42 AS integer" [AnInteger (-42)]
|
||||||
|
|
||||||
describe "FromField Word" $ do
|
describe "FromField Word" $ do
|
||||||
it "Decodes smallint" $ \conn -> do
|
it "Decodes smallint" $ \conn -> do
|
||||||
shouldFetch conn "SELECT 42::SMALLINT AS word" [AWord 42]
|
shouldFetch conn "SELECT 42::SMALLINT AS word" [AWord 42]
|
||||||
@ -152,6 +164,12 @@ spec = do
|
|||||||
it "Decodes bigint" $ \conn -> do
|
it "Decodes bigint" $ \conn -> do
|
||||||
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS word" [AWord $ (2 :: Word) ^ (48 :: Word)]
|
shouldFetch conn "SELECT pow(2, 48)::BIGINT AS word" [AWord $ (2 :: Word) ^ (48 :: Word)]
|
||||||
|
|
||||||
|
it "Decodes negative one as 2^64-1" $ \conn -> do
|
||||||
|
shouldFetch conn "SELECT -1::BIGINT AS word" [AWord maxBound]
|
||||||
|
|
||||||
|
it "Decodes integer negative one as 2^32-1" $ \conn -> do
|
||||||
|
shouldFetch conn "SELECT -1::INTEGER AS word" [AWord $ (2 :: Word) ^ (32 :: Word) - 1]
|
||||||
|
|
||||||
describe "FromField ByteString" $ do
|
describe "FromField ByteString" $ do
|
||||||
it "Decodes bytea" $ \conn -> do
|
it "Decodes bytea" $ \conn -> do
|
||||||
shouldFetch conn "SELECT 'Hello, World!'::BYTEA AS bytestring" [AByteString "Hello, World!"]
|
shouldFetch conn "SELECT 'Hello, World!'::BYTEA AS bytestring" [AByteString "Hello, World!"]
|
||||||
|
Loading…
x
Reference in New Issue
Block a user