{-# OPTIONS_HADDOCK hide #-}
-- Stream Types:    https://msdn.microsoft.com/en-us/library/dd303435.aspx
-- Data Types:      https://msdn.microsoft.com/en-us/library/dd305325.aspx
-- Data Stream:     https://msdn.microsoft.com/en-us/library/dd340794.aspx
-- Client Messages: https://msdn.microsoft.com/en-us/library/dd341027.aspx


module Database.Tds.Message.Client ( Login7
                                   , tdsVersion
                                   , defaultLogin7
                                   , l7PacketSize
                                   , l7ClientProgVer
                                   , l7ConnectionID
                                   , l7OptionFlags1
                                   , l7OptionFlags2
                                   , l7OptionFlags3
                                   , l7TypeFlags
                                   , l7TimeZone
                                   , l7Collation
                                   , l7CltIntName
                                   , l7Language
                                   , l7ClientPID
                                   , l7ClientMacAddr
                                   , l7ClientHostName
                                   , l7AppName
                                   , l7ServerName
                                   , l7UserName
                                   , l7Password
                                   , l7Database
                                   
                                   , SqlBatch (..)
                                   
                                   , RpcRequest (..)
                                   
                                   , RpcReqBatch (..)
                                   , ProcID (..)
                                   , ProcName (..)
                                   , OptionFlags (..)
                                   
                                   , RpcReqBatchParam (..)
                                   , ParamName (..)
                                   , StatusFlag (..)
                                   
                                   ) where

import Data.Monoid(mempty)

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB

import qualified Data.Text as T
import qualified Data.Text.Encoding as T

import Data.Word (Word8(..),Word16(..),Word32(..),Word64(..))
import Data.Int (Int8(..),Int16(..),Int32(..),Int64(..))

import Data.Binary (Put(..),Get(..),Binary(..))
import qualified Data.Binary.Put as Put
import qualified Data.Binary.Get as Get

import Data.Bits ((.&.),(.|.),xor,shift)

import Control.Monad (foldM,foldM_)

import Database.Tds.Message.Prelogin
import Database.Tds.Message.DataStream
import Database.Tds.Primitives.Collation




-- | [\[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 { Login7 -> Word32
l7TdsVersion :: !Word32
                     , Login7 -> Word32
l7PacketSize :: !Word32
                     , Login7 -> Word32
l7ClientProgVer :: !Word32
                     , Login7 -> Word32
l7ConnectionID :: !Word32
                     , Login7 -> Word8
l7OptionFlags1 :: !Word8
                     , Login7 -> Word8
l7OptionFlags2 :: !Word8
                     , Login7 -> Word8
l7OptionFlags3 :: !Word8
                     , Login7 -> Word8
l7TypeFlags :: !Word8
                     , Login7 -> Int32
l7TimeZone :: !Int32
                     , Login7 -> Word32
l7Collation :: !Collation32
                     , Login7 -> Text
l7CltIntName :: !T.Text
                     , Login7 -> Text
l7Language :: !T.Text
                     , Login7 -> Word32
l7ClientPID :: !Word32
                     , Login7 -> ByteString
l7ClientMacAddr :: !B.ByteString
                     , Login7 -> Text
l7ClientHostName :: !T.Text
                     , Login7 -> Text
l7AppName :: !T.Text
                     , Login7 -> Text
l7ServerName :: !T.Text
                     , Login7 -> Text
l7UserName :: !T.Text
                     , Login7 -> Text
l7Password :: !T.Text
                     , Login7 -> Text
l7Database :: !T.Text
                     }
            deriving (Int -> Login7 -> ShowS
[Login7] -> ShowS
Login7 -> String
(Int -> Login7 -> ShowS)
-> (Login7 -> String) -> ([Login7] -> ShowS) -> Show Login7
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Login7] -> ShowS
$cshowList :: [Login7] -> ShowS
show :: Login7 -> String
$cshow :: Login7 -> String
showsPrec :: Int -> Login7 -> ShowS
$cshowsPrec :: Int -> Login7 -> ShowS
Show)


tdsVersion :: Word32
tdsVersion :: Word32
tdsVersion = Word32
0x71000001
-- [MEMO]
-- tds70Version = 0x70000000
-- tds71Version = 0x71000001
-- tds72Version = 0x72090002
-- tds73Version = 0x730B0003
-- tds74Version = 0x74000004


defaultLogin7 :: Login7
defaultLogin7 :: Login7
defaultLogin7 = Login7 :: Word32
-> Word32
-> Word32
-> Word32
-> Word8
-> Word8
-> Word8
-> Word8
-> Int32
-> Word32
-> Text
-> Text
-> Word32
-> ByteString
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Login7
Login7 { l7TdsVersion :: Word32
l7TdsVersion = Word32
tdsVersion
                         , l7PacketSize :: Word32
l7PacketSize = Word32
4096
                         , l7ClientProgVer :: Word32
l7ClientProgVer = Word32
0 -- [MEMO] 0x0683f2f8, 0x00000007
                         , l7ConnectionID :: Word32
l7ConnectionID = Word32
0
                         , l7OptionFlags1 :: Word8
l7OptionFlags1 = Word8
0x80 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
0x40 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
0x20
                         , l7OptionFlags2 :: Word8
l7OptionFlags2 = Word8
0  -- [MEMO] 0x02 + 0x01
                         , l7OptionFlags3 :: Word8
l7OptionFlags3 = Word8
0
                         , l7TypeFlags :: Word8
l7TypeFlags = Word8
0
                         , l7TimeZone :: Int32
l7TimeZone = Int32
0  -- [MEMO] -120
                         , l7Collation :: Word32
l7Collation = Word32
0x00000000  -- [MEMO] 0x36040000, 0x1104d000, 0x09040000
                         , l7CltIntName :: Text
l7CltIntName = Text
forall a. Monoid a => a
mempty -- [MDMO] "DB-Library", "OLEDB", "ODBC"
                         , l7Language :: Text
l7Language = Text
forall a. Monoid a => a
mempty -- [MEMO] "us_english"
                         , l7ClientPID :: Word32
l7ClientPID = Word32
0
                         , l7ClientMacAddr :: ByteString
l7ClientMacAddr = ByteString
forall a. Monoid a => a
mempty
                         , l7ClientHostName :: Text
l7ClientHostName = Text
forall a. Monoid a => a
mempty
                         , l7AppName :: Text
l7AppName = Text
forall a. Monoid a => a
mempty
                         , l7ServerName :: Text
l7ServerName = Text
forall a. Monoid a => a
mempty
                         , l7UserName :: Text
l7UserName = Text
forall a. Monoid a => a
mempty
                         , l7Password :: Text
l7Password = Text
forall a. Monoid a => a
mempty
                         , l7Database :: Text
l7Database = Text
forall a. Monoid a => a
mempty
                         }


login7Bytes1 :: Login7 -> [B.ByteString]
login7Bytes1 :: Login7 -> [ByteString]
login7Bytes1 Login7
x =
  let
    clientHostName :: ByteString
clientHostName  = Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Login7 -> Text
l7ClientHostName Login7
x
    userName :: ByteString
userName        = Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Login7 -> Text
l7UserName Login7
x
    password :: ByteString
password        = ByteString -> ByteString
cryptPassword (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Login7 -> Text
l7Password Login7
x
    appName :: ByteString
appName         = Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Login7 -> Text
l7AppName Login7
x
    serverName :: ByteString
serverName      = Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Login7 -> Text
l7ServerName Login7
x
    unused :: ByteString
unused          = ByteString
forall a. Monoid a => a
mempty
    libraryName :: ByteString
libraryName     = Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Login7 -> Text
l7CltIntName Login7
x
    language :: ByteString
language        = Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Login7 -> Text
l7Language Login7
x
    database :: ByteString
database        = Text -> ByteString
T.encodeUtf16LE (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Login7 -> Text
l7Database Login7
x

  in [ ByteString
clientHostName
     , ByteString
userName
     , ByteString
password
     , ByteString
appName
     , ByteString
serverName
     , ByteString
unused
     , ByteString
libraryName
     , ByteString
language
     , ByteString
database
     ]
  where
    cryptPassword :: B.ByteString -> B.ByteString
    cryptPassword :: ByteString -> ByteString
cryptPassword ByteString
bs =
      let
        bs' :: [Word8]
bs' = ByteString -> [Word8]
B.unpack ByteString
bs
      in [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Word8) -> [Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\Word8
x -> (Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shift Word8
x Int
4 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
shift Word8
x (-Int
4)) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
0xa5) [Word8]
bs'
         

login7Bytes2 :: Login7 -> [B.ByteString]
login7Bytes2 :: Login7 -> [ByteString]
login7Bytes2 Login7
x =
  let
    sspi :: ByteString
sspi            = ByteString
forall a. Monoid a => a
mempty
    atachDBFile :: ByteString
atachDBFile     = ByteString
forall a. Monoid a => a
mempty
--    changePassword  = mempty -- TDS 7.2
  in [ ByteString
sspi
     , ByteString
atachDBFile
--     , changePassword -- TDS 7.2
     ]


login7HeaderLength :: Int
login7HeaderLength :: Int
login7HeaderLength =
  let
    hLen :: Int
hLen = Int
4 -- payload length
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- TDS Version
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- packet size
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- client program version
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- client pid
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- connection id
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 -- flag1
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 -- flag2
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 -- SQL type
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 -- flag3
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- time zone
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- collation
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx client hostname 
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx username
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx password
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx app name
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx server name
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx unused
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx library name
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx language
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx database
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6 -- client mac addr
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx SSPI
         Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- idx AtachDBFile
--         + 4 -- idx ChangePassword -- TDS 7.2 
--         + 4 -- SSPI_long          -- TDS 7.2
  in Int
hLen


login7Length :: Login7 -> Int
login7Length :: Login7 -> Int
login7Length Login7
x =
  let
    bLen :: Int
bLen = ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
B.length ([ByteString] -> [Int]) -> [ByteString] -> [Int]
forall a b. (a -> b) -> a -> b
$ Login7 -> [ByteString]
login7Bytes1 Login7
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
B.length ([ByteString] -> [Int]) -> [ByteString] -> [Int]
forall a b. (a -> b) -> a -> b
$ Login7 -> [ByteString]
login7Bytes2 Login7
x)
  in Int
login7HeaderLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bLen


-- https://msdn.microsoft.com/en-us/library/dd304019.aspx
putLogin7 :: Login7 -> Put
putLogin7 :: Login7 -> Put
putLogin7 Login7
x = do
  Word32 -> Put
Put.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
plLen  -- payload length
  Word32 -> Put
Put.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word32
l7TdsVersion Login7
x
  Word32 -> Put
Put.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word32
l7PacketSize Login7
x    -- packet size
  Word32 -> Put
Put.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word32
l7ClientProgVer Login7
x -- client program version
  Word32 -> Put
Put.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word32
l7ClientPID Login7
x     -- client pid
  Word32 -> Put
Put.putWord32le (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word32
l7ConnectionID Login7
x  -- connect id
  Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word8
l7OptionFlags1 Login7
x     -- flag1
  Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word8
l7OptionFlags2 Login7
x     -- flag2
  Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word8
l7TypeFlags Login7
x        -- sql type
  Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word8
l7OptionFlags3 Login7
x     -- flag3
  Int32 -> Put
Put.putInt32le (Int32 -> Put) -> Int32 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Int32
l7TimeZone Login7
x       -- tz
  Word32 -> Put
Put.putWord32be (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> Word32
l7Collation Login7
x     -- collation

  Int
offs <- (Int -> ByteString -> PutM Int) -> Int -> [ByteString] -> PutM Int
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Int -> ByteString -> PutM Int
putIndex Int
plHLen [ByteString]
bytes1  -- index 1st-half
  ByteString -> Put
Put.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Login7 -> ByteString
l7ClientMacAddr Login7
x -- mac address
  (Int -> ByteString -> PutM Int) -> Int -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Int -> ByteString -> PutM Int
putIndex Int
offs [ByteString]
bytes2           -- index 2nd-half
  
--    Put.putWord32le 0 -- SSPI long  -- TDS 7.2

  (ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
Put.putByteString ([ByteString] -> Put) -> [ByteString] -> Put
forall a b. (a -> b) -> a -> b
$ [ByteString]
bytes1
  (ByteString -> Put) -> [ByteString] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> Put
Put.putByteString ([ByteString] -> Put) -> [ByteString] -> Put
forall a b. (a -> b) -> a -> b
$ [ByteString]
bytes2

    where
      putIndex :: Int -> B.ByteString -> Put.PutM Int
      putIndex :: Int -> ByteString -> PutM Int
putIndex Int
offs ByteString
bs = do
        let
          len :: Int
len = ByteString -> Int
B.length ByteString
bs
        Word16 -> Put
Put.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offs
        Word16 -> Put
Put.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
        Int -> PutM Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> PutM Int) -> Int -> PutM Int
forall a b. (a -> b) -> a -> b
$ Int
offsInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
len

      plLen :: Int
plLen  = Login7 -> Int
login7Length Login7
x
      plHLen :: Int
plHLen = Int
login7HeaderLength
      bytes1 :: [ByteString]
bytes1 = Login7 -> [ByteString]
login7Bytes1 Login7
x
      bytes2 :: [ByteString]
bytes2 = Login7 -> [ByteString]
login7Bytes2 Login7
x
          

getLogin7 :: Get Login7
getLogin7 :: Get Login7
getLogin7 = Get Login7
forall a. HasCallStack => a
undefined -- [TODO] implement get function


instance Binary Login7 where
  put :: Login7 -> Put
put = Login7 -> Put
putLogin7
  get :: Get Login7
get = Get Login7
getLogin7
  




-- | [\[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 (Int -> SqlBatch -> ShowS
[SqlBatch] -> ShowS
SqlBatch -> String
(Int -> SqlBatch -> ShowS)
-> (SqlBatch -> String) -> ([SqlBatch] -> ShowS) -> Show SqlBatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlBatch] -> ShowS
$cshowList :: [SqlBatch] -> ShowS
show :: SqlBatch -> String
$cshow :: SqlBatch -> String
showsPrec :: Int -> SqlBatch -> ShowS
$cshowsPrec :: Int -> SqlBatch -> ShowS
Show)


putSqlBatch :: SqlBatch -> Put
putSqlBatch :: SqlBatch -> Put
putSqlBatch (SqlBatch Text
sql) = ByteString -> Put
Put.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf16LE Text
sql

getSqlBatch :: Get SqlBatch
getSqlBatch :: Get SqlBatch
getSqlBatch = Get SqlBatch
forall a. HasCallStack => a
undefined -- [TODO] implement get function


instance Binary SqlBatch where
  put :: SqlBatch -> Put
put = SqlBatch -> Put
putSqlBatch
  get :: Get SqlBatch
get = Get SqlBatch
getSqlBatch



type ParamName = T.Text
type StatusFlag = Word8

data RpcReqBatchParam = RpcReqBatchParam !ParamName !StatusFlag !TypeInfo !RawBytes
                      deriving (Int -> RpcReqBatchParam -> ShowS
[RpcReqBatchParam] -> ShowS
RpcReqBatchParam -> String
(Int -> RpcReqBatchParam -> ShowS)
-> (RpcReqBatchParam -> String)
-> ([RpcReqBatchParam] -> ShowS)
-> Show RpcReqBatchParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcReqBatchParam] -> ShowS
$cshowList :: [RpcReqBatchParam] -> ShowS
show :: RpcReqBatchParam -> String
$cshow :: RpcReqBatchParam -> String
showsPrec :: Int -> RpcReqBatchParam -> ShowS
$cshowsPrec :: Int -> RpcReqBatchParam -> ShowS
Show)


type ProcID = Word16
type ProcName = T.Text
type OptionFlags = Word16

data RpcReqBatch = RpcReqBatchProcId !ProcID !OptionFlags ![RpcReqBatchParam]
                 | RpcReqBatchProcName !ProcName !OptionFlags ![RpcReqBatchParam]
                 deriving (Int -> RpcReqBatch -> ShowS
[RpcReqBatch] -> ShowS
RpcReqBatch -> String
(Int -> RpcReqBatch -> ShowS)
-> (RpcReqBatch -> String)
-> ([RpcReqBatch] -> ShowS)
-> Show RpcReqBatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcReqBatch] -> ShowS
$cshowList :: [RpcReqBatch] -> ShowS
show :: RpcReqBatch -> String
$cshow :: RpcReqBatch -> String
showsPrec :: Int -> RpcReqBatch -> ShowS
$cshowsPrec :: Int -> RpcReqBatch -> ShowS
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 (Int -> RpcRequest -> ShowS
[RpcRequest] -> ShowS
RpcRequest -> String
(Int -> RpcRequest -> ShowS)
-> (RpcRequest -> String)
-> ([RpcRequest] -> ShowS)
-> Show RpcRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcRequest] -> ShowS
$cshowList :: [RpcRequest] -> ShowS
show :: RpcRequest -> String
$cshow :: RpcRequest -> String
showsPrec :: Int -> RpcRequest -> ShowS
$cshowsPrec :: Int -> RpcRequest -> ShowS
Show)
                    





putRpcReqBatch :: RpcReqBatch -> Put
putRpcReqBatch :: RpcReqBatch -> Put
putRpcReqBatch (RpcReqBatchProcId Word16
pid Word16
flgs [RpcReqBatchParam]
pds) = do
  Word16 -> Put
Put.putWord16le Word16
0xffff
  Word16 -> Put
Put.putWord16le Word16
pid
  Word16 -> Put
Put.putWord16le Word16
flgs
  (RpcReqBatchParam -> Put) -> [RpcReqBatchParam] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RpcReqBatchParam -> Put
putRpcReqBatchParam [RpcReqBatchParam]
pds
  
putRpcReqBatch (RpcReqBatchProcName Text
pn Word16
flgs [RpcReqBatchParam]
pds) = do
  Word16 -> Put
Put.putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
pn -- [MEMO] text length
  ByteString -> Put
Put.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf16LE Text
pn
  Word16 -> Put
Put.putWord16le Word16
flgs
  (RpcReqBatchParam -> Put) -> [RpcReqBatchParam] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RpcReqBatchParam -> Put
putRpcReqBatchParam [RpcReqBatchParam]
pds
  

putRpcReqBatchParam :: RpcReqBatchParam -> Put
putRpcReqBatchParam :: RpcReqBatchParam -> Put
putRpcReqBatchParam (RpcReqBatchParam Text
pn Word8
sf TypeInfo
ti RawBytes
val) = do
  Word8 -> Put
Put.putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length Text
pn -- [MEMO] text length
  ByteString -> Put
Put.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf16LE Text
pn
  Word8 -> Put
Put.putWord8 Word8
sf
  TypeInfo -> Put
forall t. Binary t => t -> Put
put TypeInfo
ti
  TypeInfo -> RawBytes -> Put
putRawBytes TypeInfo
ti RawBytes
val
  () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()


putRpcRequest :: RpcRequest -> Put
putRpcRequest :: RpcRequest -> Put
putRpcRequest (RpcRequest [RpcReqBatch]
bts) = (RpcReqBatch -> Put) -> [RpcReqBatch] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\RpcReqBatch
bt -> RpcReqBatch -> Put
putRpcReqBatch RpcReqBatch
bt Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
Put.putWord8 Word8
0x80) [RpcReqBatch]
bts -- [MEMO] split by 0x80

getRpcRequest :: Get RpcRequest
getRpcRequest :: Get RpcRequest
getRpcRequest = Get RpcRequest
forall a. HasCallStack => a
undefined -- [TODO] implement get function


instance Binary RpcRequest where
  put :: RpcRequest -> Put
put = RpcRequest -> Put
putRpcRequest
  get :: Get RpcRequest
get = Get RpcRequest
getRpcRequest