{-# OPTIONS_HADDOCK hide #-}
-- Packet Header:   https://msdn.microsoft.com/en-us/library/dd340948.aspx

module Database.Tds.Message.Header ( Header (..)
                                   , headerLength
                                   ) where

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


type Type = Word8
type Status = Word8
type Length = Word16
type SPID = Word16
type PacketID = Word8
type Window = Word8

data Header = Header !Type !Status !Length !SPID !PacketID !Window


headerLength :: Integral a => a
headerLength :: forall a. Integral a => a
headerLength = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
8


-- https://msdn.microsoft.com/en-us/library/dd340948.aspx
putHeader :: Header -> Put
putHeader :: Header -> Put
putHeader (Header Type
pt Type
st Length
len Length
spid Type
pcid Type
win) = do
  Type -> Put
Put.putWord8 Type
pt      -- packet type
  Type -> Put
Put.putWord8 Type
st      -- packet status -- [TODO] flags
  Length -> Put
Put.putWord16be (Length -> Put) -> Length -> Put
forall a b. (a -> b) -> a -> b
$ Length -> Length
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Length -> Length) -> Length -> Length
forall a b. (a -> b) -> a -> b
$ Length
len -- packet len
  Length -> Put
Put.putWord16be Length
spid -- SPID
  Type -> Put
Put.putWord8 Type
pcid    -- PacketID
  Type -> Put
Put.putWord8 Type
win     -- Window

-- https://msdn.microsoft.com/en-us/library/dd340948.aspx
getHeader :: Get Header
getHeader :: Get Header
getHeader = do
  Type
pt   <- Get Type
Get.getWord8    -- packet type
  Type
st   <- Get Type
Get.getWord8    -- packet status -- [TODO] flags
  Length
len  <- Get Length
Get.getWord16be -- packet len
  Length
spid <- Get Length
Get.getWord16be -- SPID
  Type
pcid <- Get Type
Get.getWord8    -- PacketIK
  Type
win  <- Get Type
Get.getWord8    -- Window
  Header -> Get Header
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> Get Header) -> Header -> Get Header
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Length -> Length -> Type -> Type -> Header
Header Type
pt Type
st Length
len Length
spid Type
pcid Type
win


instance Binary Header where
  put :: Header -> Put
put = Header -> Put
putHeader
  get :: Get Header
get = Get Header
getHeader