8000 Fixed encoders with newtypes · postgres-haskell/postgres-wire@da8bba2 · GitHub
[go: up one dir, main page]

Skip to content

Commit da8bba2

Browse files
Fixed encoders with newtypes
1 parent b9b0098 commit da8bba2

File tree

3 files changed

+27
-22
lines changed

3 files changed

+27
-22
lines changed

src/Database/PostgreSQL/Protocol/Encoders.hs

Lines changed: 16 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -17,56 +17,59 @@ currentVersion = 3 * 256 * 256
1717

1818
encodeStartMessage :: StartMessage -> Builder
1919
-- Options except user and database are not supported
20-
encodeStartMessage (StartupMessage uname dbname) =
20+
encodeStartMessage (StartupMessage (Username uname) (DatabaseName dbname)) =
2121
int32BE (len + 4) <> payload
2222
where
2323
len = fromIntegral $ BL.length $ toLazyByteString payload
2424
payload = int32BE currentVersion <>
2525
pgString "user" <> pgString uname <>
2626
pgString "database" <> pgString dbname <> word8 0
27+
-- TODO
2728
encodeStartMessage SSLRequest = undefined
2829

2930
encodeClientMessage :: ClientMessage -> Builder
30-
encodeClientMessage (Bind portalName stmtName paramFormat values resultFormat)
31+
encodeClientMessage (Bind (PortalName portalName) (StatementName stmtName)
32+
paramFormat values resultFormat)
3133
= prependHeader 'B' $
3234
pgString portalName <>
3335
pgString stmtName <>
34-
-- the specified format code is applied to all parameters
36+
-- `1` means that the specified format code is applied to all parameters
3537
int16BE 1 <>
3638
encodeFormat paramFormat <>
3739
int16BE (fromIntegral $ V.length values) <>
3840
-- TODO -1 indicates a NULL parameter value. No value bytes
3941
-- follow in the NULL case.
4042
fold ((\v -> int32BE (fromIntegral $ B.length v) <> byteString v)
4143
<$> values) <>
42-
-- the specified format code is applied to all result columns (if any)
44+
-- `1` means that the specified format code is applied to all
45+
-- result columns (if any)
4346
int16BE 1 <>
4447
encodeFormat resultFormat
45-
encodeClientMessage (CloseStatement stmtName)
48+
encodeClientMessage (CloseStatement (StatementName stmtName))
4649
= prependHeader 'C' $ char8 'S' <> pgString stmtName
47-
encodeClientMessage (ClosePortal portalName)
50+
encodeClientMessage (ClosePortal (PortalName portalName))
4851
= prependHeader 'C' $ char8 'P' <> pgString portalName
49-
encodeClientMessage (DescribeStatement stmtName)
52+
encodeClientMessage (DescribeStatement (StatementName stmtName))
5053
= prependHeader 'D' $ char8 'S' <> pgString stmtName
51-
encodeClientMessage (DescribePortal portalName)
54+
encodeClientMessage (DescribePortal (PortalName portalName))
5255
= prependHeader 'D' $ char8 'P' <> pgString portalName
53-
encodeClientMessage (Execute portalName)
56+
encodeClientMessage (Execute (PortalName portalName))
5457
= prependHeader 'E' $
5558
pgString portalName <>
5659
--Maximum number of rows to return, if portal contains a query that
5760
--returns rows (ignored otherwise). Zero denotes "no limit".
5861
int32BE 0
5962
encodeClientMessa 8000 ge Flush
6063
= prependHeader 'H' mempty
61-
encodeClientMessage (Parse stmtName stmt oids)
64+
encodeClientMessage (Parse (StatementName stmtName) (StatementSQL stmt) oids)
6265
= prependHeader 'P' $
6366
pgString stmtName <>
6467
pgString stmt <>
6568
int16BE (fromIntegral $ V.length oids) <>
66-
fold (int32BE <$> oids)
67-
encodeClientMessage (PasswordMessage passText)
69+
fold (int32BE . unOid <$> oids)
70+
encodeClientMessage (PasswordMessage (PasswordText passText))
6871
= prependHeader 'p' $ pgString passText
69-
encodeClientMessage (Query stmt)
72+
encodeClientMessage (SimpleQuery (StatementSQL stmt))
7073
= prependHeader 'Q' $ pgString stmt
7174
encodeClientMessage Sync
7275
= prependHeader 'S' mempty

