module Network.QUIC.Packet.Encode (
--    encodePacket
    encodeVersionNegotiationPacket
  , encodeRetryPacket
  , encodePlainPacket
  ) where

import qualified Data.ByteString as BS
import Foreign.Ptr
import Foreign.Storable (peek)

import Network.QUIC.Connection
import Network.QUIC.Crypto
import Network.QUIC.Imports
import Network.QUIC.Packet.Frame
import Network.QUIC.Packet.Header
import Network.QUIC.Packet.Number
import Network.QUIC.Parameters
import Network.QUIC.Types

----------------------------------------------------------------

-- | This is not used internally.
{-
encodePacket :: Connection -> PacketO -> IO [ByteString]
encodePacket _    (PacketOV pkt) = (:[]) <$> encodeVersionNegotiationPacket pkt
encodePacket _    (PacketOR pkt) = (:[]) <$> encodeRetryPacket pkt
encodePacket conn (PacketOP pkt) = fst   <$> encodePlainPacket conn pkt Nothing
-}

----------------------------------------------------------------

encodeVersionNegotiationPacket :: VersionNegotiationPacket -> IO ByteString
encodeVersionNegotiationPacket :: VersionNegotiationPacket -> IO ByteString
encodeVersionNegotiationPacket (VersionNegotiationPacket CID
dCID CID
sCID [Version]
vers) = BufferSize -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer BufferSize
maximumQUICHeaderSize ((WriteBuffer -> IO ()) -> IO ByteString)
-> (WriteBuffer -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> do
    Flags Word8
flags <- IO (Flags Raw)
versionNegotiationPacketType
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf Word8
flags
    -- ver .. sCID
    WriteBuffer -> Version -> CID -> CID -> IO ()
encodeLongHeader WriteBuffer
wbuf Version
Negotiation CID
dCID CID
sCID
    -- vers
    (Version -> IO ()) -> [Version] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Version Word32
ver) -> WriteBuffer -> Word32 -> IO ()
write32 WriteBuffer
wbuf Word32
ver) [Version]
vers
    -- no header protection

----------------------------------------------------------------

