File tree

18 files changed

+241
-144
lines changed

18 files changed

+241
-144
lines changed
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,6 @@ library
3737
, Database.PostgreSQL.Protocol.Codecs.PgTypes
3838
, Database.PostgreSQL.Protocol.Codecs.Time
3939
, Database.PostgreSQL.Protocol.Codecs.Numeric
40-
other-modules: Database.PostgreSQL.Protocol.Utils
4140
build-depends: base >= 4.7 && < 5
4241
, bytestring
4342
, socket
Original file line numberDiff line numberDiff line change
@@ -23,33 +23,34 @@ module Database.PostgreSQL.Driver.Connection
2323
, defaultFilter
2424
) where
2525

26-
import Data.Monoid ((<>))
27-
import Control.Monad (void, when)
28-
import Control.Concurrent (forkIOWithUnmask, killThread, ThreadId, threadDelay
29-
, mkWeakThreadId)
26+
import Data.Monoid ((<>))
27+
import Control.Concurrent (forkIOWithUnmask, killThread, ThreadId,
28+
threadDelay , mkWeakThreadId)
29+
import Control.Concurrent.STM (atomically)
3030
import Control.Concurrent.STM.TQueue (TQueue, writeTQueue, newTQueueIO)
31-
import Control.Concurrent.STM (atomically)
32-
import Control.Exception (SomeException, bracketOnError, catch, mask_,
33-
catch, throwIO)
34-
import GHC.Conc (labelThread)
35-
import Crypto.Hash (hash, Digest, MD5)
36-
import System.Mem.Weak (Weak, deRefWeak)
37-
import System.Socket (eBadFileDescriptor)
31+
import Control.Exception (SomeException, bracketOnError, catch,
32+
mask_, catch, throwIO)
33+
import Control.Monad (void, when)
34+
import GHC.Conc (labelThread)
35+
import System.Mem.Weak (Weak, deRefWeak)
36+
37+
import Crypto.Hash (hash, Digest, MD5)
38+
import System.Socket (eBadFileDescriptor)
3839
import qualified Data.HashMap.Strict as HM
3940
import qualified Data.ByteString as B
4041
import qualified Data.ByteString.Char8 as BS(pack, unpack)
4142

43+
import Database.PostgreSQL.Protocol.DataRows
4244
import Database.PostgreSQL.Protocol.Encoders
4345
import Database.PostgreSQL.Protocol.Decoders
4446
import Database.PostgreSQL.Protocol.Parsers
45-
import Database.PostgreSQL.Protocol.DataRows
4647
import Database.PostgreSQL.Protocol.Types
4748
import Database.PostgreSQL.Protocol.Store.Encode (runEncode, Encode)
4849
import Database.PostgreSQL.Protocol.Store.Decode (runDecode)
4950

51+
import Database.PostgreSQL.Driver.Error
5052
import Database.PostgreSQL.Driver.Settings
5153
import Database.PostgreSQL.Driver.StatementStorage
52-
import Database.PostgreSQL.Driver.Error
5354
import Database.PostgreSQL.Driver.RawConnection
5455

5556
-- | Public
Original file line numberDiff line numberDiff line change
@@ -17,9 +17,10 @@ module Database.PostgreSQL.Driver.Error
1717
, throwAuthErrorInIO
1818
) where
1919

20-
import Control.Exception (throwIO, Exception(..), SomeException)
21-
import Data.ByteString (ByteString)
22-
import System.Socket (AddressInfoException)
20+
import Control.Exception (throwIO, Exception(..), SomeException)
21+
22+
import Data.ByteString (ByteString)
23+
import System.Socket (AddressInfoException)
2324
import qualified Data.ByteString.Char8 as BS
2425

2526
import Database.PostgreSQL.Protocol.Types (ErrorDesc)
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,11 @@ module Database.PostgreSQL.Driver.RawConnection
44
, createRawConnection
55
) where
66

7-
import Control.Monad (void, when)
8-
import Control.Exception (bracketOnError, try)
9-
import Data.Monoid ((<>))
10-
import Foreign (castPtr, plusPtr)
7+
import Control.Monad (void, when)
8+
import Control.Exception (bracketOnError, try)
9+
import Data.Monoid ((<>))
10+
import Foreign (castPtr, plusPtr)
11+
1112
import System.Socket (socket, AddressInfo(..), getAddressInfo, socketAddress,
1213
aiV4Mapped, AddressInfoException, Socket, connect,
1314
close, receive, send)
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,8 @@ module Database.PostgreSQL.Driver.Settings
44
, defaultConnectionSettings
55
) where
66

