Decoders for server messages

This commit is contained in:
VyacheslavHashov 2017-01-13 15:40:12 +03:00
parent f3bf8a65b5
commit 41f90ee572
3 changed files with 101 additions and 5 deletions

View File

@ -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

View 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

View File

@ -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