encodeRetryPacket :: RetryPacket -> IO ByteString
encodeRetryPacket :: RetryPacket -> IO ByteString
encodeRetryPacket (RetryPacket Version
ver CID
dCID CID
sCID ByteString
token (Left CID
odCID)) = BufferSize -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer BufferSize
maximumQUICHeaderSize ((WriteBuffer -> IO ()) -> IO ByteString)
-> (WriteBuffer -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> do
    WriteBuffer -> IO ()
forall a. Readable a => a -> IO ()
save WriteBuffer
wbuf
    Flags Word8
flags <- IO (Flags Raw)
retryPacketType
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf Word8
flags
    WriteBuffer -> Version -> CID -> CID -> IO ()
encodeLongHeader WriteBuffer
wbuf Version
ver CID
dCID CID
sCID
    WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
token
    BufferSize
siz <- WriteBuffer -> IO BufferSize
forall a. Readable a => a -> IO BufferSize
savingSize WriteBuffer
wbuf
    ByteString
pseudo0 <- WriteBuffer -> BufferSize -> IO ByteString
forall a. Readable a => a -> BufferSize -> IO ByteString
extractByteString WriteBuffer
wbuf (BufferSize -> IO ByteString) -> BufferSize -> IO ByteString
forall a b. (a -> b) -> a -> b
$ BufferSize -> BufferSize
forall a. Num a => a -> a
negate BufferSize
siz
    let tag :: ByteString
tag = Version -> CID -> ByteString -> ByteString
calculateIntegrityTag Version
ver CID
odCID ByteString
pseudo0
    WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
tag
    -- no header protection
encodeRetryPacket RetryPacket
_ = [Char] -> IO ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"encodeRetryPacket"

----------------------------------------------------------------

encodePlainPacket :: Connection -> Buffer -> BufferSize -> PlainPacket -> Maybe Int -> IO (Int,Int)
encodePlainPacket :: Connection
-> Buffer
-> BufferSize
-> PlainPacket
-> Maybe BufferSize
-> IO (BufferSize, BufferSize)
encodePlainPacket Connection
conn Buffer
buf BufferSize
bufsiz ppkt :: PlainPacket
ppkt@(PlainPacket Header
_ Plain
plain) Maybe BufferSize
mlen = do
    let mlen' :: Maybe BufferSize
mlen' | BufferSize -> Bool
isNoPaddings (Plain -> BufferSize
plainMarks Plain
plain) = Maybe BufferSize
forall a. Maybe a
Nothing
              | Bool
otherwise                       = Maybe BufferSize
mlen
    WriteBuffer
wbuf <- Buffer -> BufferSize -> IO WriteBuffer
newWriteBuffer Buffer
buf BufferSize
bufsiz
    let encodeBuf :: Ptr b
encodeBuf = Buffer
buf Buffer -> BufferSize -> Ptr b
forall a b. Ptr a -> BufferSize -> Ptr b
`plusPtr` BufferSize
bufsiz -- see sender
    Connection
-> WriteBuffer
-> Buffer
-> PlainPacket
-> Maybe BufferSize
-> IO (BufferSize, BufferSize)
encodePlainPacket' Connection
conn WriteBuffer
wbuf Buffer
forall b. Ptr b
encodeBuf PlainPacket
ppkt Maybe BufferSize
mlen'

encodePlainPacket' :: Connection -> WriteBuffer -> Buffer -> PlainPacket -> Maybe Int -> IO (Int,Int)
encodePlainPacket' :: Connection
-> WriteBuffer
-> Buffer
-> PlainPacket
-> Maybe BufferSize
-> IO (BufferSize, BufferSize)
encodePlainPacket' Connection
conn WriteBuffer
wbuf Buffer
encodeBuf (PlainPacket (Initial Version
ver CID
dCID CID
sCID ByteString
token) (Plain Flags Raw
flags BufferSize
pn [Frame]
frames BufferSize
_)) Maybe BufferSize
mlen = do
    Buffer
headerBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    -- flag ... sCID
    (Word32
epn, BufferSize
epnLen) <- Connection
-> WriteBuffer
-> LongHeaderPacketType
-> Version
-> CID
-> CID
-> Flags Raw
-> BufferSize
-> IO (Word32, BufferSize)
encodeLongHeaderPP Connection
conn WriteBuffer
wbuf LongHeaderPacketType
InitialPacketType Version
ver CID
dCID CID
sCID Flags Raw
flags BufferSize
pn
    -- token
    WriteBuffer -> Int64 -> IO ()
encodeInt' WriteBuffer
wbuf (Int64 -> IO ()) -> Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferSize -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BufferSize -> Int64) -> BufferSize -> Int64
forall a b. (a -> b) -> a -> b
$ ByteString -> BufferSize
BS.length ByteString
token
    WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
token
    -- length .. payload
    Connection
-> WriteBuffer
-> Buffer
-> [Frame]
-> BufferSize
-> Word32
-> BufferSize
-> Buffer
-> Maybe BufferSize
-> EncryptionLevel
-> Bool
-> IO (BufferSize, BufferSize)
protectPayloadHeader Connection
conn WriteBuffer
wbuf Buffer
encodeBuf [Frame]
frames BufferSize
pn Word32
epn BufferSize
epnLen Buffer
headerBeg Maybe BufferSize
mlen EncryptionLevel
InitialLevel Bool
False

encodePlainPacket' Connection
conn WriteBuffer
wbuf Buffer
encodeBuf (PlainPacket (RTT0 Version
ver CID
dCID CID
sCID) (Plain Flags Raw
flags BufferSize
pn [Frame]
frames BufferSize
_)) Maybe BufferSize
mlen = do
    Buffer
headerBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    -- flag ... sCID
    (Word32
epn, BufferSize
epnLen) <- Connection
-> WriteBuffer
-> LongHeaderPacketType
-> Version
-> CID
-> CID
-> Flags Raw
-> BufferSize
-> IO (Word32, BufferSize)
encodeLongHeaderPP Connection
conn WriteBuffer
wbuf LongHeaderPacketType
RTT0PacketType Version
ver CID
dCID CID
sCID Flags Raw
flags BufferSize
pn
    -- length .. payload
    Connection
