From 4d21e67130804b365a1741e70447f2f1111b472f Mon Sep 17 00:00:00 2001 From: Paul Brinkmeier Date: Sat, 23 Sep 2023 05:53:30 +0200 Subject: [PATCH] Decode values from binary instead of text format --- README.md | 5 +- lib/Database/PostgreSQL/Opium.hs | 16 ++-- lib/Database/PostgreSQL/Opium/Error.hs | 3 +- lib/Database/PostgreSQL/Opium/FromField.hs | 79 +++++++++++-------- lib/Database/PostgreSQL/Opium/Oid.hs | 5 ++ .../PostgreSQL/Opium/FromFieldSpec.hs | 13 ++- test/Database/PostgreSQL/OpiumSpec.hs | 12 +-- 7 files changed, 76 insertions(+), 57 deletions(-) diff --git a/README.md b/README.md index 5618d56..bfeb0f7 100644 --- a/README.md +++ b/README.md @@ -62,10 +62,11 @@ getScoreByAge conn = do - [x] Implement error reporting i.e. use `Either OpiumError` instead of `Maybe` - [x] Implement `Float` and `Double` decoding - [x] Clean up and document column table stuff +- [x] Decode `LibPQ.Binary` - [ ] Implement `fetch` (`fetch_` but with parameter passing) - [ ] Implement `UTCTime` and zoned time decoding - [ ] Implement JSON decoding - [ ] Implement `ByteString` decoding (`bytea`) - - Can we make the fromField instance choose whether it wants binary or text? - [ ] Implement (anonymous) composite types - - It seems that in order to decode these, we'd need to use binary mode. In order to avoid writing everything twice it would be wise to move the whole `FromField` machinery to decoding from binary first +- [ ] Catch [UnicodeException](https://hackage.haskell.org/package/text-2.1/docs/Data-Text-Encoding-Error.html#t:UnicodeException) when decoding text +- [ ] Implement array decoding diff --git a/lib/Database/PostgreSQL/Opium.hs b/lib/Database/PostgreSQL/Opium.hs index 15f024d..274ae17 100644 --- a/lib/Database/PostgreSQL/Opium.hs +++ b/lib/Database/PostgreSQL/Opium.hs @@ -47,7 +47,7 @@ import Database.PostgreSQL.Opium.FromField (FromField (..), fromField) execParams :: Connection -> ByteString -> ExceptT Error IO Result execParams conn query = do - liftIO (LibPQ.execParams conn query [] LibPQ.Text) >>= \case + liftIO (LibPQ.execParams conn query [] LibPQ.Binary) >>= \case Nothing -> except $ Left ErrorNoResult Just result -> do @@ -147,20 +147,16 @@ decodeField nameText g (FromRowCtx result columnTable iRef) row = do i <- liftIO $ readIORef iRef liftIO $ modifyIORef' iRef (+1) let (column, oid) = columnTable `indexColumnTable` i - mbField <- liftIO $ getFieldText column + mbField <- liftIO $ LibPQ.getvalue result row column mbValue <- except $ getValue oid mbField value <- except $ g row mbValue pure $ M1 $ K1 value where - getFieldText :: Column -> IO (Maybe Text) - getFieldText column = - fmap Encoding.decodeUtf8 <$> LibPQ.getvalue result row column - - getValue :: FromField u => LibPQ.Oid -> Maybe Text -> Either Error (Maybe u) - getValue oid = maybe (Right Nothing) $ \fieldText -> + getValue :: FromField u => LibPQ.Oid -> Maybe ByteString -> Either Error (Maybe u) + getValue oid = maybe (Right Nothing) $ \field -> mapLeft - (ErrorInvalidField (ErrorPosition row nameText) oid fieldText) - (Just <$> fromField fieldText) + (ErrorInvalidField (ErrorPosition row nameText) oid field) + (Just <$> fromField field) mapLeft :: (b -> c) -> Either b a -> Either c a mapLeft f (Left l) = Left $ f l diff --git a/lib/Database/PostgreSQL/Opium/Error.hs b/lib/Database/PostgreSQL/Opium/Error.hs index 8486f10..1ac3531 100644 --- a/lib/Database/PostgreSQL/Opium/Error.hs +++ b/lib/Database/PostgreSQL/Opium/Error.hs @@ -1,6 +1,7 @@ module Database.PostgreSQL.Opium.Error (Error (..), ErrorPosition (..)) where import Control.Exception (Exception) +import Data.ByteString (ByteString) import Data.Text (Text) import Database.PostgreSQL.LibPQ (ExecStatus, Oid, Row) @@ -15,7 +16,7 @@ data Error | ErrorMissingColumn Text | ErrorInvalidOid Text Oid | ErrorUnexpectedNull ErrorPosition - | ErrorInvalidField ErrorPosition Oid Text String + | ErrorInvalidField ErrorPosition Oid ByteString String deriving (Eq, Show) instance Exception Error where diff --git a/lib/Database/PostgreSQL/Opium/FromField.hs b/lib/Database/PostgreSQL/Opium/FromField.hs index 2fb6302..9acdfc1 100644 --- a/lib/Database/PostgreSQL/Opium/FromField.hs +++ b/lib/Database/PostgreSQL/Opium/FromField.hs @@ -7,42 +7,42 @@ module Database.PostgreSQL.Opium.FromField , fromField ) where -import Data.Attoparsec.Text - ( Parser - , anyChar - , choice - , decimal - , double - , parseOnly - , signed - , string - , takeText - ) +import Data.Attoparsec.ByteString (Parser) +import Data.Bits (Bits (..)) +import Data.ByteString (ByteString) import Data.Functor (($>)) import Data.Proxy (Proxy (..)) import Data.Text (Text) +import Data.Word (Word32, Word64) import Database.PostgreSQL.LibPQ (Oid) -import GHC.Float (double2Float) +import Unsafe.Coerce (unsafeCoerce) +import qualified Data.Attoparsec.ByteString as AP +import qualified Data.ByteString as BS import qualified Data.Text as Text +import qualified Data.Text.Encoding as Encoding import qualified Database.PostgreSQL.Opium.Oid as Oid (\/) :: (a -> Bool) -> (a -> Bool) -> a -> Bool p \/ q = \x -> p x || q x -fromField :: FromField a => Text -> Either String a +fromField :: FromField a => ByteString -> Either String a fromField = - parseOnly parseField + AP.parseOnly parseField class FromField a where validOid :: Proxy a -> Oid -> Bool parseField :: Parser a +instance FromField ByteString where + validOid Proxy = Oid.bytea + parseField = AP.takeByteString + -- | See https://www.postgresql.org/docs/current/datatype-character.html. instance FromField Text where validOid Proxy = Oid.text \/ Oid.character \/ Oid.characterVarying - parseField = takeText + parseField = Encoding.decodeUtf8 <$> AP.takeByteString -- | See https://www.postgresql.org/docs/current/datatype-character.html. instance FromField String where @@ -53,45 +53,54 @@ instance FromField String where -- This instance accepts all character types but fails to decode fields that are not exactly one character. instance FromField Char where validOid Proxy = validOid @Text Proxy - parseField = anyChar + parseField = do + str <- parseField + case str of + [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 -- | 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 = signed decimal + parseField = intParser -- | See https://www.postgresql.org/docs/current/datatype-numeric.html. instance FromField Integer where validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint - parseField = signed decimal + parseField = intParser instance FromField Word where validOid Proxy = Oid.smallint \/ Oid.integer \/ Oid.bigint - parseField = decimal - -doubleParser :: Parser Double -doubleParser = choice - [ string "NaN" $> nan - , signed (string "Infinity" $> infinity) - , double - ] - where - nan = 0 / 0 - infinity = 1 / 0 + parseField = intParser +-- | See https://www.postgresql.org/docs/current/datatype-numeric.html. +-- Accepts only @real@ fields, not @double precision@. instance FromField Float where validOid Proxy = Oid.real - parseField = fmap double2Float doubleParser + -- Afaict there's no cleaner (@base@) way to access the underlying bits. + -- In C we'd do + -- + -- union { float a; uint32_t b; } x; + -- x.b = ...; + -- return x.a; + parseField = unsafeCoerce <$> intParser @Word32 +-- | See https://www.postgresql.org/docs/current/datatype-numeric.html. +-- Accepts only @double precision@ fields, not @real@. instance FromField Double where - validOid Proxy = Oid.real \/ Oid.doublePrecision - parseField = doubleParser + validOid Proxy = Oid.doublePrecision + parseField = unsafeCoerce <$> intParser @Word64 boolParser :: Parser Bool -boolParser = choice - [ string "t" $> True - , string "f" $> False +boolParser = AP.choice + [ AP.word8 1 $> True + , AP.word8 0 $> False ] -- | See https://www.postgresql.org/docs/current/datatype-boolean.html. diff --git a/lib/Database/PostgreSQL/Opium/Oid.hs b/lib/Database/PostgreSQL/Opium/Oid.hs index 3ebe82b..014b25b 100644 --- a/lib/Database/PostgreSQL/Opium/Oid.hs +++ b/lib/Database/PostgreSQL/Opium/Oid.hs @@ -5,6 +5,11 @@ import Database.PostgreSQL.LibPQ (Oid (..)) eq :: Eq a => a -> a -> Bool eq = (==) +-- raw byte string + +bytea :: Oid -> Bool +bytea = eq $ Oid 17 + -- string types text :: Oid -> Bool diff --git a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs index 2d3db7a..9ccdf95 100644 --- a/test/Database/PostgreSQL/Opium/FromFieldSpec.hs +++ b/test/Database/PostgreSQL/Opium/FromFieldSpec.hs @@ -30,6 +30,12 @@ newtype AWord = AWord instance FromRow AWord where +newtype AByteString = AByteString + { bytestring :: ByteString + } deriving (Eq, Generic, Show) + +instance FromRow AByteString where + newtype AText = AText { text :: Text } deriving (Eq, Generic, Show) @@ -106,6 +112,10 @@ spec = do it "Decodes bigint" $ \conn -> do shouldFetch conn "SELECT pow(2, 48)::BIGINT AS word" [AWord $ (2 :: Word) ^ (48 :: Word)] + describe "FromField ByteString" $ do + it "Decodes bytea" $ \conn -> do + shouldFetch conn "SELECT 'Hello, World!'::BYTEA AS bytestring" [AByteString "Hello, World!"] + describe "FromField Text" $ do it "Decodes text" $ \conn -> do shouldFetch conn "SELECT 'Hello, World!'::TEXT AS text" [AText "Hello, World!"] @@ -159,9 +169,6 @@ spec = do it "Decodes double precision" $ \conn -> do shouldFetch conn "SELECT 4.2::double precision AS double" [ADouble 4.2] - it "Decodes real" $ \conn -> do - shouldFetch conn "SELECT 4.2::real AS double" [ADouble 4.2] - it "Decodes NaN::double precision" $ \conn -> do Right [ADouble value] <- Opium.fetch_ conn "SELECT 'NaN'::double precision AS double" value `shouldSatisfy` isNaN diff --git a/test/Database/PostgreSQL/OpiumSpec.hs b/test/Database/PostgreSQL/OpiumSpec.hs index 1c82e23..a1ae811 100644 --- a/test/Database/PostgreSQL/OpiumSpec.hs +++ b/test/Database/PostgreSQL/OpiumSpec.hs @@ -58,7 +58,7 @@ shouldHaveColumns -> [LibPQ.Column] -> IO () shouldHaveColumns proxy conn query expectedColumns = do - Just result <- LibPQ.execParams conn query [] LibPQ.Text + Just result <- LibPQ.execParams conn query [] LibPQ.Binary columnTable <- Opium.getColumnTable proxy result let actualColumns = fmap (map fst . Opium.toListColumnTable) columnTable actualColumns `shouldBe` Right expectedColumns @@ -81,13 +81,13 @@ spec = do [5, 3] it "Fails for missing columns" $ \conn -> do - Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Text + Just result <- LibPQ.execParams conn "SELECT 0 AS a FROM person" [] LibPQ.Binary columnTable <- Opium.getColumnTable @Person Proxy result columnTable `shouldBe` Left (Opium.ErrorMissingColumn "name") describe "fromRow" $ do it "Decodes rows in a Result" $ \conn -> do - Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Text + Just result <- LibPQ.execParams conn "SELECT * FROM person" [] LibPQ.Binary Right columnTable <- Opium.getColumnTable @Person Proxy result row0 <- Opium.fromRow @Person result columnTable 0 @@ -97,21 +97,21 @@ spec = do row1 `shouldBe` Right (Person "albus" 103) it "Decodes NULL into Nothing for Maybes" $ \conn -> do - Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Text + Just result <- LibPQ.execParams conn "SELECT NULL AS a" [] LibPQ.Binary Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result row <- Opium.fromRow result columnTable 0 row `shouldBe` Right (MaybeTest Nothing) it "Decodes values into Just for Maybes" $ \conn -> do - Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Text + Just result <- LibPQ.execParams conn "SELECT 'abc' AS a" [] LibPQ.Binary Right columnTable <- Opium.getColumnTable @MaybeTest Proxy result row <- Opium.fromRow result columnTable 0 row `shouldBe` Right (MaybeTest $ Just "abc") it "Works for many fields" $ \conn -> do - Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Text + Just result <- LibPQ.execParams conn "SELECT 'abc' AS a, 42 AS b, 1.0::double precision AS c, 'test' AS d, true AS e" [] LibPQ.Binary Right columnTable <- Opium.getColumnTable @ManyFields Proxy result row <- Opium.fromRow result columnTable 0