src/Database/PostgreSQL/Protocol/StatementStorage.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ storageStatement :: StatementStorage -> StatementSQL -> IO StatementName
2222
storageStatement (StatementStorage table counter) stmt = do
2323
n <- readIORef counter
2424
writeIORef counter $ n + 1
25-
let name = pack $ show n
26-
H.insert table name stmt
25+
let name = StatementName . pack $ show n
26+
H.insert table stmt name
2727
pure name
2828

src/Database/PostgreSQL/Protocol/Types.hs

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,15 @@
11
module Database.PostgreSQL.Protocol.Types where
22

33
import Data.Word (Word32, Word8)
4-
import Data.Int (Int32)
4+
import Data.Int (Int32, Int16)
5+
import Data.Hashable (Hashable)
56
import qualified Data.ByteString as B
67
import qualified Data.Vector as V
78

89
-- Common
9-
newtype Oid = Oid Int32 deriving (Show)
10+
newtype Oid = Oid { unOid :: Int32 } deriving (Show)
1011
newtype StatementName = StatementName B.ByteString deriving (Show)
11-
newtype StatementSQL = StatementSQL B.ByteString deriving (Show)
12+
newtype StatementSQL = StatementSQL B.ByteString deriving (Show, Eq, Hashable)
1213
newtype PortalName = PortalName B.ByteString deriving (Show)
1314
newtype ChannelName = ChannelName B.ByteString deriving (Show)
1415

@@ -21,7 +22,7 @@ newtype MD5Salt = MD5Salt Word32 deriving (Show)
2122
newtype ServerProccessId = ServerProcessId Int32 deriving (Show)
2223
newtype ServerSecretKey = ServerSecrecKey Int32 deriving (Show)
2324

24-
newtype RowsCount = RowsCount Word
25+
newtype RowsCount = RowsCount Word deriving (Show)
2526

2627
-- | Information about completed command.
2728
data CommandResult
@@ -34,6 +35,7 @@ data CommandResult
3435
| MoveCompleted RowsCount
3536
| FetchCompleted RowsCount
3637
| CopyCompleted RowsCount
38+
deriving (Show)
3739

3840
-- | Parameters of the current connection.
3941
-- We store only the parameters that cannot change after startup.
@@ -105,7 +107,7 @@ data ServerMessage
105107
= BackendKeyData ServerProccessId ServerSecretKey
106108
| BindComplete
107109
| CloseComplete
108-
| CommandComplete CommandTag
110+
| CommandComplete CommandResult
109111
| DataRow (V.Vector B.ByteString) -- the values of a result
110112
| EmptyQueryResponse
111113
| ErrorResponse ErrorDesc
@@ -175,7 +177,7 @@ data ErrorDesc = ErrorDesc
175177
, errorDataType :: Maybe B.ByteString
176178
, errorConstraint :: Maybe B.ByteString
177179
, errorSourceFilename :: Maybe B.ByteString
178-
, errorSourceLine :: Maybe B.Int
180+
, errorSourceLine :: Maybe Int
179181
, errorRoutine :: Maybe B.ByteString
180182
} deriving (Show)
181183

@@ -195,7 +197,7 @@ data NoticeDesc = NoticeDesc
195197
, noticeDataType :: Maybe B.ByteString
196198
, noticeConstraint :: Maybe B.ByteString
197199
, noticeSourceFilename :: Maybe B.ByteString
198-
, noticeSourceLine :: Maybe B.Int
200+
, noticeSourceLine :: Maybe Int
199201
, noticeRoutine :: Maybe B.ByteString
200202
} deriving (Show)
201203

0 commit comments

Comments
 (0)
0