mirror of
https://github.com/postgres-haskell/postgres-wire.git
synced 2024-11-26 09:33:46 +03:00
Decoders for server messages
This commit is contained in:
parent
f3bf8a65b5
commit
41f90ee572
@ -19,6 +19,8 @@ library
|
||||
, Database.PostgreSQL.Protocol.Types
|
||||
, Database.PostgreSQL.Protocol.Settings
|
||||
, Database.PostgreSQL.Protocol.Connection
|
||||
, Database.PostgreSQL.Protocol.Encoders
|
||||
, Database.PostgreSQL.Protocol.Decoders
|
||||
build-depends: base >= 4.7 && < 5
|
||||
, bytestring
|
||||
, socket
|
||||
|
94
src/Database/PostgreSQL/Protocol/Decoders.hs
Normal file
94
src/Database/PostgreSQL/Protocol/Decoders.hs
Normal file
@ -0,0 +1,94 @@
|
||||
module Database.PostgreSQL.Protocol.Decoders where
|
||||
|
||||
import Data.Word
|
||||
import Data.Int
|
||||
import Data.Monoid
|
||||
import Data.Foldable
|
||||
import Data.Char (chr)
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Binary.Get
|
||||
|
||||
import Database.PostgreSQL.Protocol.Types
|
||||
|
||||
decodeAuthResponse :: Get AuthResponse
|
||||
decodeAuthResponse = do
|
||||
c <- getWord8
|
||||
when ('R' /= chr (fromIntegral c)) $ fail "Invalid message"
|
||||
len <- getInt32be
|
||||
rType <- getInt32be
|
||||
case rType of
|
||||
0 -> pure AuthenticationOk
|
||||
3 -> pure AuthenticationCleartextPassword
|
||||
5 -> AuthenticationMD5Password <$> getWord32be
|
||||
7 -> pure AuthenticationGSS
|
||||
9 -> pure AuthenticationSSPI
|
||||
8 -> AuthenticationGSSContinue <$> getByteString (fromIntegral $ len -8)
|
||||
_ -> fail "Unknown authentication response"
|
||||
|
||||
decodeServerMessage :: Get ServerMessage
|
||||
decodeServerMessage = do
|
||||
c <- getWord8
|
||||
len <- getInt32be
|
||||
case chr $ fromIntegral c of
|
||||
'K' -> BackendKeyData <$> getInt32be <*> getInt32be
|
||||
'2' -> pure BindComplete
|
||||
'3' -> pure CloseComplete
|
||||
'C' -> CommandComplete <$> getByteString (fromIntegral $ len - 4)
|
||||
'D' -> do
|
||||
columnCount <- fromIntegral <$> getInt16be
|
||||
DataRow <$> V.replicateM columnCount
|
||||
(getInt32be >>= getByteString . fromIntegral)
|
||||
'I' -> pure EmptyQueryResponse
|
||||
-- TODO
|
||||
'E' -> do
|
||||
getByteString (fromIntegral $ len - 4)
|
||||
pure $ ErrorResponse Nothing
|
||||
'n' -> pure NoData
|
||||
'N' -> do
|
||||
getByteString (fromIntegral $ len - 4)
|
||||
pure $ NoticeResponse Nothing
|
||||
'A' -> NotificationResponse <$> getInt32be
|
||||
<*> decodePgString <*> decodePgString
|
||||
't' -> do
|
||||
paramCount <- fromIntegral <$> getInt16be
|
||||
ParameterDescription <$> V.replicateM paramCount getInt32be
|
||||
'S' -> ParameterStatus <$> decodePgString <*> decodePgString
|
||||
'1' -> pure ParseComplete
|
||||
's' -> pure PortalSuspended
|
||||
'Z' -> ReadForQuery <$> decodeTransactionStatus
|
||||
'T' -> do
|
||||
rowsCount <- fromIntegral <$> getInt16be
|
||||
RowDescription <$> V.replicateM rowsCount decodeFieldDescription
|
||||
|
||||
decodeTransactionStatus :: Get TransactionStatus
|
||||
decodeTransactionStatus = getWord8 >>= \t ->
|
||||
case chr $ fromIntegral t of
|
||||
'I' -> pure TransactionIdle
|
||||
'T' -> pure TransactionInProgress
|
||||
'E' -> pure TransactionFailed
|
||||
_ -> fail "unknown transaction status"
|
||||
|
||||
decodeFieldDescription :: Get FieldDescription
|
||||
decodeFieldDescription = FieldDescription
|
||||
<$> decodePgString
|
||||
<*> getInt32be
|
||||
<*> getInt16be
|
||||
<*> getInt32be
|
||||
<*> getInt16be
|
||||
<*> getInt32be
|
||||
<*> decodeFormat
|
||||
|
||||
decodeFormat :: Get Format
|
||||
decodeFormat = getInt16be >>= \f ->
|
||||
case f of
|
||||
0 -> pure Text
|
||||
1 -> pure Binary
|
||||
_ -> fail "Unknown field format"
|
||||
|
||||
decodePgString :: Get B.ByteString
|
||||
decodePgString = BL.toStrict <$> getLazyByteStringNul
|
||||
|
@ -11,8 +11,8 @@ type Oid = Int32
|
||||
-- maybe distinguish sql for extended query and simple query
|
||||
type StatementSQL = B.ByteString
|
||||
type PasswordText = B.ByteString
|
||||
type ServerProccessId = Word32
|
||||
type ServerSecretKey = Word32
|
||||
type ServerProccessId = Int32
|
||||
type ServerSecretKey = Int32
|
||||
-- String that identifies which SQL command was completed.
|
||||
-- should be more complex in future
|
||||
type CommandTag = B.ByteString
|
||||
@ -101,13 +101,13 @@ data FieldDescription = FieldDescription
|
||||
-- the object ID of the table
|
||||
, fieldTableOid :: Oid
|
||||
-- the attribute number of the column;
|
||||
, fieldColumnNumber :: Word16
|
||||
, fieldColumnNumber :: Int16
|
||||
, fieldTypeOid :: Oid
|
||||
-- The data type size (see pg_type.typlen). Note that negative
|
||||
-- values denote variable-width types.
|
||||
, fieldSize :: Word16
|
||||
, fieldSize :: Int16
|
||||
-- The type modifier (see pg_attribute.atttypmod).
|
||||
, fieldMode :: Word32
|
||||
, fieldMode :: Int32
|
||||
-- In a RowDescription returned from the statement variant of Describe,
|
||||
-- the format code is not yet known and will always be zero.
|
||||
, fieldFormat :: Format
|
||||
|
Loading…
Reference in New Issue
Block a user