ms-tds 0.1.0.1 → 0.1.0.2
raw patch · 9 files changed
+164/−103 lines, 9 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Database.Tds.Message: TSOther :: !Word8 -> TokenStream
+ Database.Tds.Message: AltRowData :: AltRowData
+ Database.Tds.Message: data AltRowData
- Database.Tds.Message: TSAltRow :: TokenStream
+ Database.Tds.Message: TSAltRow :: !AltRowData -> TokenStream
- Database.Tds.Message: type DoneRowCount = Word32
+ Database.Tds.Message: type DoneRowCount = Int32
Files
- README.md +0/−1
- ms-tds.cabal +2/−2
- src/Database/Tds/Message.hs +5/−0
- src/Database/Tds/Message/Client.hs +3/−0
- src/Database/Tds/Message/DataStream.hs +77/−55
- src/Database/Tds/Message/Prelogin.hs +1/−0
- src/Database/Tds/Message/Server.hs +74/−45
- src/Database/Tds/Primitives/Collation.hs +1/−0
- src/Database/Tds/Transport.hs +1/−0
README.md view
@@ -48,7 +48,6 @@ * Implement data types * AltMetaData * AltRow- * ColInfo * Implement [Binary.put](http://hackage.haskell.org/package/binary-0.10.0.0/docs/Data-Binary.html#v:put)
ms-tds.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 153790241105911a205f4c88096f32d522fbb3262222de0f525f2f958a5dad79+-- hash: 1cdf9ff7b298d7db7c17d324be7f9387fbcc28b4b989329cf96751a8e3ae7c96 name: ms-tds-version: 0.1.0.1+version: 0.1.0.2 synopsis: TDS Protocol implemented in Haskell description: Please see the README on GitHub at <https://github.com/mitsuji/ms-tds#readme> category: Database
src/Database/Tds/Message.hs view
@@ -30,6 +30,9 @@ -- ** AltMetaData , AltMetaData (..) + -- ** AltRowData+ , AltRowData (..)+ -- ** ColProperty , ColProperty (..) , CPColNum (..)@@ -196,6 +199,7 @@ +-- | [\[MS-TDS\] 2.2.1 Client Messages](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/7ea9ee1a-b461-41f2-9004-141c0e712935) data ClientMessage = CMPrelogin !Prelogin | CMLogin7 !Login7 | CMSqlBatch !SqlBatch@@ -243,6 +247,7 @@ _ -> fail "getServerMessageInstance: invalid packet type" +-- | [\[MS-TDS\] 2.2.2 Server Messages](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/342f4cbb-2b4b-489c-8b63-f99b12021a94) newtype ServerMessage a = ServerMessage a deriving (Show)
src/Database/Tds/Message/Client.hs view
@@ -49,6 +49,7 @@ +-- | [\[MS-TDS\] 2.2.6.4 LOGIN7](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/773a62b6-ee89-4c02-9e5e-344882630aac) data Login7 = Login7 { l7TdsVersion :: !Word32 , l7PacketSize :: !Word32 , l7ClientProgVer :: !Word32@@ -243,6 +244,7 @@ +-- | [\[MS-TDS\] 2.2.6.7 SQLBatch](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/f2026cd3-9a46-4a3f-9a08-f63140bcbbe3) newtype SqlBatch = SqlBatch T.Text deriving (Show) @@ -276,6 +278,7 @@ deriving (Show) +-- | [\[MS-TDS\] 2.2.6.6 RPC Request](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/619c43b6-9495-4a58-9e49-a4950db245b3) newtype RpcRequest = RpcRequest [RpcReqBatch] deriving (Show)
src/Database/Tds/Message/DataStream.hs view
@@ -19,6 +19,8 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT import Data.Word (Word8(..),Word16(..),Word32(..),Word64(..)) import Data.Int (Int8(..),Int16(..),Int32(..),Int64(..))@@ -42,6 +44,7 @@ +-- | [\[MS-TDS\] 2.2.5.4 Data Type Definitions](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/ffb02215-af07-4b50-8545-1fd522106c68) data TypeInfo = TINull -- 0x1f | TIBit -- 0x32 | TIInt1 -- 0x30@@ -311,7 +314,7 @@ -type RawBytes = Maybe B.ByteString+type RawBytes = Maybe LB.ByteString getRawBytes :: TypeInfo -> Get RawBytes getRawBytes = f@@ -322,42 +325,42 @@ len <- Get.getWord8 if len == 0 then return Nothing- else Just <$> (Get.getByteString $ fromIntegral len)+ else Just <$> (Get.getLazyByteString $ fromIntegral len) get8s :: Get RawBytes get8s = do len <- Get.getWord8 if len == 0xff then return Nothing- else Just <$> (Get.getByteString $ fromIntegral len)+ else Just <$> (Get.getLazyByteString $ fromIntegral len) get16s :: Get RawBytes get16s = do len <- Get.getWord16le if len == 0xffff then return Nothing- else Just <$> (Get.getByteString $ fromIntegral len)+ else Just <$> (Get.getLazyByteString $ fromIntegral len) get32s :: Get RawBytes get32s = do len <- Get.getWord32le if len == 0xffffffff then return Nothing- else Just <$> (Get.getByteString $ fromIntegral len)+ else Just <$> (Get.getLazyByteString $ fromIntegral len) f :: TypeInfo -> Get RawBytes f TINull = return Nothing- f TIBit = Just <$> Get.getByteString 1- f TIInt1 = Just <$> Get.getByteString 1- f TIInt2 = Just <$> Get.getByteString 2- f TIInt4 = Just <$> Get.getByteString 4- f TIInt8 = Just <$> Get.getByteString 8- f TIMoney4 = Just <$> Get.getByteString 4- f TIMoney8 = Just <$> Get.getByteString 8- f TIDateTime4 = Just <$> Get.getByteString 4- f TIDateTime8 = Just <$> Get.getByteString 8- f TIFlt4 = Just <$> Get.getByteString 4- f TIFlt8 = Just <$> Get.getByteString 8+ f TIBit = Just <$> Get.getLazyByteString 1+ f TIInt1 = Just <$> Get.getLazyByteString 1+ f TIInt2 = Just <$> Get.getLazyByteString 2+ f TIInt4 = Just <$> Get.getLazyByteString 4+ f TIInt8 = Just <$> Get.getLazyByteString 8+ f TIMoney4 = Just <$> Get.getLazyByteString 4+ f TIMoney8 = Just <$> Get.getLazyByteString 8+ f TIDateTime4 = Just <$> Get.getLazyByteString 4+ f TIDateTime8 = Just <$> Get.getLazyByteString 8+ f TIFlt4 = Just <$> Get.getLazyByteString 4+ f TIFlt8 = Just <$> Get.getLazyByteString 8 f TIBitN = get8n f TIIntN1 = get8n@@ -400,26 +403,26 @@ put8n :: RawBytes -> Put put8n Nothing = Put.putWord8 0 put8n (Just bs) = do- Put.putWord8 $ fromIntegral $ B.length bs- Put.putByteString bs+ Put.putWord8 $ fromIntegral $ LB.length bs+ Put.putLazyByteString bs put8s :: RawBytes -> Put put8s Nothing = Put.putWord8 0xff put8s (Just bs) = do- Put.putWord8 $ fromIntegral $ B.length bs- Put.putByteString bs+ Put.putWord8 $ fromIntegral $ LB.length bs+ Put.putLazyByteString bs put16s :: RawBytes -> Put put16s Nothing = Put.putWord16le 0xffff put16s (Just bs) = do- Put.putWord16le $ fromIntegral $ B.length bs- Put.putByteString bs+ Put.putWord16le $ fromIntegral $ LB.length bs+ Put.putLazyByteString bs put32s :: RawBytes -> Put put32s Nothing = Put.putWord32le 0xffffffff put32s (Just bs) = do- Put.putWord32le $ fromIntegral $ B.length bs- Put.putByteString bs+ Put.putWord32le $ fromIntegral $ LB.length bs+ Put.putLazyByteString bs g :: TypeInfo -> RawBytes -> Put@@ -437,17 +440,17 @@ g TIFlt4 Nothing = error "putRawBytes: Nothing is not convertible to TIFlt4" g TIFlt8 Nothing = error "putRawBytes: Nothing is not convertible to TIFlt8" - g TIBit (Just bs) = Put.putByteString bs- g TIInt1 (Just bs) = Put.putByteString bs- g TIInt2 (Just bs) = Put.putByteString bs- g TIInt4 (Just bs) = Put.putByteString bs- g TIInt8 (Just bs) = Put.putByteString bs- g TIMoney4 (Just bs) = Put.putByteString bs- g TIMoney8 (Just bs) = Put.putByteString bs- g TIDateTime4 (Just bs) = Put.putByteString bs- g TIDateTime8 (Just bs) = Put.putByteString bs- g TIFlt4 (Just bs) = Put.putByteString bs- g TIFlt8 (Just bs) = Put.putByteString bs+ g TIBit (Just bs) = Put.putLazyByteString bs+ g TIInt1 (Just bs) = Put.putLazyByteString bs+ g TIInt2 (Just bs) = Put.putLazyByteString bs+ g TIInt4 (Just bs) = Put.putLazyByteString bs+ g TIInt8 (Just bs) = Put.putLazyByteString bs+ g TIMoney4 (Just bs) = Put.putLazyByteString bs+ g TIMoney8 (Just bs) = Put.putLazyByteString bs+ g TIDateTime4 (Just bs) = Put.putLazyByteString bs+ g TIDateTime8 (Just bs) = Put.putLazyByteString bs+ g TIFlt4 (Just bs) = Put.putLazyByteString bs+ g TIFlt8 (Just bs) = Put.putLazyByteString bs g TIBitN rb = put8n rb g TIIntN1 rb = put8n rb@@ -736,23 +739,24 @@ -runGet :: Get a -> B.ByteString -> a-runGet f bs = Get.runGet f $ LB.fromStrict bs+runGet :: Get a -> LB.ByteString -> a+runGet f bs = Get.runGet f bs -runPut :: Put -> B.ByteString-runPut f = LB.toStrict $ Put.runPut f+runPut :: Put -> LB.ByteString+runPut f = Put.runPut f -runGetBool :: TypeInfo -> B.ByteString -> Bool+runGetBool :: TypeInfo -> LB.ByteString -> Bool runGetBool ti bs = (/=0) $ runGet (getIntegral ti) bs -runPutBool :: TypeInfo -> Bool -> B.ByteString+runPutBool :: TypeInfo -> Bool -> LB.ByteString runPutBool ti b = runPut $ putIntegral ti $ if b then 1 else 0 -- [TODO] check nullable flag +-- | [\[MS-TDS\] 2.2.5.5.1 System Data Type Values](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/5773bd3e-a8cf-45cc-a058-3fd3ec3a8aff) class Data a where fromRawBytes :: TypeInfo -> RawBytes -> a toRawBytes :: TypeInfo -> a -> RawBytes@@ -803,7 +807,7 @@ instance Data Decimal where fromRawBytes ti (Just bs) = withValidDecimal ti $ \vt -> let (p,s) = ps vt- in runGet (getDecimal (B.length bs) p s) bs+ in runGet (getDecimal (fromIntegral $ LB.length bs) p s) bs where ps :: TypeInfo -> (Precision,Scale) ps (TIDecimalN p s) = (p,s)@@ -812,24 +816,34 @@ toRawBytes ti dec = withValidDecimal ti $ \_ -> Just $ runPut $ putDecimal dec instance Data UUID where- fromRawBytes ti (Just bs) = withValidUUID ti $ \_ -> case UUID.fromByteString $ LB.fromStrict bs of+ fromRawBytes ti (Just bs) = withValidUUID ti $ \_ -> case UUID.fromByteString bs of Nothing -> error "UUID.fromRawBytes: UUID.fromBtyteString error" Just (uuid) -> uuid fromRawBytes ti Nothing = withValidUUID ti $ \_ -> error "UUID.fromRawBytes: Null value is not convertible to UUID"- toRawBytes ti uuid = withValidUUID ti $ \_ -> Just $ LB.toStrict $ UUID.toByteString uuid+ toRawBytes ti uuid = withValidUUID ti $ \_ -> Just $ UUID.toByteString uuid instance Data B.ByteString where- fromRawBytes ti (Just bs) = withValidByteString ti $ \_ -> bs+ fromRawBytes ti (Just bs) = withValidByteString ti $ \_ -> LB.toStrict bs fromRawBytes ti Nothing = withValidByteString ti $ \_ -> error "ByteString.fromRawBytes: Null value is not convertible to ByteString"- toRawBytes ti bs = withValidByteString ti $ \_ -> Just $ bs+ toRawBytes ti bs = withValidByteString ti $ \_ -> Just $ LB.fromStrict bs instance Data T.Text where- fromRawBytes ti (Just bs) = withValidText ti $ \_ -> T.decodeUtf16LE bs+ fromRawBytes ti (Just bs) = withValidText ti $ \_ -> T.decodeUtf16LE $ LB.toStrict bs fromRawBytes ti Nothing = withValidText ti $ \_ -> error "Text.fromRawBytes: Null value is not convertible to Text"- toRawBytes ti t = withValidText ti $ \_ -> Just $ T.encodeUtf16LE t+ toRawBytes ti t = withValidText ti $ \_ -> Just $ LB.fromStrict $ T.encodeUtf16LE t +instance Data LB.ByteString where+ fromRawBytes ti (Just bs) = withValidByteString ti $ \_ -> bs+ fromRawBytes ti Nothing = withValidByteString ti $ \_ -> error "ByteString.fromRawBytes: Null value is not convertible to ByteString"+ toRawBytes ti bs = withValidByteString ti $ \_ -> Just bs +instance Data LT.Text where+ fromRawBytes ti (Just bs) = withValidText ti $ \_ -> LT.decodeUtf16LE bs+ fromRawBytes ti Nothing = withValidText ti $ \_ -> error "Text.fromRawBytes: Null value is not convertible to Text"+ toRawBytes ti t = withValidText ti $ \_ -> Just $ LT.encodeUtf16LE t ++ instance Data (Maybe Bool) where fromRawBytes ti rb = withValidBool ti $ \vt -> runGetBool vt <$> rb toRawBytes ti b = withValidBool ti $ \vt ->@@ -882,7 +896,7 @@ instance Data (Maybe Decimal) where fromRawBytes ti rb = withValidDecimal ti $ \vt -> let (p,s) = ps vt- in (\bs -> runGet (getDecimal (B.length bs) p s) bs) <$> rb+ in (\bs -> runGet (getDecimal (fromIntegral $ LB.length bs) p s) bs) <$> rb where ps :: TypeInfo -> (Precision,Scale) ps (TIDecimalN p s) = (p,s)@@ -892,18 +906,26 @@ instance Data (Maybe UUID) where fromRawBytes ti rb = withValidUUID ti $ \_ -> f <$> rb where- f :: B.ByteString -> UUID- f bs = case UUID.fromByteString $ LB.fromStrict bs of+ f :: LB.ByteString -> UUID+ f bs = case UUID.fromByteString bs of Nothing -> error "(Maybe UUID).fromRawBytes: UUID.fromBtyteString error" Just (uuid) -> uuid- toRawBytes ti m = withValidUUID ti $ \_ -> (LB.toStrict . UUID.toByteString) <$> m+ toRawBytes ti m = withValidUUID ti $ \_ -> UUID.toByteString <$> m instance Data (Maybe B.ByteString) where+ fromRawBytes ti rb = withValidByteString ti $ \_ -> LB.toStrict <$> rb+ toRawBytes ti bs = withValidByteString ti $ \_ -> LB.fromStrict <$> bs+ +instance Data (Maybe T.Text) where+ fromRawBytes ti rb = withValidText ti $ \_ -> T.decodeUtf16LE . LB.toStrict <$> rb + toRawBytes ti t = withValidText ti $ \_ -> LB.fromStrict . T.encodeUtf16LE <$> t++instance Data (Maybe LB.ByteString) where fromRawBytes ti rb = withValidByteString ti $ \_ -> rb toRawBytes ti bs = withValidByteString ti $ \_ -> bs -instance Data (Maybe T.Text) where- fromRawBytes ti rb = withValidText ti $ \_ -> T.decodeUtf16LE <$> rb - toRawBytes ti t = withValidText ti $ \_ -> T.encodeUtf16LE <$> t+instance Data (Maybe LT.Text) where+ fromRawBytes ti rb = withValidText ti $ \_ -> LT.decodeUtf16LE <$> rb + toRawBytes ti t = withValidText ti $ \_ -> LT.encodeUtf16LE <$> t
src/Database/Tds/Message/Prelogin.hs view
@@ -53,6 +53,7 @@ | PLONonceOpt !Nonce deriving (Show) +-- | [\[MS-TDS\] 2.2.6.5 PRELOGIN](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/60f56408-0188-4cd5-8b90-25c6f2423868) newtype Prelogin = Prelogin [PreloginOption] deriving (Show)
src/Database/Tds/Message/Server.hs view
@@ -9,6 +9,7 @@ , TokenStream (..) , AltMetaData (..)+ , AltRowData (..) , ColProperty (..) , CPColNum (..)@@ -112,10 +113,15 @@ deriving (Show) +-- [TODO] implement data type data AltMetaData = AltMetaData deriving (Show) +-- [TODO] implement data type+data AltRowData = AltRowData+ deriving (Show) + type OffsetIdentifier = Word16 type OffsetLength = Word16 @@ -136,8 +142,6 @@ deriving (Show) --- COLMETADATA_TOKEN, ALTMETDATA_TOKEN, OFFSET_TOKEN- type CPColNum = Word8 type CPTableNum = Word8 type CPStatus = Word8@@ -147,7 +151,7 @@ type DoneStatus = Word16 type DoneCurCmd = Word16-type DoneRowCount = Word32 -- Word64 -- TDS 7.2+type DoneRowCount = Int32 -- [MEMO] TDS 7.2 -> Word64 data Done = Done !DoneStatus !DoneCurCmd !DoneRowCount deriving (Show) @@ -161,7 +165,7 @@ type InfoMsgText = T.Text type InfoServerName = T.Text type InfoProcName = T.Text-type InfoLineNumber = Word16 -- Word32 -- TDS 7.2+type InfoLineNumber = Word16 -- [MEMO] TDS 7.2 -> (error:Int32,info:Word32) data Info = Info !InfoNumber !InfoState !InfoClass !InfoMsgText !InfoServerName !InfoProcName !InfoLineNumber deriving (Show) @@ -170,44 +174,62 @@ type LAProgName = T.Text type LAProgVersion = Word32 -- [TODO] split bytes -data TokenStream = TSAltMetaData !AltMetaData+-- | [\[MS-TDS\] 2.2.7 Packet Data Token Stream Definition](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/67b6113c-d722-42d1-902c-3f6e8de09173)+data TokenStream =+ -- | [\[MS-TDS\] 2.2.7.1 ALTMETADATA](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/004bba4a-8c23-4d7b-ab2c-d9e7ba864cd0) (not supprted)+ TSAltMetaData !AltMetaData - | TSAltRow- + -- | [\[MS-TDS\] 2.2.7.2 ALTROW](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/d1c42761-6a64-43ab-8a55-fccb210ac073) (not supprted)+ | TSAltRow !AltRowData++ -- | [\[MS-TDS\] 2.2.7.3 COLINFO](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/aa8466c5-ca3d-48ca-a638-7c1becebe754) | TSColInfo ![ColProperty]- ++ -- | [\[MS-TDS\] 2.2.7.4 COLMETADATA](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/58880b9f-381c-43b2-bf8b-0727a98c4f4c) | TSColMetaData !(Maybe ColMetaData) + -- | [\[MS-TDS\] 2.2.7.5 DONE](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/3c06f110-98bd-4d5b-b836-b1ba66452cb7) | TSDone !Done + -- | [\[MS-TDS\] 2.2.7.6 DONEINPROC](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/43e891c5-f7a1-432f-8f9f-233c4cd96afb) | TSDoneInProc !Done + -- | [\[MS-TDS\] 2.2.7.7 DONEPROC](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/65e24140-edea-46e5-b710-209af2016195) | TSDoneProc !Done + -- | [\[MS-TDS\] 2.2.7.8 ENVCHANGE](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/2b3eb7e5-d43d-4d1b-bf4d-76b9e3afc791) | TSEnvChange !ECType !ECNewValue !ECOldValue + -- | [\[MS-TDS\] 2.2.7.9 ERROR](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/9805e9fa-1f8b-4cf8-8f78-8d2602228635) | TSError !Info + -- | [\[MS-TDS\] 2.2.7.12 INFO](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/284bb815-d083-4ed5-b33a-bdc2492e322b) | TSInfo !Info + -- | [\[MS-TDS\] 2.2.7.13 LOGINACK](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/490e563d-cc6e-4c86-bb95-ef0186b98032) | TSLoginAck !LAInterface !LATdsVersion !LAProgName !LAProgVersion + -- | [\[MS-TDS\] 2.2.7.15 OFFSET](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/8d0b37ff-20c1-439e-8f31-1d7f136249b5) (not tested) | TSOffset !Offset + -- | [\[MS-TDS\] 2.2.7.16 ORDER](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/252759be-9d74-4435-809d-d55dd860ea78) | TSOrder ![Word16] + -- | [\[MS-TDS\] 2.2.7.17 RETURNSTATUS](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/c719f199-e71b-4187-90b9-94f78bd1870e) | TSReturnStatus !Int32 + -- | [\[MS-TDS\] 2.2.7.18 RETURNVALUE](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/7091f6f6-b83d-4ed2-afeb-ba5013dfb18f) | TSReturnValue !ReturnValue + -- | [\[MS-TDS\] 2.2.7.19 ROW](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/3840ef93-3b10-4aca-9fd1-a210b8bb6d0c) | TSRow ![RowColumnData] + -- | [\[MS-TDS\] 2.2.7.21 SSPI](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/07e2bb7b-8ba6-445f-89b1-cc76d8bfa9c6) (not tested) | TSSSPI !B.ByteString + -- | [\[MS-TDS\] 2.2.7.22 TABNAME](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/140e3348-da08-409a-b6c3-f0fc9cee2d6e) | TSTabName ![[T.Text]] - | TSOther !Word8- deriving (Show) @@ -215,8 +237,8 @@ getTokenStreamS = do pt <- lift Get.getWord8 case pt of- 0x88 -> lift getAltMetaData -- [TODO] State Monad- 0xd3 -> lift getAltRow -- [TODO] State Monad+ 0x88 -> getAltMetaDataS+ 0xd3 -> getAltRowS 0xa5 -> lift getColInfo 0x81 -> getColMetaDataS 0xfd -> lift getDone@@ -236,11 +258,17 @@ _ -> lift $ getOther pt where - getAltMetaData :: Get TokenStream -- [TODO] implementation, SQL statement that generates totals- getAltMetaData = return $ TSAltMetaData AltMetaData- - getAltRow :: Get TokenStream -- [TODO] implementation, SQL statement that generates totals- getAltRow = return TSAltRow+ -- [TODO] find SQL statement that generates this type of packet, implementation+ getAltMetaDataS :: StateT MetaData Get TokenStream+ getAltMetaDataS =+ fail "getTokenStreamS.getAltMetaDataS: packet type ALTMEATADA not supportd"+-- return $ TSAltMetaData AltMetaData++ -- [TODO] find SQL statement that generates this type of packet, implementation+ getAltRowS :: StateT MetaData Get TokenStream+ getAltRowS =+ fail "getTokenStreamS.getAltRowS: packet type ALTROW not supportd"+-- return $ TSAltRow AltRowData getColInfo :: Get TokenStream getColInfo = do@@ -308,24 +336,24 @@ getDone = do status <- Get.getWord16le curCmd <- Get.getWord16le+ doneRowCount <- Get.getInt32le -- [MEMO] TDS 7.2 -> Word64 -- doneRowCount <- Get.getWord64le- doneRowCount <- Get.getWord32le -- [MEMO] lte TDS 7.1 Int32 return $ TSDone $ Done status curCmd doneRowCount getDoneInProc :: Get TokenStream getDoneInProc = do status <- Get.getWord16le curCmd <- Get.getWord16le+ doneRowCount <- Get.getInt32le -- [MEMO] TDS 7.2 -> Word64 -- doneRowCount <- Get.getWord64le- doneRowCount <- Get.getWord32le -- [TODO] lte TDS 7.1 Int32 return $ TSDoneInProc $ Done status curCmd doneRowCount getDoneProc :: Get TokenStream getDoneProc = do status <- Get.getWord16le curCmd <- Get.getWord16le+ doneRowCount <- Get.getInt32le -- [MEMO] TDS 7.2 -> Word64 -- doneRowCount <- Get.getWord64le- doneRowCount <- Get.getWord32le -- [TODO] lte 7.1 Int32 return $ TSDoneProc $ Done status curCmd doneRowCount @@ -333,9 +361,9 @@ getEnvChange = do slen <- Get.getWord16le envCode <- Get.getWord8- -- [TODO] split Type implementation+ -- [TODO] to be detailed types (old,new) <- case envCode of- 0x07 -> do -- [TODO] collation+ 0x07 -> do -- [MEMO] report SQL Collation oldLen <- Get.getWord8 old <- getByteString oldLen newLen <- Get.getWord8@@ -361,8 +389,8 @@ server <- getText8 process <- getText8 --- line <- Get.getWord32le -- TDS 7.2- line <- Get.getWord16le+ line <- Get.getWord16le -- [MEMO] TDS 7.2 -> Int32+-- line <- Get.getInt32le return $ TSError $ Info number state mclass message server process line @@ -377,8 +405,8 @@ server <- getText8 process <- getText8 --- line <- Get.getWord32le -- TDS 7.2- line <- Get.getWord16le+ line <- Get.getWord16le -- [MEMO] TDS 7.2 -> Word32+-- line <- Get.getWord32le return $ TSInfo $ Info number state mclass message server process line @@ -397,7 +425,8 @@ return $ TSLoginAck interface tdsVer server servVer - getOffset :: Get TokenStream -- [TODO] test+ -- [TODO] find SQL statement that generates this type of packet, test+ getOffset :: Get TokenStream getOffset = do ofs <- Offset <$> Get.getWord16le <*> Get.getWord16le return $ TSOffset ofs@@ -410,15 +439,16 @@ getReturnStatus :: Get TokenStream getReturnStatus = do- val <- Get.getInt32le -- Value+ val <- Get.getInt32le return $ TSReturnStatus val - getReturnValue :: Get TokenStream -- [TODO] test+ getReturnValue :: Get TokenStream getReturnValue = do po <- Get.getWord16le pn <- getText8 st <- Get.getWord8- ut <- Get.getWord16le+ ut <- Get.getWord16le -- [MEMO] TDS 7.2 -> Word32+-- ut <- Get.getWord32le fl <- Get.getWord16le ti <- Data.Binary.get vl <- getRawBytes ti@@ -427,7 +457,7 @@ getRowS :: StateT MetaData Get TokenStream getRowS = do- -- [TODO] error check+ -- [TODO] raise error when Nothing Just (ColMetaData colDatas) <- (\(MetaData mcmd mamd) -> mcmd) <$> Control.Monad.State.get datas <- lift $ mapM (getColumnData . (\(MetaColumnData _ _ ti _ _) -> ti)) colDatas return $ TSRow datas@@ -440,13 +470,12 @@ TIImage{} -> getCDLarge ti _ -> RCDOrdinal <$> getRawBytes ti - -- [TODO] test when text,ntext,image is Null getCDLarge :: TypeInfo -> Get RowColumnData getCDLarge ti = do len <- Get.getWord8 if len == 0 then do- -- [TODO] should read 32bit ?+ -- [MEMO] should read 32bit ? case ti of TIText{} -> return $ RCDLarge Nothing Nothing Nothing TINText{} -> return $ RCDLarge Nothing Nothing Nothing@@ -457,7 +486,8 @@ return $ RCDLarge (Just tp) (Just ts) dt - getSSPI :: Get TokenStream -- [TODO] test+ -- [TODO] find SQL statement that generates this type of packet, test+ getSSPI :: Get TokenStream getSSPI = do len <- Get.getWord16le bs <- getByteString len@@ -495,28 +525,28 @@ getOther :: Word8 -> Get TokenStream getOther pt = do case pt of- 0xae -> do+ 0xae -> -- FEATUREEXTACK -- [MEMO] introduced in TDS 7.4- return $ TSOther pt- 0xee -> do+ fail "getTokenStreamS.getOther: packet type FEATUREEXTACK not supportd"+ 0xee -> -- FEDAUTHINFO -- [MEMO] introduced in TDS 7.4- return $ TSOther pt- 0xd2 -> do+ fail "getTokenStreamS.getOther: packet type FEDAUTHINFO not supportd"+ 0xd2 -> -- NBCROW -- [MEMO] introduced in TDS 7.3.B- return $ TSOther pt- 0xe4 -> do+ fail "getTokenStreamS.getOther: packet type NBCROW not supported"+ 0xe4 -> -- SESSIONSTATE -- [MEMO] introduced in TDS 7.4- return $ TSOther pt- 0x01 -> do+ fail "getTokenStreamS.getOther: packet type SESSIONSTATE not supportd"+ 0x01 -> -- TVP ROW -- https://msdn.microsoft.com/en-us/library/dd304813.aspx -- [MEMO] not here ? -- [MEMO] introduced in TDS 7.3 ?- return $ TSOther pt+ fail "getTokenStreamS.getOther: packet type TVP ROW not supported" _ -> fail "getTokenStreamS.getOther: invalid packet type" @@ -546,7 +576,6 @@ --- [MEMO] Lazyness? newtype TokenStreams = TokenStreams [TokenStream] deriving (Show)
src/Database/Tds/Primitives/Collation.hs view
@@ -18,6 +18,7 @@ type Collation32 = Word32 type SortId = Word8 +-- | [\[MS-TDS\] 2.2.5.1.2 Collation Rule Definition](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/3d29e8dc-218a-42c6-9ba4-947ebca9fd7e) data Collation = Collation !Collation32 !SortId deriving (Show)
src/Database/Tds/Transport.hs view
@@ -23,6 +23,7 @@ import Database.Tds.Message.Header +-- | [\[MS-TDS\] 3.2.5.2 Sent TLS/SSL Negotiation Packet State](https://docs.microsoft.com/en-us/openspecs/windows_protocols/ms-tds/d62e225b-d865-4ccc-8f73-de1ef49e30d4) contextNew :: Socket -> TLS.HostName -> IO TLS.Context contextNew sock host = do certStore <- getSystemCertificateStore