{-# OPTIONS_HADDOCK hide #-}
-- PRELOGIN:        https://msdn.microsoft.com/en-us/library/dd357559.aspx

module Database.Tds.Message.Prelogin ( Prelogin (..)
                                     , PreloginOption (..)
                                     , MajorVer (..)
                                     , MinorVer (..)
                                     , BuildVer (..)
                                     , SubBuildVer (..)
                                     , Threadid (..)
                                     , Connid (..)
                                     , Activity (..)
                                     , Sequence (..)
                                     , Nonce (..)
                                     ) where

import Data.Monoid(mempty)

import Control.Applicative((<$>),(<*>))

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

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 Control.Monad (forM_,foldM_)
import Data.Foldable (maximumBy)




type MajorVer = Word8
type MinorVer = Word8
type BuildVer = Word16
type SubBuildVer = Word16
type Threadid = Word32
type Connid = B.ByteString   -- 16byte GUID
type Activity = B.ByteString -- 16byte GUID
type Sequence = Word32
type Nonce = B.ByteString    -- 32byte NONCE


data PreloginOption = PLOVersion !MajorVer !MinorVer !BuildVer !SubBuildVer
                    | PLOEncryption !Word8  -- [TODO] flags
                    | PLOInstopt !B.ByteString
                    | PLOThreadid !(Maybe Threadid)
                    | PLOMars !Word8  -- MARS(Multiple Active Result Sets) supprt -- [TODO] flags
                    | PLOTraceid !Connid !Activity !Sequence
                    | PLOFedAuthRequired !Word8
                    | PLONonceOpt !Nonce
                    deriving (Int -> PreloginOption -> ShowS
[PreloginOption] -> ShowS
PreloginOption -> String
(Int -> PreloginOption -> ShowS)
-> (PreloginOption -> String)
-> ([PreloginOption] -> ShowS)
-> Show PreloginOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PreloginOption -> ShowS
showsPrec :: Int -> PreloginOption -> ShowS
$cshow :: PreloginOption -> String
show :: PreloginOption -> String
$cshowList :: [PreloginOption] -> ShowS
showList :: [PreloginOption] -> ShowS
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 (Int -> Prelogin -> ShowS
[Prelogin] -> ShowS
Prelogin -> String
(Int -> Prelogin -> ShowS)
-> (Prelogin -> String) -> ([Prelogin] -> ShowS) -> Show Prelogin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Prelogin -> ShowS
showsPrec :: Int -> Prelogin -> ShowS
$cshow :: Prelogin -> String
show :: Prelogin -> String
$cshowList :: [Prelogin] -> ShowS
showList :: [Prelogin] -> ShowS
Show)


preloginOptionsIndexOffset :: [a] -> Int
preloginOptionsIndexOffset :: forall a. [a] -> Int
preloginOptionsIndexOffset [a]
ops = (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ops) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

preloginOptionPayloadLength :: PreloginOption -> Int
preloginOptionPayloadLength :: PreloginOption -> Int
preloginOptionPayloadLength = PreloginOption -> Int
f
  where
    f :: PreloginOption -> Int
f (PLOVersion Word8
_ Word8
_ Word16
_ Word16
_)   = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4
    f (PLOEncryption Word8
_)      = Int
1
    f (PLOInstopt ByteString
io)        = ByteString -> Int
B.length ByteString
io Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
    f (PLOThreadid Maybe Threadid
_)        = Int
4
    f (PLOMars Word8
_)            = Int
1
    f (PLOTraceid ByteString
_ ByteString
_ Threadid
_)     = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 -- [TODO] Test
    f (PLOFedAuthRequired Word8
_) = Int
1           -- [TODO] Test
    f (PLONonceOpt ByteString
_)        = Int
32          -- [TODO] Test

-- https://msdn.microsoft.com/en-us/library/dd357559.aspx
putPrelogin :: Prelogin -> Put
putPrelogin :: Prelogin -> Put
putPrelogin (Prelogin [PreloginOption]
ops) = do
  (Int -> PreloginOption -> PutM Int)
-> Int -> [PreloginOption] -> Put
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_ Int -> PreloginOption -> PutM Int
putIndex ([PreloginOption] -> Int
forall a. [a] -> Int
preloginOptionsIndexOffset [PreloginOption]
ops) [PreloginOption]
ops
  Word8 -> Put
Put.putWord8 Word8
0xff -- terminate
  [PreloginOption] -> (PreloginOption -> Put) -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [PreloginOption]
ops PreloginOption -> Put
putOpt
  where
    putIndex :: Int -> PreloginOption -> Put.PutM Int
    putIndex :: Int -> PreloginOption -> PutM Int
putIndex Int
offs PreloginOption
op = do
      let
        ot :: Word8
ot = case PreloginOption
op of
          PLOVersion Word8
_ Word8
_ Word16
_ Word16
_   -> Word8
0x00
          PLOEncryption Word8
_      -> Word8
0x01
          PLOInstopt ByteString
_         -> Word8
0x02
          PLOThreadid Maybe Threadid
_        -> Word8
0x03
          PLOMars Word8
_            -> Word8
0x04
          PLOTraceid ByteString
_ ByteString
_ Threadid
_     -> Word8
0x05 -- [TODO] Test
          PLOFedAuthRequired Word8
_ -> Word8
0x06 -- [TODO] Test
          PLONonceOpt ByteString
_        -> Word8
0x07 -- [TODO] Test
        len :: Int
len = PreloginOption -> Int
preloginOptionPayloadLength PreloginOption
op
      Word8 -> Put
Put.putWord8 Word8
ot
      Word16 -> Put
Put.putWord16be (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.putWord16be (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
      Int -> PutM Int
forall a. a -> PutM a
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
        
    putOpt :: PreloginOption -> Put
    putOpt :: PreloginOption -> Put
putOpt (PLOVersion Word8
ma Word8
mi Word16
b Word16
sb) = do
      Word8 -> Put
Put.putWord8 Word8
ma
      Word8 -> Put
Put.putWord8 Word8
mi
      Word16 -> Put
Put.putWord16be Word16
b
      Word16 -> Put
Put.putWord16be Word16
sb
        
    putOpt (PLOEncryption Word8
enc) = Word8 -> Put
Put.putWord8 Word8
enc
        
    putOpt (PLOInstopt ByteString
io) = do
      ByteString -> Put
Put.putByteString ByteString
io
      Word8 -> Put
Put.putWord8 Word8
0
        
    putOpt (PLOThreadid Maybe Threadid
Nothing) = () -> Put
forall a. a -> PutM a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    putOpt (PLOThreadid (Just Threadid
tid)) = Threadid -> Put
Put.putWord32le Threadid
tid
        
    putOpt (PLOMars Word8
mars) = Word8 -> Put
Put.putWord8 Word8
mars

    -- [TODO] Test
    putOpt (PLOTraceid ByteString
ci ByteString
ac Threadid
se) = do
      ByteString -> Put
Put.putByteString ByteString
ci
      ByteString -> Put
Put.putByteString ByteString
ac
      Threadid -> Put
Put.putWord32le Threadid
se
    
    -- [TODO] Test
    putOpt (PLOFedAuthRequired Word8
b) = Word8 -> Put
Put.putWord8 Word8
b

    -- [TODO] Test
    putOpt (PLONonceOpt ByteString
opt) = ByteString -> Put
Put.putByteString ByteString
opt



-- https://msdn.microsoft.com/en-us/library/dd340710.aspx
getPrelogin :: Get Prelogin
getPrelogin :: Get Prelogin
getPrelogin = do
  [(Word8, Int, Int)]
idcs <- Get [(Word8, Int, Int)]
getIndices
  -- [MEMO] calc totallen from max offset
  let (Word8
_,Int
maxoffs,Int
maxoffslen) = ((Word8, Int, Int) -> (Word8, Int, Int) -> Ordering)
-> [(Word8, Int, Int)] -> (Word8, Int, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (\(Word8
_,Int
offs1,Int
_) (Word8
_,Int
offs2,Int
_) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
offs1 Int
offs2) [(Word8, Int, Int)]
idcs
  let totalLen :: Int
totalLen = Int
maxoffs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
maxoffslen
  let offs0 :: Int
offs0 = [(Word8, Int, Int)] -> Int
forall a. [a] -> Int
preloginOptionsIndexOffset [(Word8, Int, Int)]
idcs
  ByteString
payl <- Int64 -> Get ByteString
Get.getLazyByteString (Int64 -> Get ByteString) -> Int64 -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalLen) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offs0

  Prelogin -> Get Prelogin
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Prelogin -> Get Prelogin) -> Prelogin -> Get Prelogin
forall a b. (a -> b) -> a -> b
$ [PreloginOption] -> Prelogin
Prelogin ([PreloginOption] -> Prelogin) -> [PreloginOption] -> Prelogin
forall a b. (a -> b) -> a -> b
$ (((Word8, Int, Int) -> PreloginOption)
 -> [(Word8, Int, Int)] -> [PreloginOption])
-> [(Word8, Int, Int)]
-> ((Word8, Int, Int) -> PreloginOption)
-> [PreloginOption]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Word8, Int, Int) -> PreloginOption)
-> [(Word8, Int, Int)] -> [PreloginOption]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Word8, Int, Int)]
idcs (((Word8, Int, Int) -> PreloginOption) -> [PreloginOption])
-> ((Word8, Int, Int) -> PreloginOption) -> [PreloginOption]
forall a b. (a -> b) -> a -> b
$ \(Word8
ot,Int
offs,Int
len) ->
    Get PreloginOption -> ByteString -> PreloginOption