-> WriteBuffer
-> Buffer
-> [Frame]
-> BufferSize
-> Word32
-> BufferSize
-> Buffer
-> Maybe BufferSize
-> EncryptionLevel
-> Bool
-> IO (BufferSize, BufferSize)
protectPayloadHeader Connection
conn WriteBuffer
wbuf Buffer
encodeBuf [Frame]
frames BufferSize
pn Word32
epn BufferSize
epnLen Buffer
headerBeg Maybe BufferSize
mlen EncryptionLevel
RTT0Level Bool
False

encodePlainPacket' Connection
conn WriteBuffer
wbuf Buffer
encodeBuf (PlainPacket (Handshake Version
ver CID
dCID CID
sCID) (Plain Flags Raw
flags BufferSize
pn [Frame]
frames BufferSize
_)) Maybe BufferSize
mlen = do
    Buffer
headerBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    -- flag ... sCID
    (Word32
epn, BufferSize
epnLen) <- Connection
-> WriteBuffer
-> LongHeaderPacketType
-> Version
-> CID
-> CID
-> Flags Raw
-> BufferSize
-> IO (Word32, BufferSize)
encodeLongHeaderPP Connection
conn WriteBuffer
wbuf LongHeaderPacketType
HandshakePacketType Version
ver CID
dCID CID
sCID Flags Raw
flags BufferSize
pn
    -- length .. payload
    Connection
-> WriteBuffer
-> Buffer
-> [Frame]
-> BufferSize
-> Word32
-> BufferSize
-> Buffer
-> Maybe BufferSize
-> EncryptionLevel
-> Bool
-> IO (BufferSize, BufferSize)
protectPayloadHeader Connection
conn WriteBuffer
wbuf Buffer
encodeBuf [Frame]
frames BufferSize
pn Word32
epn BufferSize
epnLen Buffer
headerBeg Maybe BufferSize
mlen EncryptionLevel
HandshakeLevel Bool
False

encodePlainPacket' Connection
conn WriteBuffer
wbuf Buffer
encodeBuf (PlainPacket (Short CID
dCID) (Plain Flags Raw
flags BufferSize
pn [Frame]
frames BufferSize
marks)) Maybe BufferSize
mlen = do
    Buffer
headerBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    -- flag
    let (Word32
epn, BufferSize
epnLen) | BufferSize -> Bool
is4bytesPN BufferSize
marks = (BufferSize -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral BufferSize
pn, BufferSize
4)
                      | Bool
otherwise        = BufferSize -> BufferSize -> (Word32, BufferSize)
encodePacketNumber BufferSize
0 {- dummy -} BufferSize
pn
        pp :: Flags Raw
pp = BufferSize -> Flags Raw
encodePktNumLength BufferSize
epnLen
    Bool
quicBit <- Parameters -> Bool
greaseQuicBit (Parameters -> Bool) -> IO Parameters -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO Parameters
getPeerParameters Connection
conn
    (Bool
keyPhase,BufferSize
_) <- Connection -> IO (Bool, BufferSize)
getCurrentKeyPhase Connection
conn
    Flags Word8
flags' <- Flags Raw -> Flags Raw -> Bool -> Bool -> IO (Flags Raw)
encodeShortHeaderFlags Flags Raw
flags Flags Raw
pp Bool
quicBit Bool
keyPhase
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf Word8
flags'
    -- dCID
    let (ShortByteString
dcid, Word8
_) = CID -> (ShortByteString, Word8)
unpackCID CID
dCID
    WriteBuffer -> ShortByteString -> IO ()
copyShortByteString WriteBuffer
wbuf ShortByteString
dcid
    Connection
-> WriteBuffer
-> Buffer
-> [Frame]
-> BufferSize
-> Word32
-> BufferSize
-> Buffer
-> Maybe BufferSize
-> EncryptionLevel
-> Bool
-> IO (BufferSize, BufferSize)
protectPayloadHeader Connection
conn WriteBuffer
wbuf Buffer
encodeBuf [Frame]
frames BufferSize
pn Word32
epn BufferSize
epnLen Buffer
headerBeg Maybe BufferSize
mlen EncryptionLevel
RTT1Level Bool
keyPhase

----------------------------------------------------------------

encodeLongHeader :: WriteBuffer
                 -> Version -> CID -> CID
                 -> IO ()
