Fix negative integer decoding

Use Int and Word instead of Int64 and Word64 consistently

README.md

@@ -66,10 +66,10 @@ getScoreByAge conn = do
 - [x] Implement `date -> Day` decoding
 - [x] Implement `UTCTime`
 - [x] Implement `ByteString` decoding (`bytea`)
+- [x] Test negative integer decoding, especially for `Integer`
 - [ ] and zoned time decoding
 - [ ] Implement `fetch` (`fetch_` but with parameter passing)
 - [ ] Implement JSON decoding
 - [ ] 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
 - [ ] Implement array decoding
-- [ ] Test negative integer decoding, especially for `Integer`

lib/Database/PostgreSQL/Opium/FromField.hs

@@ -14,7 +14,7 @@ import Data.Attoparsec.ByteString (Parser)
 import Data.Bits (Bits (..))
 import Data.ByteString (ByteString)
 import Data.Functor (($>))
-import Data.Int (Int32)
+import Data.Int (Int16, Int32)
 import Data.Proxy (Proxy (..))
 import Data.Time
   ( Day (..)
@@ -27,7 +27,7 @@ import Data.Time
   , timeToTimeOfDay
   )
 import Data.Text (Text)
-import Data.Word (Word32, Word64)
+import Data.Word (Word16, Word32)
 import Database.PostgreSQL.LibPQ (Oid)
 import Unsafe.Coerce (unsafeCoerce)
 
@@ -77,25 +77,38 @@ instance FromField Char where
       [c] -> pure c
       _ -> 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.
 -- We assume that 'Int' has 64 bits. This is not guaranteed but reasonable enough.
 instance FromField Int where
   validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
-  parseField = intParser
+  parseField = readInt =<< AP.takeByteString
 
 -- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
 instance FromField Integer where
   validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
-  parseField = intParser
+  parseField = readInt =<< AP.takeByteString
 
 instance FromField Word where
   validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint
-  parseField = intParser
+  parseField = readWord =<< AP.takeByteString
 
 -- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
 -- Accepts only @real@ fields, not @double precision@.
@@ -107,13 +120,13 @@ instance FromField Float where
   -- union { float a; uint32_t b; } x;
   -- x.b = ...;
   -- return x.a;
-  parseField = unsafeCoerce <$> intParser @Word32
+  parseField = unsafeCoerce <$> readBigEndian @Word32 <$> AP.takeByteString
 
 -- | See https://www.postgresql.org/docs/current/datatype-numeric.html.
 -- Accepts only @double precision@ fields, not @real@.
 instance FromField Double where
   validOid Proxy = Oid.doublePrecision
-  parseField = unsafeCoerce <$> intParser @Word64
+  parseField = unsafeCoerce <$> readBigEndian @Word <$> AP.takeByteString
 
 boolParser :: Parser Bool
 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.
 instance FromField Day where
   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.
 -- 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@.
 instance FromField DiffTime where
   validOid Proxy = Oid.time
-  parseField = microsecondsToDiffTime <$> intParser
+  parseField = microsecondsToDiffTime . fromIntegral <$> readBigEndian @Int <$> AP.takeByteString
     where
       microsecondsToDiffTime :: Integer -> DiffTime
       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.
 instance FromField LocalTime where
   validOid Proxy = Oid.timestamp
-  parseField = fromPostgresTimestamp <$> intParser @Int
+  parseField = fromPostgresTimestamp <$> readBigEndian @Int <$> AP.takeByteString
     where
       fromPostgresTimestamp :: Int -> LocalTime
       fromPostgresTimestamp ts =

test/Database/PostgreSQL/Opium/FromFieldSpec.hs

@@ -132,6 +132,15 @@ spec = do
     it "Decodes bigint" $ \conn -> do
       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
     it "Decodes smallint" $ \conn -> do
       shouldFetch conn "SELECT 42::SMALLINT AS integer" [AnInteger 42]
@@ -142,6 +151,9 @@ spec = do
     it "Decodes bigint" $ \conn -> do
       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
     it "Decodes smallint" $ \conn -> do
       shouldFetch conn "SELECT 42::SMALLINT AS word" [AWord 42]
@@ -152,6 +164,12 @@ spec = do
     it "Decodes bigint" $ \conn -> do
       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
     it "Decodes bytea" $ \conn -> do
       shouldFetch conn "SELECT 'Hello, World!'::BYTEA AS bytestring" [AByteString "Hello, World!"]