ms-tds 0.1.0.3 → 0.1.0.4

raw patch · 7 files changed

+32/−28 lines, 7 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 +12/−16
• src/Database/Tds/Message/Client.hs +4/−3
• src/Database/Tds/Message/Header.hs +9/−2
• src/Database/Tds/Message/Prelogin.hs +2/−1
• src/Database/Tds/Message/Server.hs +0/−1
• src/Database/Tds/Transport.hs +3/−3

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

@@ -133,7 +133,6 @@                                                          ) where -import Data.Monoid((<>),mempty) import Control.Applicative((<$>),(<*>))  import qualified Data.ByteString as B@@ -166,27 +165,24 @@   putMessage :: Word8 -> LB.ByteString -> Put-putMessage pt bs = mapM_ (f pt) $ split packetSize bs+putMessage pt bs = mapM_ f $ split (packetSize -headerLength) bs   where-    f :: Word8 -> B.ByteString -> Put-    f pt bs = do+    f :: (Bool,LB.ByteString) -> Put+    f (isLast,bs) = do       let-        len = B.length bs-        flg = if len < (packetSize -8) then 0x01 else 0x00 -- last flag-      put $ Header pt flg (len +8) 0 0 0-      Put.putByteString bs+        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 -> [B.ByteString]+    split :: Int64 -> LB.ByteString -> [(Bool,LB.ByteString)]     split len lbs =       let-        (lbs',rem) = LB.splitAt (len + 8) lbs-        bs = LB.toStrict lbs'+        (lbs',rem) = LB.splitAt len lbs       in if LB.null rem-         then [bs]-         else-           let bss = split len rem-           in bs:bss +         then [(True,lbs')]+         else (False,lbs'): split len rem          -- [MEMO] 4096     packetSize :: Integral a => a@@ -200,7 +196,7 @@     f :: WriterT BB.Builder Get Word8     f = do       (Header pt flg len _ _ _) <- lift get-      tell =<< BB.byteString <$> (lift $ Get.getByteString (len -8))+      tell =<< BB.byteString <$> (lift $ Get.getByteString (fromIntegral $ len -8))       if flg == 0x01         then return pt         else f

@@ -23,7 +23,7 @@                                                                        ) where -import Data.Monoid((<>),mempty)+import Data.Monoid(mempty)  import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB@@ -179,7 +179,7 @@ login7Length :: Login7 -> Int login7Length x =   let-    bLen = sum $ map B.length $ login7Bytes1 x <> login7Bytes2 x+    bLen = (sum $ map B.length $ login7Bytes1 x) + (sum $ map B.length $ login7Bytes2 x)   in login7HeaderLength + bLen  @@ -215,7 +215,8 @@    --    Put.putWord32le 0 -- SSPI long  -- TDS 7.2 -  mapM_ Put.putByteString $ bytes1 <> bytes2 -- datas+  mapM_ Put.putByteString $ bytes1+  mapM_ Put.putByteString $ bytes2      where       putIndex :: Int -> B.ByteString -> Put.PutM Int

@@ -2,6 +2,7 @@ -- Packet Header:   https://msdn.microsoft.com/en-us/library/dd340948.aspx  module Database.Tds.Message.Header ( Header (..)+                                   , headerLength                                    ) where  import Data.Word (Word8(..),Word16(..),Word32(..),Word64(..))@@ -14,7 +15,7 @@  type Type = Word8 type Status = Word8-type Length = Int+type Length = Word16 type SPID = Word16 type PacketID = Word8 type Window = Word8@@ -41,9 +42,15 @@   spid <- Get.getWord16be -- SPID   pcid <- Get.getWord8    -- PacketIK   win  <- Get.getWord8    -- Window-  return $ Header pt st (fromIntegral len) spid pcid win+  return $ Header pt st len spid pcid win   instance Binary Header where   put = putHeader   get = getHeader+++headerLength :: Integral a => a+headerLength = fromIntegral 8++

@@ -14,7 +14,8 @@                                      , Nonce (..)                                      ) where -import Data.Monoid((<>),mempty)+import Data.Monoid(mempty)+ import Control.Applicative((<$>),(<*>))  import qualified Data.ByteString as B

@@ -64,7 +64,6 @@                                     ) where -import Data.Monoid((<>),mempty) import Control.Applicative((<$>),(<*>))  import qualified Data.ByteString as B

@@ -73,7 +73,7 @@           modifyMVar_ (getSendStep sock') (return . (+1))             where               appendBuff = modifyMVar_ (getSendBuff sock') (return . (<>bs))-              header bs = LB.toStrict $ encode $ Header 0x12 1 (B.length bs +8) 0 0 0+              header bs = LB.toStrict $ encode $ Header 0x12 1 (fromIntegral $ B.length bs +8) 0 0 0                    -- [MEMO] This doesn't work         -- [MEMO] Want to do this@@ -82,7 +82,7 @@             0x17 -> sendAll sock bs             _    -> sendAll sock $ (header bs) <> bs             where-              header bs = LB.toStrict $ encode $ Header 0x12 1 (B.length bs +8) 0 0 0+              header bs = LB.toStrict $ encode $ Header 0x12 1 (fromIntegral $ B.length bs +8) 0 0 0                     -- [MEMO] Remove TDS header@@ -98,7 +98,7 @@               recvDropBuff = do                 header <- recv sock 8                 let (Header _ _ totalLen _ _ _) = decode $ LB.fromStrict header-                body <- recv sock $ totalLen -8+                body <- recv sock $ fromIntegral $ totalLen -8                 let bs = B.take len body                 modifyMVar_ (getRecvBuff sock') (\_ -> return $ B.drop len body)                 return bs