diff --git a/README.md b/README.md index 441a9b8..14680f2 100644 --- a/README.md +++ b/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` diff --git a/lib/Database/PostgreSQL/Opium/FromField.hs b/lib/Database/PostgreSQL/Opium/FromField.hs index 143ae1b..b0fb141 100644 --- a/lib/Database/PostgreSQL/Opium/FromField.hs +++ b/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 - where - readBigEndian = BS.foldl' (\x b -> x `shiftL` 8 .|. fromIntegral b) 0 + +readBigEndian :: (Bits a, Num a) => ByteString -> a +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 = diff --git a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs index 0f69afa..a0f9992 100644 --- a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs +++ b/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!"]