7-
import Data.Word (Word16)
8-
import Data.ByteString (ByteString)
7+
import Data.Word (Word16)
8+
import Data.ByteString (ByteString)
99

1010
data TlsMode = RequiredTls | NoTls
1111
deriving (Show, Eq)
@@ -26,6 +26,7 @@ data ConnectionSettings = ConnectionSettings
2626
, settingsTls :: TlsMode
2727
} deriving (Show)
2828

29+
-- TODO change defaults
2930
defaultConnectionSettings :: ConnectionSettings
3031
defaultConnectionSettings = ConnectionSettings
3132
{ settingsHost = "localhost"
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,37 @@
1-
module Database.PostgreSQL.Protocol.Codecs.Decoders where
2-
3-
import Data.Word
4-
import Data.Int
5-
import Data.Maybe
6-
import Data.Char
7-
import Data.Scientific
8-
import Data.UUID (UUID, fromWords)
9-
import Data.Time (Day, UTCTime, LocalTime, DiffTime)
10-
import qualified Data.ByteString as B
1+
module Database.PostgreSQL.Protocol.Codecs.Decoders
2+
( dataRowHeader
3+
, getNonNullable
4+
, getNullable
5+
, FieldDecoder
6+
, bool
7+
, bytea
8+
, char
9+
, date
10+
, float4
11+
, float8
12+
, int2
13+
, int4
14+
, int8
15+
, interval
16+
, bsJsonText
17+
, bsJsonBytes
18+
, numeric
19+
, bsText
20+
, timestamp
21+
, timestamptz
22+
, uuid
23+
) where
24+
25+
import Prelude hiding (bool)
26+
import Control.Monad (replicateM, (<$!>))
27+
import Data.ByteString (ByteString)
28+
import Data.Char (chr)
29+
import Data.Int (Int16, Int32, Int64)
30+
import Data.Scientific (Scientific)
31+
import Data.Time (Day, UTCTime, LocalTime, DiffTime)
32+
import Data.UUID (UUID, fromWords)
1133
import qualified Data.Vector as V
1234

13-
import Control.Monad
14-
import Prelude hiding (bool)
15-
1635
import Database.PostgreSQL.Protocol.Store.Decode
1736
import Database.PostgreSQL.Protocol.Types
1837
import Database.PostgreSQL.Protocol.Codecs.Time
@@ -85,7 +104,7 @@ bool :: FieldDecoder Bool
85104
bool _ = (== 1) <$> getWord8
86105

87106
{-# INLINE bytea #-}
88-
bytea :: FieldDecoder B.ByteString
107+
bytea :: FieldDecoder ByteString
89108
bytea = getByteString
90109

91110
{-# INLINE char #-}
@@ -122,12 +141,12 @@ interval _ = intervalToDiffTime <$> getInt64BE <*> getInt32BE <*> getInt32BE
122141

123142
-- | Decodes representation of JSON as @ByteString@.
124143
{-# INLINE bsJsonText #-}
125-
bsJsonText :: FieldDecoder B.ByteString
144+
bsJsonText :: FieldDecoder ByteString
126145
bsJsonText = getByteString
127146

128147
-- | Decodes representation of JSONB as @ByteString@.
129148
{-# INLINE bsJsonBytes #-}
130-
bsJsonBytes :: FieldDecoder B.ByteString
149+
bsJsonBytes :: FieldDecoder ByteString
131150
bsJsonBytes len = getWord8 *> getByteString (len - 1)
132151

133152
{-# INLINE numeric #-}
@@ -142,7 +161,7 @@ numeric _ = do
142161

143162
-- | Decodes text without applying encoding.
144163
{-# INLINE bsText #-}
145-
bsText :: FieldDecoder B.ByteString
164+
bsText :: FieldDecoder ByteString
146165
bsText = getByteString
147166

148167
{-# INLINE timestamp #-}
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,30 @@
1-
module Database.PostgreSQL.Protocol.Codecs.Encoders where
2-
3-
import Data.Word
4-
import Data.Monoid ((<>))
5-
import Data.Int
6-
import Data.Char
7-
import Data.Scientific
8-
import Data.UUID (UUID, toWords)
9-
import Data.Time (Day, UTCTime, LocalTime, DiffTime)
10-
import qualified Data.ByteString as B
11-
import qualified Data.Vector as V
12-
13-
import Control.Monad
1+
module Database.PostgreSQL.Protocol.Codecs.Encoders
2+
( bool
3+
, bytea
4+
, char
5+
, date
6+
, float4
7+
, float8
8+
, int2
9+
, int4
10+
, int8
11+
, interval
12+
, bsJsonText
13+
, bsJsonBytes
14+
, numeric
15+
, bsText
16+
, timestamp
17+
, timestamptz
18+
, uuid
19+
) where
20+
21+
import Data.ByteString (ByteString)
22+
import Data.Char (ord)
23+
import Data.Int (Int16, Int32, Int64)
24+
import Data.Monoid ((<>))
25+
import Data.Scientific (Scientific)
26+
import Data.Time (Day, UTCTime, LocalTime, DiffTime)
27+
import Data.UUID (UUID, toWords)
1428

1529
import Database.PostgreSQL.Protocol.Store.Encode
1630
import Database.PostgreSQL.Protocol.Types
@@ -27,7 +41,7 @@ bool False = putWord8 0
2741
bool True = putWord8 1
2842

2943
{-# INLINE bytea #-}
30-
bytea :: B.ByteString -> Encode
44+
bytea :: ByteString -> Encode
3145
bytea = putByteString
3246

3347
{-# INLINE char #-}
@@ -65,12 +79,12 @@ interval v = let (mcs, days, months) = diffTimeToInterval v
6579

6680
-- | Encodes representation of JSON as @ByteString@.
6781
{-# INLINE bsJsonText #-}
68-
bsJsonText :: B.ByteString -> Encode
82+
bsJsonText :: ByteString -> Encode
6983
bsJsonText = putByteString
7084

7185
-- | Encodes representation of JSONB as @ByteString@.
7286
{-# INLINE bsJsonBytes #-}
73-
bsJsonBytes :: B.ByteString -> Encode
87+
bsJsonBytes :: ByteString -> Encode
7488
bsJsonBytes bs = putWord8 1 <> putByteString bs
7589

7690
{-# INLINE numeric #-}
@@ -85,7 +99,7 @@ numeric n =
8599

86100
-- | Encodes text.
87101
{-# INLINE bsText #-}
88-
bsText :: B.ByteString -> Encode
102+
bsText :: ByteString -> Encode
89103
bsText = putByteString
90104

91105
{-# INLINE timestamp #-}
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,17 @@
11
{-# language LambdaCase #-}
22

3-
module Database.PostgreSQL.Protocol.Codecs.Numeric where
3+
module Database.PostgreSQL.Protocol.Codecs.Numeric
4+
( scientificToNumeric
5+
, numericToScientific
6+
, toNumericSign
7+
, fromNumericSign
8+
) where
49

5-
import Data.Word (Word16)
6-
import Data.Int (Int16)
710
import Data.Foldable (foldl')
8-
import Data.Scientific (Scientific, scientific, base10Exponent, coefficient)
11+
import Data.Int (Int16)
912
import Data.List (unfoldr)
13+
import Data.Scientific (Scientific, scientific, base10Exponent, coefficient)
14+
import Data.Word (Word16)
1015

1116
{-# INLINE scientificToNumeric #-}
1217
scientificToNumeric :: Scientific -> (Word16, Int16, Word16, [Word16])
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,34 @@
11
{-
22
Oids for built-in types.
33
-}
4-
module Database.PostgreSQL.Protocol.Codecs.PgTypes where
4+
module Database.PostgreSQL.Protocol.Codecs.PgTypes
5+
( Oids(..)
6+
-- * Primitives
7+
, bool
8+
, bytea
9+
, char
10+
, date
11+
, float4
12+
, float8
13+
, int2
14+
, int4
15+
, int8
16+
, interval
17+
, json
18+
, jsonb
19+
, numeric
20+
, text
21+
, timestamp
22+
, timestamptz
23+
, uuid
24+
-- * Ranges
25+
, daterange
26+
, int4range
27+
, int8range
28+
, numrange
29+
, tsrange
30+
, tstzrange
31+
) where
532

633
import Data.Word (Word32)
734

Original file line numberDiff line numberDiff line change
@@ -50,7 +50,6 @@ intervalToDiffTime mcs days months = picosecondsToDiffTime . mcsToPcs $
5050
microsInDay * (fromIntegral months * daysInMonth + fromIntegral days)
5151
+ fromIntegral mcs
5252

53-
-- TODO consider adjusted encoding
5453
{-# INLINE diffTimeToInterval #-}
5554
diffTimeToInterval :: DiffTime -> (Int64, Int32, Int32)
5655
diffTimeToInterval dt = (fromIntegral $ diffTimeToMcs dt, 0, 0)
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# language ForeignFunctionInterface #-}
12
module Database.PostgreSQL.Protocol.DataRows
23
( loopExtractDataRows
34
, countDataRows
@@ -6,22 +7,24 @@ module Database.PostgreSQL.Protocol.DataRows
67
, decodeOneRow
78
) where
89

9-
import Data.Monoid ((<>))
10-
import Data.Word (Word8, byteSwap32)
11-
import Foreign (peek, peekByteOff, castPtr)
10+
import Data.Foldable (traverse_)
11+
import Data.Monoid ((<>))
12+
import Data.Word (Word8, byteSwap32)
13+
import Foreign (Ptr, alloca, peek, peekByteOff, castPtr)
14+
import Foreign.C.Types (CInt, CSize(..), CChar, CULong)
15+
import Foreign (Ptr, peek, alloca)
16+
import System.IO.Unsafe (unsafePerformIO)
17+
1218
import qualified Data.ByteString as B
1319
import qualified Data.ByteString.Unsafe as B
1420
import qualified Data.Vector as V
1521
import qualified Data.Vector.Mutable as MV
1622
import qualified Data.List as L
17-
import Data.Foldable
18-
import System.IO.Unsafe
1923

2024
import Database.PostgreSQL.Driver.Error
2125
import Database.PostgreSQL.Protocol.Types
2226
import Database.PostgreSQL.Protocol.Parsers
2327
import Database.PostgreSQL.Protocol.Store.Decode
24-
import Database.PostgreSQL.Protocol.Utils
2528

2629
-- Optimized loop for extracting chunks of DataRows.
2730
-- Ignores all messages from database that do not relate to data.
@@ -188,3 +191,29 @@ countDataRows = foldlDataRows (\acc (DataChunk c _) -> acc + c) 0
188191
{-# INLINE flattenDataRows #-}
189192
flattenDataRows :: DataRows -> B.ByteString
190193
flattenDataRows = foldlDataRows (\acc (DataChunk _ bs) -> acc <> bs) ""
194+
195+
--
196+
-- C utils
197+
--
198+
199+
data ScanRowResult = ScanRowResult
200+
{-# UNPACK #-} !DataChunk -- chunk of datarows, may be empty
201+
{-# UNPACK #-} !B.ByteString -- the rest of string
202+
{-# UNPACK #-} !Int -- reason code
203+
204+
-- | Scans `ByteString` for a chunk of `DataRow`s.
205+
{-# INLINE scanDataRows #-}
206+
scanDataRows :: B.ByteString -> IO ScanRowResult
207+
scanDataRows bs =
208+
alloca $ \countPtr ->
209+
alloca $ \reasonPtr ->
210+
B.unsafeUseAsCStringLen bs $ \(ptr, len) -> do
211+
offset <- fromIntegral <$>
212+
c_scan_datarows ptr (fromIntegral len) countPtr reasonPtr
213+
reason <- fromIntegral <$> peek reasonPtr
214+
count <- fromIntegral <$> peek countPtr
215+
let (ch, rest) = B.splitAt offset bs
216+
pure $ ScanRowResult (DataChunk count ch) rest reason
217+
218+
foreign import ccall unsafe "static pw_utils.h scan_datarows" c_scan_datarows
219+
:: Ptr CChar -> CSize -> Ptr CULong -> Ptr CInt -> IO CSize

0 commit comments

Comments
 (0)