forall a. Get a -> ByteString -> a
Get.runGet (Word8 -> Int -> Get PreloginOption
getOpt Word8
ot Int
len) (ByteString -> PreloginOption) -> ByteString -> PreloginOption
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
LB.drop (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Int
offs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offs0) ByteString
payl
        
  where
    getIndices :: Get [(Word8,Int,Int)]
    getIndices :: Get [(Word8, Int, Int)]
getIndices = do
      Word8
ot <- Get Word8
Get.getWord8
      if Word8
ot Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xff
        then [(Word8, Int, Int)] -> Get [(Word8, Int, Int)]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do (Word8, Int, Int)
index   <- Word8 -> Get (Word8, Int, Int)
getIndex Word8
ot
                [(Word8, Int, Int)]
indices <- Get [(Word8, Int, Int)]
getIndices
                [(Word8, Int, Int)] -> Get [(Word8, Int, Int)]
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Word8, Int, Int)] -> Get [(Word8, Int, Int)])
-> [(Word8, Int, Int)] -> Get [(Word8, Int, Int)]
forall a b. (a -> b) -> a -> b
$ (Word8, Int, Int)
index(Word8, Int, Int) -> [(Word8, Int, Int)] -> [(Word8, Int, Int)]
forall a. a -> [a] -> [a]
:[(Word8, Int, Int)]
indices
        where
          getIndex :: Word8 -> Get (Word8,Int,Int)
          getIndex :: Word8 -> Get (Word8, Int, Int)
