{-# LANGUAGE MagicHash #-}
-- | The Session Multiplex Protocol's packet header: what carries the TDS
-- packets of several requests over one connection under MARS.
--
-- [MC-SMP](https://learn.microsoft.com/en-us/openspecs/windows_protocols/mc-smp/04c8edde-371d-4af5-bb33-a39b3948f0af)
--
-- Every SMP packet starts with 16 bytes: the identifier 0x53, the flags
-- (exactly one of SYN, ACK, FIN and DATA), the session's identifier, the
-- packet's length (header included), a sequence number and a window, all
-- little-endian.  A DATA packet's payload is one TDS packet; the others
-- have none.
--
-- The sequence number of a DATA packet is one more than that of the
-- session's previous DATA packet from the same sender, the first being 1;
-- a SYN carries 0, and an ACK or FIN the sender's last DATA sequence
-- number.  The window is the highest sequence number the sender of the
-- packet will accept from its peer on this session: it only ever grows,
-- as the sender consumes what it received.
module Hmssql.Tds.Smp
  ( SmpHeader (..)
  , SmpFlag (..)
  , smpFlagWord
  , smpHeaderLength
  , smpIdentifier
  , readSmpHeader
  , pokeSmpHeader
  , smpControlPacket
  , smpDataPacket
  , smpInitialWindow
  ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as BI
import Data.Word (Word16, Word32, Word8)
import Foreign.Ptr (Ptr)
import Foreign.Storable (pokeByteOff)

import Hmssql.Internal.Derived
import Hmssql.Tds.Bytes (word16LeAt, word32LeAt, word8At)
import Hmssql.Tds.Bytes.Unsafe (pokeWord16LE, pokeWord32LE)

-- | What a packet is.
data SmpFlag
  = SmpSyn   -- ^ 0x01: opens a session.
  | SmpAck   -- ^ 0x02: carries a new window, nothing else.
  | SmpFin   -- ^ 0x04: closes a session.
  | SmpData  -- ^ 0x08: carries one TDS packet.
  deriving stock (SmpFlag -> SmpFlag -> Bool
(SmpFlag -> SmpFlag -> Bool)
-> (SmpFlag -> SmpFlag -> Bool) -> Eq SmpFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SmpFlag -> SmpFlag -> Bool
== :: SmpFlag -> SmpFlag -> Bool
$c/= :: SmpFlag -> SmpFlag -> Bool
/= :: SmpFlag -> SmpFlag -> Bool
Eq, Int -> SmpFlag -> ShowS
[SmpFlag] -> ShowS
SmpFlag -> String
(Int -> SmpFlag -> ShowS)
-> (SmpFlag -> String) -> ([SmpFlag] -> ShowS) -> Show SmpFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SmpFlag -> ShowS
showsPrec :: Int -> SmpFlag -> ShowS
$cshow :: SmpFlag -> String
show :: SmpFlag -> String
$cshowList :: [SmpFlag] -> ShowS
showList :: [SmpFlag] -> ShowS
Show)

smpFlagWord :: SmpFlag -> Word8
smpFlagWord :: SmpFlag -> Word8
smpFlagWord = \case
  SmpFlag
SmpSyn -> Word8
0x01
  SmpFlag
SmpAck -> Word8
0x02
  SmpFlag
SmpFin -> Word8
0x04
  SmpFlag
SmpData -> Word8
0x08

data SmpHeader = SmpHeader
  { SmpHeader -> Word8
smpFlags :: !Word8
    -- ^ As sent: one of the 'SmpFlag' bits in a valid packet.
  , SmpHeader -> Word16
smpSession :: !Word16
  , SmpHeader -> Word32
smpLength :: !Word32
    -- ^ The whole packet's, this header included.
  , SmpHeader -> Word32
smpSeqNum :: !Word32
  , SmpHeader -> Word32
smpWindow :: !Word32
  }

instance Show SmpHeader where
  showsPrec :: Int -> SmpHeader -> ShowS
showsPrec Int
p (SmpHeader Word8
a Word16
b Word32
c Word32
e Word32
f) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"SmpHeader"#
    [ Addr#
"smpFlags"# Addr# -> Word8 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word8
a, Addr#
"smpSession"# Addr# -> Word16 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word16
b, Addr#
"smpLength"# Addr# -> Word32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word32
c, Addr#
"smpSeqNum"# Addr# -> Word32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word32
e
    , Addr#
"smpWindow"# Addr# -> Word32 -> Field
forall a. Show a => Addr# -> a -> Field
:= Word32
f
    ]
  {-# OPAQUE showsPrec #-}

instance Eq SmpHeader where
  SmpHeader Word8
a Word16
b Word32
c Word32
e Word32
f == :: SmpHeader -> SmpHeader -> Bool
== SmpHeader Word8
a' Word16
b' Word32
c' Word32
e' Word32
f' =
    Word8
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
a' Bool -> Bool -> Bool
&& Word16
b Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
b' Bool -> Bool -> Bool
&& Word32
c Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
c' Bool -> Bool -> Bool
&& Word32
e Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
e' Bool -> Bool -> Bool
&& Word32
f Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
f'
  {-# OPAQUE (==) #-}

smpHeaderLength :: Int
smpHeaderLength :: Int
smpHeaderLength = Int
16

-- | The first byte of every SMP packet (SMID).
smpIdentifier :: Word8
smpIdentifier :: Word8
smpIdentifier = Word8
0x53

-- | The window a session has before its peer has said anything
-- (MC-SMP 3.1.3): how far a client may send after its SYN, which the
-- server doesn't answer.
smpInitialWindow :: Word32
smpInitialWindow :: Word32
smpInitialWindow = Word32
4

-- | The header at the start of a buffer of at least 'smpHeaderLength'
-- bytes whose first byte is 'smpIdentifier' (the caller checks both).
readSmpHeader :: B.ByteString -> SmpHeader
readSmpHeader :: ByteString -> SmpHeader
readSmpHeader ByteString
bs = SmpHeader
  { smpFlags :: Word8
smpFlags = ByteString -> Int -> Word8
word8At ByteString
bs Int
1
  , smpSession :: Word16
smpSession = ByteString -> Int -> Word16
word16LeAt ByteString
bs Int
2
  , smpLength :: Word32
smpLength = ByteString -> Int -> Word32
word32LeAt ByteString
bs Int
4
  , smpSeqNum :: Word32
smpSeqNum = ByteString -> Int -> Word32
word32LeAt ByteString
bs Int
8
  , smpWindow :: Word32
smpWindow = ByteString -> Int -> Word32
word32LeAt ByteString
bs Int
12
  }

-- | Write a header at the pointer.
pokeSmpHeader :: Ptr Word8 -> SmpFlag -> Word16 -> Int -> Word32 -> Word32 -> IO ()
pokeSmpHeader :: Ptr Word8 -> SmpFlag -> Word16 -> Int -> Word32 -> Word32 -> IO ()
pokeSmpHeader Ptr Word8
p SmpFlag
flag Word16
sid Int
len Word32
seqNum Word32
window = do
  Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p Int
0 Word8
smpIdentifier
  Ptr Word8 -> Int -> Word8 -> IO ()
forall b. Ptr b -> Int -> Word8 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
p Int
1 (SmpFlag -> Word8
smpFlagWord SmpFlag
flag)
  Ptr Word8 -> Int -> Word16 -> IO ()
pokeWord16LE Ptr Word8
p Int
2 Word16
sid
  Ptr Word8 -> Int -> Word32 -> IO ()
pokeWord32LE Ptr Word8
p Int
4 (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)
  Ptr Word8 -> Int -> Word32 -> IO ()
pokeWord32LE Ptr Word8
p Int
8 Word32
seqNum
  Ptr Word8 -> Int -> Word32 -> IO ()
pokeWord32LE Ptr Word8
p Int
12 Word32
window

-- | A packet that is its header alone: a SYN, an ACK or a FIN.
smpControlPacket :: SmpFlag -> Word16 -> Word32 -> Word32 -> B.ByteString
smpControlPacket :: SmpFlag -> Word16 -> Word32 -> Word32 -> ByteString
smpControlPacket SmpFlag
flag Word16
sid Word32
seqNum Word32
window =
  Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
smpHeaderLength ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p -> Ptr Word8 -> SmpFlag -> Word16 -> Int -> Word32 -> Word32 -> IO ()
pokeSmpHeader Ptr Word8
p SmpFlag
flag Word16
sid Int
smpHeaderLength Word32
seqNum Word32
window

-- | A DATA packet around a complete TDS packet, as its pieces: the header,
-- then the packet.  The header is separate because its sequence number and
-- window are only known under the send lock, long after the packet is complete,
-- and a 'B.ByteString' must not be written to once it exists.
smpDataPacket :: Word16 -> Word32 -> Word32 -> B.ByteString -> [B.ByteString]
smpDataPacket :: Word16 -> Word32 -> Word32 -> ByteString -> [ByteString]
smpDataPacket Word16
sid Word32
window Word32
seqNum ByteString
packet =
  [ Int -> (Ptr Word8 -> IO ()) -> ByteString
BI.unsafeCreate Int
smpHeaderLength ((Ptr Word8 -> IO ()) -> ByteString)
-> (Ptr Word8 -> IO ()) -> ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
p ->
      Ptr Word8 -> SmpFlag -> Word16 -> Int -> Word32 -> Word32 -> IO ()
pokeSmpHeader Ptr Word8
p SmpFlag
SmpData Word16
sid (Int
smpHeaderLength Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
B.length ByteString
packet) Word32
seqNum Word32
window
  , ByteString
packet
  ]