{-# 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
showList :: [PreloginOption] -> ShowS
$cshowList :: [PreloginOption] -> ShowS
show :: PreloginOption -> String
$cshow :: PreloginOption -> String
showsPrec :: Int -> PreloginOption -> ShowS
$cshowsPrec :: Int -> 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
showList :: [Prelogin] -> ShowS
$cshowList :: [Prelogin] -> ShowS
show :: Prelogin -> String
$cshow :: Prelogin -> String
showsPrec :: Int -> Prelogin -> ShowS
$cshowsPrec :: Int -> Prelogin -> ShowS
Show)


preloginOptionsIndexOffset :: [a] -> Int
preloginOptionsIndexOffset :: [a] -> Int
preloginOptionsIndexOffset [a]
ops = (Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> 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 MajorVer
_ MajorVer
_ BuildVer
_ BuildVer
_)   = 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 MajorVer
_)      = 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 MajorVer
_)            = 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 MajorVer
_) = 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
  MajorVer -> Put
Put.putWord8 MajorVer
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 :: MajorVer
ot = case PreloginOption
op of
          PLOVersion MajorVer
_ MajorVer
_ BuildVer
_ BuildVer
_   -> MajorVer
0x00
          PLOEncryption MajorVer
_      -> MajorVer
0x01
          PLOInstopt ByteString
_         -> MajorVer
0x02
          PLOThreadid Maybe Threadid
_        -> MajorVer
0x03
          PLOMars MajorVer
_            -> MajorVer
0x04
          PLOTraceid ByteString
_ ByteString
_ Threadid
_     -> MajorVer
0x05 -- [TODO] Test
          PLOFedAuthRequired MajorVer
_ -> MajorVer
0x06 -- [TODO] Test
          PLONonceOpt ByteString
_        -> MajorVer
0x07 -- [TODO] Test
        len :: Int
len = PreloginOption -> Int
preloginOptionPayloadLength PreloginOption
op
      MajorVer -> Put
Put.putWord8 MajorVer
ot
      BuildVer -> Put
Put.putWord16be (BuildVer -> Put) -> BuildVer -> Put
forall a b. (a -> b) -> a -> b
$ Int -> BuildVer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offs
      BuildVer -> Put
Put.putWord16be (BuildVer -> Put) -> BuildVer -> Put
forall a b. (a -> b) -> a -> b
$ Int -> BuildVer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
      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
        
    putOpt :: PreloginOption -> Put
    putOpt :: PreloginOption -> Put
putOpt (PLOVersion MajorVer
ma MajorVer
mi BuildVer
b BuildVer
sb) = do
      MajorVer -> Put
Put.putWord8 MajorVer
ma
      MajorVer -> Put
Put.putWord8 MajorVer
mi
      BuildVer -> Put
Put.putWord16be BuildVer
b
      BuildVer -> Put
Put.putWord16be BuildVer
sb
        
    putOpt (PLOEncryption MajorVer
enc) = MajorVer -> Put
Put.putWord8 MajorVer
enc
        
    putOpt (PLOInstopt ByteString
io) = do
      ByteString -> Put
Put.putByteString ByteString
io
      MajorVer -> Put
Put.putWord8 MajorVer
0
        
    putOpt (PLOThreadid Maybe Threadid
Nothing) = () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    putOpt (PLOThreadid (Just Threadid
tid)) = Threadid -> Put
Put.putWord32le Threadid
tid
        
    putOpt (PLOMars MajorVer
mars) = MajorVer -> Put
Put.putWord8 MajorVer
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 MajorVer
b) = MajorVer -> Put
Put.putWord8 MajorVer
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
  [(MajorVer, Int, Int)]
