ms-tds 0.1.0.4 → 0.2.0.0

raw patch · 5 files changed

+119/−82 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ms-tds.cabal +2/−2
• src/Database/Tds/Message.hs +19/−48
• src/Database/Tds/Message/Client.hs +28/−23
• src/Database/Tds/Message/Header.hs +65/−4
• src/Database/Tds/Message/Prelogin.hs +5/−5

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 62ef4732f490b492580886e66b1c89efb43e06a9d005a2c6f326e6b1ea894943+-- hash: 49394a8278191a141ae8a27d9e19f2c2d1bbab3d689aa2454d6b9b44ae2312e9  name:           ms-tds-version:        0.1.0.4+version:        0.2.0.0 synopsis:       TDS Protocol implemented in Haskell description:    Please see the README on GitHub at <https://github.com/mitsuji/ms-tds#readme> category:       Database

@@ -2,8 +2,25 @@                               ClientMessage (..)                                                            -- ** Login-                            , Login7 (..)+                            , Login7                             , defaultLogin7+                            , l7ConnectionID+                            , l7OptionFlags1+                            , l7OptionFlags2+                            , l7OptionFlags3+                            , l7TypeFlags+                            , l7TimeZone+                            , l7Collation+                            , l7Language+                            , l7ClientPID+                            , l7ClientMacAddr+                            , l7ClientHostName+                            , l7AppName+                            , l7ServerName+                            , l7UserName+                            , l7Password+                            , l7Database+                            , tdsVersion                                                          -- ** SQL Batch                             , SqlBatch (..)@@ -133,11 +150,7 @@                                                          ) where -import Control.Applicative((<$>),(<*>))--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LB-import qualified Data.ByteString.Builder as BB+import Control.Applicative((<$>))  import Data.Word (Word8(..),Word16(..),Word32(..),Word64(..)) import Data.Int (Int8(..),Int16(..),Int32(..),Int64(..))@@ -146,9 +159,6 @@ import qualified Data.Binary.Put as Put import qualified Data.Binary.Get as Get -import Control.Monad.Writer (WriterT(..),runWriterT,tell)-import Control.Monad.Trans (lift)- import Database.Tds.Primitives.Null import Database.Tds.Primitives.Decimal import Database.Tds.Primitives.Money@@ -161,45 +171,6 @@ import Database.Tds.Message.Server  ----putMessage :: Word8 -> LB.ByteString -> Put-putMessage pt bs = mapM_ f $ split (packetSize -headerLength) bs-  where-    f :: (Bool,LB.ByteString) -> Put-    f (isLast,bs) = do-      let-        len = (fromIntegral $ LB.length bs) + headerLength-        flg = if isLast then 0x01 else 0x00 -- last flag-      put $ Header pt flg len 0 0 0-      Put.putLazyByteString bs--  -    split :: Int64 -> LB.ByteString -> [(Bool,LB.ByteString)]-    split len lbs =-      let-        (lbs',rem) = LB.splitAt len lbs-      in if LB.null rem-         then [(True,lbs')]-         else (False,lbs'): split len rem-    -    -- [MEMO] 4096-    packetSize :: Integral a => a-    packetSize = fromIntegral $ l7PacketSize defaultLogin7--  --getMessage :: Get (Word8,LB.ByteString)-getMessage = (\(pt,bs) -> (pt,BB.toLazyByteString bs)) <$> runWriterT f-  where-    f :: WriterT BB.Builder Get Word8-    f = do-      (Header pt flg len _ _ _) <- lift get-      tell =<< BB.byteString <$> (lift $ Get.getByteString (fromIntegral $ len -8))-      if flg == 0x01-        then return pt-        else f   

@@ -5,8 +5,24 @@ -- Client Messages: https://msdn.microsoft.com/en-us/library/dd341027.aspx  -module Database.Tds.Message.Client ( Login7 (..)+module Database.Tds.Message.Client ( Login7                                    , defaultLogin7+                                   , l7ConnectionID+                                   , l7OptionFlags1+                                   , l7OptionFlags2+                                   , l7OptionFlags3+                                   , l7TypeFlags+                                   , l7TimeZone+                                   , l7Collation+                                   , l7Language+                                   , l7ClientPID+                                   , l7ClientMacAddr+                                   , l7ClientHostName+                                   , l7AppName+                                   , l7ServerName+                                   , l7UserName+                                   , l7Password+                                   , l7Database                                                                        , SqlBatch (..)                                    @@ -42,6 +58,7 @@  import Control.Monad (foldM,foldM_) +import Database.Tds.Message.Header import Database.Tds.Message.Prelogin import Database.Tds.Message.DataStream import Database.Tds.Primitives.Collation@@ -74,22 +91,20 @@             deriving (Show)  defaultLogin7 :: Login7-defaultLogin7 = Login7 { l7TdsVersion = 0x71000001-                         , l7PacketSize = 4096-                         , l7ClientProgVer = 0x0683f2f8+defaultLogin7 = Login7 { l7TdsVersion = tdsVersion+                         , l7PacketSize = packetSize+                         , l7ClientProgVer = 0x0683f2f8  -- [MEMO] 0x00000007                          , l7ConnectionID = 0                          , l7OptionFlags1 = 0x80 + 0x40 + 0x20-                         , l7OptionFlags2 = 0+                         , l7OptionFlags2 = 0  -- [MEMO] 0x02 + 0x01++                          , l7OptionFlags3 = 0                          , l7TypeFlags = 0---                         , l7TimeZone = -120-                         , l7TimeZone = 0---                         , l7Collation = 0x36040000---                         , l7Collation = 0x1104d000-                         , l7Collation = 0x00000000-                         , l7CltIntName = T.pack "DB-Library" -- "OLEDB", "ODBC"-                         , l7Language = mempty---                         , l7Language = T.pack "us_english"+                         , l7TimeZone = 0  -- [MEMO] -120+                         , l7Collation = 0x00000000  -- [MEMO] 0x36040000, 0x1104d000, 0x09040000+                         , l7CltIntName = T.pack "DB-Library" -- [MDMO] "OLEDB", "ODBC"+                         , l7Language = mempty -- [MEMO] "us_english"                          , l7ClientPID = 0                          , l7ClientMacAddr = mempty                          , l7ClientHostName = mempty@@ -188,26 +203,16 @@ putLogin7 x = do   Put.putWord32le $ fromIntegral plLen  -- payload length   Put.putWord32le $ l7TdsVersion x---	enum {---		tds70Version = 0x70000000,---		tds71Version = 0x71000001,---		tds72Version = 0x72090002,---		tds73Version = 0x730B0003,---		tds74Version = 0x74000004,---	};   Put.putWord32le $ l7PacketSize x    -- packet size   Put.putWord32le $ l7ClientProgVer x -- client program version---  Put.putWord32be 0x00000007          -- client program version   Put.putWord32le $ l7ClientPID x     -- client pid   Put.putWord32le $ l7ConnectionID x  -- connect id   Put.putWord8 $ l7OptionFlags1 x     -- flag1   Put.putWord8 $ l7OptionFlags2 x     -- flag2---  Put.putWord8 $ 0x02 + 0x01          -- flag2   Put.putWord8 $ l7TypeFlags x        -- sql type   Put.putWord8 $ l7OptionFlags3 x     -- flag3   Put.putInt32le $ l7TimeZone x       -- tz   Put.putWord32be $ l7Collation x     -- collation---  Put.putWord32be $ 0x09040000        -- collation    offs <- foldM putIndex plHLen bytes1  -- index 1st-half   Put.putByteString $ l7ClientMacAddr x -- mac address

@@ -1,10 +1,18 @@ {-# OPTIONS_HADDOCK hide #-} -- Packet Header:   https://msdn.microsoft.com/en-us/library/dd340948.aspx -module Database.Tds.Message.Header ( Header (..)-                                   , headerLength+module Database.Tds.Message.Header ( packetSize+                                   , tdsVersion+                                   , Header (..)+                                   , putMessage+                                   , getMessage                                    ) where +import Control.Applicative((<$>))++import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Builder as BB+ import Data.Word (Word8(..),Word16(..),Word32(..),Word64(..)) import Data.Int (Int8(..),Int16(..),Int32(..),Int64(..)) @@ -12,7 +20,10 @@ import qualified Data.Binary.Put as Put import qualified Data.Binary.Get as Get +import Control.Monad.Writer (WriterT(..),runWriterT,tell)+import Control.Monad.Trans (lift) + type Type = Word8 type Status = Word8 type Length = Word16@@ -23,6 +34,24 @@ data Header = Header !Type !Status !Length !SPID !PacketID !Window  +headerLength :: Integral a => a+headerLength = fromIntegral 8++packetSize :: Integral a => a+packetSize = fromIntegral 4096++tdsVersion :: Word32+tdsVersion = 0x71000001++-- [MEMO]+-- tds70Version = 0x70000000+-- tds71Version = 0x71000001+-- tds72Version = 0x72090002+-- tds73Version = 0x730B0003+-- tds74Version = 0x74000004+++ -- https://msdn.microsoft.com/en-us/library/dd340948.aspx putHeader :: Header -> Put putHeader (Header pt st len spid pcid win) = do@@ -50,7 +79,39 @@   get = getHeader  -headerLength :: Integral a => a-headerLength = fromIntegral 8++putMessage :: Word8 -> LB.ByteString -> Put+putMessage pt bs = mapM_ f $ split (packetSize -headerLength) bs+  where+    f :: (Bool,LB.ByteString) -> Put+    f (isLast,bs) = do+      let+        len = (fromIntegral $ LB.length bs) + headerLength+        flg = if isLast then 0x01 else 0x00 -- last flag+      put $ Header pt flg len 0 0 0+      Put.putLazyByteString bs+++    split :: Int64 -> LB.ByteString -> [(Bool,LB.ByteString)]+    split len lbs =+      let+        (lbs',rem) = LB.splitAt len lbs+      in if LB.null rem+         then [(True,lbs')]+         else (False,lbs'): split len rem+++++getMessage :: Get (Word8,LB.ByteString)+getMessage = (\(pt,bs) -> (pt,BB.toLazyByteString bs)) <$> runWriterT f+  where+    f :: WriterT BB.Builder Get Word8+    f = do+      (Header pt flg len _ _ _) <- lift get+      tell =<< BB.byteString <$> (lift $ Get.getByteString (fromIntegral $ len -8))+      if flg == 0x01+        then return pt+        else f  

@@ -46,7 +46,7 @@   data PreloginOption = PLOVersion !MajorVer !MinorVer !BuildVer !SubBuildVer-                    | PLOEncription !Word8  -- [TODO] flags+                    | PLOEncryption !Word8  -- [TODO] flags                     | PLOInstopt !B.ByteString                     | PLOThreadid !(Maybe Threadid)                     | PLOMars !Word8  -- MARS(Multiple Active Result Sets) supprt -- [TODO] flags@@ -67,7 +67,7 @@ preloginOptionPayloadLength = f   where     f (PLOVersion _ _ _ _)   = 1 + 1 + 4-    f (PLOEncription _)      = 1+    f (PLOEncryption _)      = 1     f (PLOInstopt io)        = B.length io + 1     f (PLOThreadid _)        = 4     f (PLOMars _)            = 1@@ -87,7 +87,7 @@       let         ot = case op of           PLOVersion _ _ _ _   -> 0x00-          PLOEncription _      -> 0x01+          PLOEncryption _      -> 0x01           PLOInstopt _         -> 0x02           PLOThreadid _        -> 0x03           PLOMars _            -> 0x04@@ -107,7 +107,7 @@       Put.putWord16be b       Put.putWord16be sb         -    putOpt (PLOEncription enc) = Put.putWord8 enc+    putOpt (PLOEncryption enc) = Put.putWord8 enc              putOpt (PLOInstopt io) = do       Put.putByteString io@@ -170,7 +170,7 @@                                <*> Get.getWord16be                                <*> Get.getWord16be                                -    getOpt 0x01 _ = PLOEncription <$> Get.getWord8+    getOpt 0x01 _ = PLOEncryption <$> Get.getWord8          getOpt 0x02 len = -- [MEMO] null terminated string       if len == 1