module Network.QUIC.Packet.Encode (
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
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
WriteBuffer -> Version -> CID -> CID -> IO ()
encodeLongHeader WriteBuffer
wbuf Version
Negotiation CID
dCID CID
sCID
(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
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
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
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
(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
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
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
(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
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
(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
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
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 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'
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 ()
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)
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 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)
Connection
conn WriteBuffer
wbuf Buffer
encodeBuf [Frame]
frames BufferSize
pn Word32
epn BufferSize
epnLen Buffer
headerBeg Maybe BufferSize
mlen EncryptionLevel
lvl Bool
keyPhase = do
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
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
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
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)
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)
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 ()
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