{-# OPTIONS_HADDOCK hide #-}
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
type Activity = B.ByteString
type Sequence = Word32
type Nonce = B.ByteString
data PreloginOption = PLOVersion !MajorVer !MinorVer !BuildVer !SubBuildVer
| PLOEncryption !Word8
| PLOInstopt !B.ByteString
| PLOThreadid !(Maybe Threadid)
| PLOMars !Word8
| 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)
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
f (PLOFedAuthRequired MajorVer
_) = Int
1
f (PLONonceOpt ByteString
_) = Int
32
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
[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
PLOFedAuthRequired MajorVer
_ -> MajorVer
0x06
PLONonceOpt ByteString
_ -> MajorVer
0x07
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
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
putOpt (PLOFedAuthRequired MajorVer
b) = MajorVer -> Put
Put.putWord8 MajorVer
b
putOpt (PLONonceOpt ByteString
opt) = ByteString -> Put
Put.putByteString ByteString
opt
getPrelogin :: Get Prelogin
getPrelogin :: Get Prelogin
getPrelogin = do
[(MajorVer, Int, Int)]
idcs <- Get [(MajorVer, Int, Int)]
getIndices
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
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
(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 =
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
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
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
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