encodeLongHeader :: WriteBuffer -> Version -> CID -> CID -> IO ()
encodeLongHeader WriteBuffer
wbuf (Version Word32
ver) CID
dCID CID
sCID = do
    WriteBuffer -> Word32 -> IO ()
write32 WriteBuffer
wbuf Word32
ver
    let (ShortByteString
dcid, Word8
dcidlen) = CID -> (ShortByteString, Word8)
unpackCID CID
dCID
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf Word8
dcidlen
    WriteBuffer -> ShortByteString -> IO ()
copyShortByteString WriteBuffer
wbuf ShortByteString
dcid
    let (ShortByteString
scid, Word8
scidlen) = CID -> (ShortByteString, Word8)
unpackCID CID
sCID
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf Word8
scidlen
    WriteBuffer -> ShortByteString -> IO ()
copyShortByteString WriteBuffer
wbuf ShortByteString
scid

----------------------------------------------------------------

encodeLongHeaderPP :: Connection -> WriteBuffer
                   -> LongHeaderPacketType -> Version -> CID -> CID
                   -> Flags Raw
                   -> PacketNumber
                   -> IO (EncodedPacketNumber, Int)
encodeLongHeaderPP :: Connection
-> WriteBuffer
-> LongHeaderPacketType
-> Version
-> CID
-> CID
-> Flags Raw
-> BufferSize
-> IO (Word32, BufferSize)
encodeLongHeaderPP Connection
conn WriteBuffer
wbuf LongHeaderPacketType
pkttyp Version
ver CID
dCID CID
sCID Flags Raw
flags BufferSize
pn = do
    let el :: (Word32, BufferSize)
el@(Word32
_, BufferSize
pnLen) = BufferSize -> BufferSize -> (Word32, BufferSize)
encodePacketNumber BufferSize
0 {- dummy -} BufferSize
pn
        pp :: Flags Raw
pp = BufferSize -> Flags Raw
encodePktNumLength BufferSize
pnLen
    Bool
quicBit <- Parameters -> Bool
greaseQuicBit (Parameters -> Bool) -> IO Parameters -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO Parameters
getPeerParameters Connection
conn
    Flags Word8
flags' <- LongHeaderPacketType
-> Flags Raw -> Flags Raw -> Bool -> IO (Flags Raw)
encodeLongHeaderFlags LongHeaderPacketType
pkttyp Flags Raw
flags Flags Raw
pp Bool
quicBit
    WriteBuffer -> Word8 -> IO ()
write8 WriteBuffer
wbuf Word8
flags'
    WriteBuffer -> Version -> CID -> CID -> IO ()
encodeLongHeader WriteBuffer
wbuf Version
ver CID
dCID CID
sCID
    (Word32, BufferSize) -> IO (Word32, BufferSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32, BufferSize)
el

----------------------------------------------------------------

protectPayloadHeader :: Connection -> WriteBuffer -> Buffer -> [Frame] -> PacketNumber -> EncodedPacketNumber -> Int -> Buffer -> Maybe Int -> EncryptionLevel -> Bool -> IO (Int,Int)
protectPayloadHeader :: Connection
-> WriteBuffer
-> Buffer
-> [Frame]
-> BufferSize
-> Word32
-> BufferSize
-> Buffer
-> Maybe BufferSize
-> EncryptionLevel
-> Bool
-> IO (BufferSize, BufferSize)
protectPayloadHeader Connection
conn WriteBuffer
wbuf Buffer
encodeBuf [Frame]
frames BufferSize
pn Word32
epn BufferSize
epnLen Buffer
headerBeg Maybe BufferSize
mlen EncryptionLevel
lvl Bool
keyPhase = do
    -- Real size is maximumUdpPayloadSize. But smaller is better.
    let encodeBufLen :: BufferSize
encodeBufLen = BufferSize
1500 BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
- BufferSize
20 BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
- BufferSize
8
    BufferSize
payloadWithoutPaddingSiz <- Buffer -> BufferSize -> [Frame] -> IO BufferSize
encodeFramesWithPadding Buffer
encodeBuf BufferSize
encodeBufLen [Frame]
frames
    Cipher
cipher <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
lvl
    Coder