idcs <- Get [(MajorVer, Int, Int)]
getIndices
  -- [MEMO] calc totallen from max offset
  let (MajorVer
_,Int
maxoffs,Int
maxoffslen) = ((MajorVer, Int, Int) -> (MajorVer, Int, Int) -> Ordering)
-> [(MajorVer, Int, Int)] -> (MajorVer, Int, Int)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (\(MajorVer
_,Int
offs1,Int
_) (MajorVer
_,Int
offs2,Int
_) -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
offs1 Int
offs2) [(MajorVer, 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 = [(MajorVer, Int, Int)] -> Int
forall a. [a] -> Int
preloginOptionsIndexOffset [(MajorVer, 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 (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
$ (((MajorVer, Int, Int) -> PreloginOption)
 -> [(MajorVer, Int, Int)] -> [PreloginOption])
-> [(MajorVer, Int, Int)]
-> ((MajorVer, Int, Int) -> PreloginOption)
-> [PreloginOption]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((MajorVer, Int, Int) -> PreloginOption)
-> [(MajorVer, Int, Int)] -> [PreloginOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(MajorVer, Int, Int)]
idcs (((MajorVer, Int, Int) -> PreloginOption) -> [PreloginOption])
-> ((MajorVer, Int, Int) -> PreloginOption) -> [PreloginOption]
forall a b. (a -> b) -> a -> b
$ \(MajorVer
ot,Int
offs,Int
len) ->
    Get PreloginOption -> ByteString -> PreloginOption
forall a. Get a -> ByteString -> a
Get.runGet (MajorVer -> Int -> Get PreloginOption
getOpt MajorVer
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 [(MajorVer, Int, Int)]
getIndices = do
      MajorVer
ot <- Get MajorVer
Get.getWord8
      if MajorVer
ot MajorVer -> MajorVer -> Bool
forall a. Eq a => a -> a -> Bool
== MajorVer
0xff
        then [(MajorVer, Int, Int)] -> Get [(MajorVer, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do (MajorVer, Int, Int)
index   <- MajorVer -> Get (MajorVer, Int, Int)
getIndex MajorVer
ot
                [(MajorVer, Int, Int)]
indices <- Get [(MajorVer, Int, Int)]
getIndices
                [(MajorVer, Int, Int)] -> Get [(MajorVer, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(MajorVer, Int, Int)] -> Get [(MajorVer, Int, Int)])
-> [(MajorVer, Int, Int)] -> Get [(MajorVer, Int, Int)]
forall a b. (a -> b) -> a -> b
$ (MajorVer, Int, Int)
index(MajorVer, Int, Int)
-> [(MajorVer, Int, Int)] -> [(MajorVer, Int, Int)]
forall a. a -> [a] -> [a]
:[(MajorVer, Int, Int)]
indices
        where
          getIndex :: Word8 -> Get (Word8,Int,Int)
          getIndex :: MajorVer -> Get (MajorVer, Int, Int)
getIndex MajorVer
ot = do
            Int
offs <- BuildVer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BuildVer -> Int) -> Get BuildVer -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get BuildVer
Get.getWord16be  -- offset
            Int
len  <- BuildVer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BuildVer -> Int) -> Get BuildVer -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get BuildVer
Get.getWord16be  -- len
            (MajorVer, Int, Int) -> Get (MajorVer, Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (MajorVer
ot,Int
offs,Int
len)
          
          
                    
    getOpt :: Word8 -> Int -> Get PreloginOption
    
    getOpt :: MajorVer -> Int -> Get PreloginOption
getOpt MajorVer
0x00 Int
_ = MajorVer -> MajorVer -> BuildVer -> BuildVer -> PreloginOption
PLOVersion (MajorVer -> MajorVer -> BuildVer -> BuildVer -> PreloginOption)
-> Get MajorVer
-> Get (MajorVer -> BuildVer -> BuildVer -> PreloginOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MajorVer
Get.getWord8
                               Get (MajorVer -> BuildVer -> BuildVer -> PreloginOption)
-> Get MajorVer -> Get (BuildVer -> BuildVer -> PreloginOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get MajorVer
Get.getWord8
                               Get (BuildVer -> BuildVer -> PreloginOption)
-> Get BuildVer -> Get (BuildVer -> PreloginOption)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BuildVer
Get.getWord16be
                               Get (BuildVer -> PreloginOption)
-> Get BuildVer -> Get PreloginOption
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get BuildVer
Get.getWord16be
                               
    getOpt MajorVer
0x01 Int
_ = MajorVer -> PreloginOption
PLOEncryption (MajorVer -> PreloginOption) -> Get MajorVer -> Get PreloginOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MajorVer
Get.getWord8
    
    getOpt MajorVer
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 (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 (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 MajorVer
0x03 Int
len = do
      if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        then PreloginOption -> Get PreloginOption
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 MajorVer
0x04 Int
_ = MajorVer -> PreloginOption
PLOMars (MajorVer -> PreloginOption) -> Get MajorVer -> Get PreloginOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MajorVer
Get.getWord8
          
    -- [TODO] Test
    getOpt MajorVer
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 (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 (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Threadid
Get.getWord32le

    -- [TODO] Test
    getOpt MajorVer
0x06 Int
_ = MajorVer -> PreloginOption
PLOFedAuthRequired (MajorVer -> PreloginOption) -> Get MajorVer -> Get PreloginOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get MajorVer
Get.getWord8
    
    -- [TODO] Test
    getOpt MajorVer
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