diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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) diff --git a/ms-tds.cabal b/ms-tds.cabal --- a/ms-tds.cabal +++ b/ms-tds.cabal @@ -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 category: Database diff --git a/src/Database/Tds/Message.hs b/src/Database/Tds/Message.hs --- a/src/Database/Tds/Message.hs +++ b/src/Database/Tds/Message.hs @@ -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) diff --git a/src/Database/Tds/Message/Client.hs b/src/Database/Tds/Message/Client.hs --- a/src/Database/Tds/Message/Client.hs +++ b/src/Database/Tds/Message/Client.hs @@ -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) diff --git a/src/Database/Tds/Message/DataStream.hs b/src/Database/Tds/Message/DataStream.hs --- a/src/Database/Tds/Message/DataStream.hs +++ b/src/Database/Tds/Message/DataStream.hs @@ -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 diff --git a/src/Database/Tds/Message/Prelogin.hs b/src/Database/Tds/Message/Prelogin.hs --- a/src/Database/Tds/Message/Prelogin.hs +++ b/src/Database/Tds/Message/Prelogin.hs @@ -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) diff --git a/src/Database/Tds/Message/Server.hs b/src/Database/Tds/Message/Server.hs --- a/src/Database/Tds/Message/Server.hs +++ b/src/Database/Tds/Message/Server.hs @@ -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) diff --git a/src/Database/Tds/Primitives/Collation.hs b/src/Database/Tds/Primitives/Collation.hs --- a/src/Database/Tds/Primitives/Collation.hs +++ b/src/Database/Tds/Primitives/Collation.hs @@ -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) diff --git a/src/Database/Tds/Transport.hs b/src/Database/Tds/Transport.hs --- a/src/Database/Tds/Transport.hs +++ b/src/Database/Tds/Transport.hs @@ -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