getIndex Word8
ot = do
            Int
offs <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16be  -- offset
            Int
len  <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
Get.getWord16be  -- len
            (Word8, Int, Int) -> Get (Word8, Int, Int)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word8
ot,Int
offs,Int
len)
          
          
                    
    getOpt :: Word8 -> Int -> Get PreloginOption
    
    getOpt :: Word8 -> Int -> Get PreloginOption
getOpt Word8
0x00 Int
_ = Word8 -> Word8 -> Word16 -> Word16 -> PreloginOption
PLOVersion (Word8 -> Word8 -> Word16 -> Word16 -> PreloginOption)
-> Get Word8 -> Get (Word8 -> Word16 -> Word16 -> PreloginOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8
                               Get (Word8 -> Word16 -> Word16 -> PreloginOption)
-> Get Word8 -> Get (Word16 -> Word16 -> PreloginOption)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word8
Get.getWord8
                               Get (Word16 -> Word16 -> PreloginOption)
-> Get Word16 -> Get (Word16 -> PreloginOption)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
Get.getWord16be
                               Get (Word16 -> PreloginOption) -> Get Word16 -> Get PreloginOption
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word16
Get.getWord16be
                               
    getOpt Word8
0x01 Int
_ = Word8 -> PreloginOption
PLOEncryption (Word8 -> PreloginOption) -> Get Word8 -> Get PreloginOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8
    
    getOpt Word8
0x02 Int
len = -- [MEMO] null terminated string
      if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
        then PreloginOption -> Get PreloginOption
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (PreloginOption -> Get PreloginOption)
-> PreloginOption -> Get PreloginOption
forall a b. (a -> b) -> a -> b
$ ByteString -> PreloginOption
PLOInstopt ByteString
forall a. Monoid a => a
mempty
        else do ByteString
bs <- Int -> Get ByteString
Get.getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
                PreloginOption -> Get PreloginOption
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (PreloginOption -> Get PreloginOption)
-> PreloginOption -> Get PreloginOption
forall a b. (a -> b) -> a -> b
$ ByteString -> PreloginOption
PLOInstopt ByteString
bs
      
    getOpt Word8
0x03 Int
len = do
      if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then PreloginOption -> Get PreloginOption
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (PreloginOption -> Get PreloginOption)
-> PreloginOption -> Get PreloginOption
forall a b. (a -> b) -> a -> b
$ Maybe Threadid -> PreloginOption
PLOThreadid Maybe Threadid
forall a. Maybe a
Nothing
        else Maybe Threadid -> PreloginOption
PLOThreadid (Maybe Threadid -> PreloginOption)
-> (Threadid -> Maybe Threadid) -> Threadid -> PreloginOption
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Threadid -> Maybe Threadid
forall a. a -> Maybe a
Just (Threadid -> PreloginOption) -> Get Threadid -> Get PreloginOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Threadid
Get.getWord32le

    getOpt Word8
0x04 Int
_ = Word8 -> PreloginOption
PLOMars (Word8 -> PreloginOption) -> Get Word8 -> Get PreloginOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8
          
    -- [TODO] Test
    getOpt Word8
0x05 Int
_ = ByteString -> ByteString -> Threadid -> PreloginOption
PLOTraceid (ByteString -> ByteString -> Threadid -> PreloginOption)
-> Get ByteString -> Get (ByteString -> Threadid -> PreloginOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
Get.getByteString Int
16
                               Get (ByteString -> Threadid -> PreloginOption)
-> Get ByteString -> Get (Threadid -> PreloginOption)
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get ByteString
Get.getByteString Int
16
                               Get (Threadid -> PreloginOption)
-> Get Threadid -> Get PreloginOption
forall a b. Get (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Threadid
Get.getWord32le

    -- [TODO] Test
    getOpt Word8
0x06 Int
_ = Word8 -> PreloginOption
PLOFedAuthRequired (Word8 -> PreloginOption) -> Get Word8 -> Get PreloginOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Get.getWord8
    
    -- [TODO] Test
    getOpt Word8
0x07 Int
_ = ByteString -> PreloginOption
PLONonceOpt (ByteString -> PreloginOption)
-> Get ByteString -> Get PreloginOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
Get.getByteString Int
32
                


instance Binary Prelogin where
  put :: Prelogin -> Put
put = Prelogin -> Put
putPrelogin
  get :: Get Prelogin
get = Get Prelogin
getPrelogin