coder <- Connection -> EncryptionLevel -> Bool -> IO Coder
getCoder Connection
conn EncryptionLevel
lvl Bool
keyPhase
    Protector
protector <- Connection -> EncryptionLevel -> IO Protector
getProtector Connection
conn EncryptionLevel
lvl
    -- before length or packer number
    Buffer
lengthOrPNBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    (BufferSize
packetLen, BufferSize
headerLen, BufferSize
plainLen, BufferSize
tagLen, BufferSize
padLen)
        <- Cipher
-> Buffer
-> BufferSize
-> IO (BufferSize, BufferSize, BufferSize, BufferSize, BufferSize)
forall (m :: * -> *) a.
Monad m =>
Cipher
-> Ptr a
-> BufferSize
-> m (BufferSize, BufferSize, BufferSize, BufferSize, BufferSize)
calcLen Cipher
cipher Buffer
lengthOrPNBeg BufferSize
payloadWithoutPaddingSiz
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
/= EncryptionLevel
RTT1Level) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferSize -> IO ()
forall a. Integral a => a -> IO ()
writeLen (BufferSize
epnLen BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
+ BufferSize
plainLen BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
+ BufferSize
tagLen)
    Buffer
pnBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    BufferSize -> IO ()
forall a. (Eq a, Num a) => a -> IO ()
writeEpn BufferSize
epnLen
    -- payload
    Buffer
cryptoBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    let sampleBeg :: Ptr b
sampleBeg = Buffer
pnBeg Buffer -> BufferSize -> Ptr b
forall a b. Ptr a -> BufferSize -> Ptr b
`plusPtr` BufferSize
4
    Protector -> Buffer -> IO ()
setSample Protector
protector Buffer
forall b. Ptr b
sampleBeg
    BufferSize
len <- Coder
-> Buffer
-> BufferSize
-> Buffer
-> BufferSize
-> BufferSize
-> Buffer
-> IO BufferSize
encrypt Coder
coder Buffer
encodeBuf BufferSize
plainLen Buffer
headerBeg BufferSize
headerLen BufferSize
pn Buffer
cryptoBeg
    if BufferSize
len BufferSize -> BufferSize -> Bool
forall a. Ord a => a -> a -> Bool
< BufferSize
0 then
         (BufferSize, BufferSize) -> IO (BufferSize, BufferSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (-BufferSize
1, -BufferSize
1)
      else do
        -- protecting header
        Buffer
maskBeg <- Protector -> IO Buffer
getMask Protector
protector
        if Buffer
maskBeg Buffer -> Buffer -> Bool
forall a. Eq a => a -> a -> Bool
== Buffer
forall b. Ptr b
nullPtr then
            (BufferSize, BufferSize) -> IO (BufferSize, BufferSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (-BufferSize
1, -BufferSize
1)
          else do
            Buffer -> Buffer -> BufferSize -> Buffer -> IO ()
protectHeader Buffer
headerBeg Buffer
pnBeg BufferSize
epnLen Buffer
maskBeg
            (BufferSize, BufferSize) -> IO (BufferSize, BufferSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferSize
packetLen, BufferSize
padLen)
  where
    calcLen :: Cipher
-> Ptr a
-> BufferSize
-> m (BufferSize, BufferSize, BufferSize, BufferSize, BufferSize)
calcLen Cipher
cipher Ptr a
lengthOrPNBeg BufferSize
payloadWithoutPaddingSiz = do
        let headerLen :: BufferSize
headerLen = (Ptr a
lengthOrPNBeg Ptr a -> Buffer -> BufferSize
forall a b. Ptr a -> Ptr b -> BufferSize
`minusPtr` Buffer
headerBeg)
                      -- length: assuming 2byte length
                      BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
+ (if EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
/= EncryptionLevel
RTT1Level then BufferSize
2 else BufferSize
0)
                      BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
+ BufferSize
epnLen
        let tagLen :: BufferSize
tagLen = Cipher -> BufferSize
tagLength Cipher
cipher
            plainLen :: BufferSize
plainLen = case Maybe BufferSize
mlen of
                Maybe BufferSize
Nothing          -> BufferSize
payloadWithoutPaddingSiz
                Just BufferSize
expectedLen -> BufferSize
expectedLen BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
- BufferSize
headerLen BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
- BufferSize
tagLen
            packetLen :: BufferSize
packetLen = BufferSize
headerLen BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
+ BufferSize
plainLen BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
+ BufferSize
tagLen
            padLen :: BufferSize
padLen = BufferSize
plainLen BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
- BufferSize
payloadWithoutPaddingSiz
        (BufferSize, BufferSize, BufferSize, BufferSize, BufferSize)
-> m (BufferSize, BufferSize, BufferSize, BufferSize, BufferSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (BufferSize
packetLen, BufferSize
headerLen, BufferSize
plainLen, BufferSize
tagLen, BufferSize
padLen)
    -- length: assuming 2byte length
    writeLen :: a -> IO ()
writeLen a
len = WriteBuffer -> Int64 -> IO ()
encodeInt'2 WriteBuffer
wbuf (Int64 -> IO ()) -> Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len
    writeEpn :: a -> IO ()
writeEpn a
1 = WriteBuffer -> Word8 -> IO ()
write8  WriteBuffer
wbuf (Word8 -> IO ()) -> Word8 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
epn
    writeEpn a
2 = WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf (Word16 -> IO ()) -> Word16 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
epn
    writeEpn a
3 = WriteBuffer -> Word32 -> IO ()
write24 WriteBuffer
wbuf Word32
epn
    writeEpn a
_ = WriteBuffer -> Word32 -> IO ()
write32 WriteBuffer
wbuf Word32
epn

----------------------------------------------------------------

protectHeader :: Buffer -> Buffer -> Int -> Buffer -> IO ()
protectHeader :: Buffer -> Buffer -> BufferSize -> Buffer -> IO ()
protectHeader Buffer
headerBeg Buffer
pnBeg BufferSize
epnLen Buffer
maskBeg = do
    IO ()
shuffleFlag
    BufferSize -> IO ()
shufflePN BufferSize
0
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BufferSize
epnLen BufferSize -> BufferSize -> Bool
forall a. Ord a => a -> a -> Bool
>= BufferSize
2) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferSize -> IO ()
shufflePN BufferSize
1
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BufferSize
epnLen BufferSize -> BufferSize -> Bool
forall a. Ord a => a -> a -> Bool
>= BufferSize
3) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferSize -> IO ()
shufflePN BufferSize
2
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BufferSize
epnLen BufferSize -> BufferSize -> Bool
forall a. Eq a => a -> a -> Bool
== BufferSize
4) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ BufferSize -> IO ()
shufflePN BufferSize
3
  where
    mask :: BufferSize -> IO a
mask BufferSize
n = Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Buffer
maskBeg Buffer -> BufferSize -> Ptr a
forall a b. Ptr a -> BufferSize -> Ptr b
`plusPtr` BufferSize
n)
    shuffleFlag :: IO ()
shuffleFlag = do
        Flags Raw
flags <- Word8 -> Flags Raw
forall a. Word8 -> Flags a
Flags (Word8 -> Flags Raw) -> IO Word8 -> IO (Flags Raw)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> BufferSize -> IO Word8
peek8 Buffer
headerBeg BufferSize
0
        Word8
mask0 <- BufferSize -> IO Word8
forall a. Storable a => BufferSize -> IO a
mask BufferSize
0
        let Flags Word8
proFlags = Flags Raw -> Word8 -> Flags Protected
protectFlags Flags Raw
flags Word8
mask0
        Word8 -> Buffer -> BufferSize -> IO ()
poke8 Word8
proFlags Buffer
headerBeg BufferSize
0
    shufflePN :: BufferSize -> IO ()
shufflePN BufferSize
n = do
        Word8
p0 <- Buffer -> BufferSize -> IO Word8
peek8 Buffer
pnBeg BufferSize
n
        Word8
maskn1 <- BufferSize -> IO Word8
forall a. Storable a => BufferSize -> IO a
mask (BufferSize
n BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
+ BufferSize
1)
        let pp0 :: Word8
pp0 = Word8
p0 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
`xor` Word8
maskn1
        Word8 -> Buffer -> BufferSize -> IO ()
poke8 Word8
pp0 Buffer
pnBeg BufferSize
n