{-# LANGUAGE RecordWildCards #-}

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

import qualified Data.ByteString as BS
import Foreign.ForeignPtr
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) = Int -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer Int
maximumQUICHeaderSize 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
    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)) = Int -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer Int
maximumQUICHeaderSize forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> do
    forall a. Readable a => a -> IO ()
save WriteBuffer
wbuf
    Flags Word8
flags <- Version -> IO (Flags Raw)
retryPacketType Version
ver
    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
    Int
siz <- forall a. Readable a => a -> IO Int
savingSize WriteBuffer
wbuf
    ByteString
pseudo0 <- forall a. Readable a => a -> Int -> IO ByteString
extractByteString WriteBuffer
wbuf forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
negate Int
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
-- only for testing
encodeRetryPacket (RetryPacket Version
ver CID
dCID CID
sCID ByteString
token (Right (ByteString
_,ByteString
tag))) = Int -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer Int
maximumQUICHeaderSize forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> do
    forall a. Readable a => a -> IO ()
save WriteBuffer
wbuf
    Flags Word8
flags <- Version -> IO (Flags Raw)
retryPacketType Version
ver
    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
    WriteBuffer -> ByteString -> IO ()
copyByteString WriteBuffer
wbuf ByteString
tag
    -- no header protection

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

-- WriteBuffer: protect(header) + encrypt(plain_frames)
-- encodeBuf:   plain_frames

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

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

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

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

encodePlainPacket' Connection
conn WriteBuffer
wbuf (PlainPacket (Short CID
dCID) (Plain Flags Raw
flags Int
pn [Frame]
frames Int
marks)) Maybe Int
mlen = do
    Buffer
headerBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    -- flag
    let (Word32
epn, Int
epnLen) | Int -> Bool
is4bytesPN Int
marks = (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pn, Int
4)
                      | Bool
otherwise        = Int -> Int -> (Word32, Int)
encodePacketNumber Int
0 {- dummy -} Int
pn
        pp :: Flags Raw
pp = Int -> Flags Raw
encodePktNumLength Int
epnLen
    Bool
quicBit <- Parameters -> Bool
greaseQuicBit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO Parameters
getPeerParameters Connection
conn
    (Bool
keyPhase,Int
_) <- Connection -> IO (Bool, Int)
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
-> [Frame]
-> Int
-> Word32
-> Int
-> Buffer
-> Maybe Int
-> EncryptionLevel
-> Bool
-> IO (Int, Int)
protectPayloadHeader Connection
conn WriteBuffer
wbuf [Frame]
frames Int
pn Word32
epn Int
epnLen Buffer
headerBeg Maybe Int
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
-> Int
-> IO (Word32, Int)
encodeLongHeaderPP Connection
conn WriteBuffer
wbuf LongHeaderPacketType
pkttyp Version
ver CID
dCID CID
sCID Flags Raw
flags Int
pn = do
    let el :: (Word32, Int)
el@(Word32
_, Int
pnLen) = Int -> Int -> (Word32, Int)
encodePacketNumber Int
0 {- dummy -} Int
pn
        pp :: Flags Raw
pp = Int -> Flags Raw
encodePktNumLength Int
pnLen
    Bool
quicBit <- Parameters -> Bool
greaseQuicBit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO Parameters
getPeerParameters Connection
conn
    Flags Word8
flags' <- Version
-> LongHeaderPacketType
-> Flags Raw
-> Flags Raw
-> Bool
-> IO (Flags Raw)
encodeLongHeaderFlags Version
ver 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
    forall (m :: * -> *) a. Monad m => a -> m a
return (Word32, Int)
el

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

protectPayloadHeader :: Connection -> WriteBuffer -> [Frame] -> PacketNumber -> EncodedPacketNumber -> Int -> Buffer -> Maybe Int -> EncryptionLevel -> Bool -> IO (Int,Int)
protectPayloadHeader :: Connection
-> WriteBuffer
-> [Frame]
-> Int
-> Word32
-> Int
-> Buffer
-> Maybe Int
-> EncryptionLevel
-> Bool
-> IO (Int, Int)
protectPayloadHeader Connection
conn WriteBuffer
wbuf [Frame]
frames Int
pn Word32
epn Int
epnLen Buffer
headerBeg Maybe Int
mlen EncryptionLevel
lvl Bool
keyPhase = do
    -- Real size is maximumUdpPayloadSize. But smaller is better.
    let encBuf :: Buffer
encBuf    = Connection -> Buffer
encodeBuf Connection
conn
        encBufLen :: Int
encBufLen = Int
1500 forall a. Num a => a -> a -> a
- Int
20 forall a. Num a => a -> a -> a
- Int
8
    Int
payloadWithoutPaddingSiz <- Buffer -> Int -> [Frame] -> IO Int
encodeFramesWithPadding Buffer
encBuf Int
encBufLen [Frame]
frames
    Cipher
cipher <- Connection -> EncryptionLevel -> IO Cipher
getCipher Connection
conn EncryptionLevel
lvl
    -- before length or packer number
    Buffer
lengthOrPNBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    (Int
packetLen, Int
headerLen, Int
plainLen, Int
tagLen, Int
padLen)
        <- forall {m :: * -> *} {a}.
Monad m =>
Cipher -> Ptr a -> Int -> m (Int, Int, Int, Int, Int)
calcLen Cipher
cipher Buffer
lengthOrPNBeg Int
payloadWithoutPaddingSiz
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl forall a. Eq a => a -> a -> Bool
/= EncryptionLevel
RTT1Level) forall a b. (a -> b) -> a -> b
$ forall {a}. Integral a => a -> IO ()
writeLen (Int
epnLen forall a. Num a => a -> a -> a
+ Int
plainLen forall a. Num a => a -> a -> a
+ Int
tagLen)
    Buffer
pnBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    forall {a}. (Eq a, Num a) => a -> IO ()
writeEpn Int
epnLen
    -- payload
    Buffer
cryptoBeg <- WriteBuffer -> IO Buffer
currentOffset WriteBuffer
wbuf
    ByteString
plaintext <- Buffer -> Int -> IO ByteString
mkBS Buffer
encBuf Int
plainLen
    ByteString
header <- Buffer -> Int -> IO ByteString
mkBS Buffer
headerBeg Int
headerLen
    --
    let sampleBeg :: Ptr b
sampleBeg = Buffer
pnBeg forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
4
    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
    Protector -> Buffer -> IO ()
setSample Protector
protector forall {b}. Ptr b
sampleBeg
    Int
len <- Coder -> Buffer -> ByteString -> AssDat -> Int -> IO Int
encrypt Coder
coder Buffer
cryptoBeg ByteString
plaintext (ByteString -> AssDat
AssDat ByteString
header) Int
pn
    Buffer
maskBeg <- Protector -> IO Buffer
getMask Protector
protector
    --
    if Int
len forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Buffer
maskBeg forall a. Eq a => a -> a -> Bool
== forall {b}. Ptr b
nullPtr then
         forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1, -Int
1)
       else do
          -- protecting header
          Buffer -> Buffer -> Int -> Buffer -> IO ()
protectHeader Buffer
headerBeg Buffer
pnBeg Int
epnLen Buffer
maskBeg
          forall (m :: * -> *) a. Monad m => a -> m a
return (Int
packetLen, Int
padLen)
  where
    calcLen :: Cipher -> Ptr a -> Int -> m (Int, Int, Int, Int, Int)
calcLen Cipher
cipher Ptr a
lengthOrPNBeg Int
payloadWithoutPaddingSiz = do
        let headerLen :: Int
headerLen = (Ptr a
lengthOrPNBeg forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Buffer
headerBeg)
                      -- length: assuming 2byte length
                      forall a. Num a => a -> a -> a
+ (if EncryptionLevel
lvl forall a. Eq a => a -> a -> Bool
/= EncryptionLevel
RTT1Level then Int
2 else Int
0)
                      forall a. Num a => a -> a -> a
+ Int
epnLen
        let tagLen :: Int
tagLen = Cipher -> Int
tagLength Cipher
cipher
            plainLen :: Int
plainLen = case Maybe Int
mlen of
                Maybe Int
Nothing          -> Int
payloadWithoutPaddingSiz
                Just Int
expectedLen -> Int
expectedLen forall a. Num a => a -> a -> a
- Int
headerLen forall a. Num a => a -> a -> a
- Int
tagLen
            packetLen :: Int
packetLen = Int
headerLen forall a. Num a => a -> a -> a
+ Int
plainLen forall a. Num a => a -> a -> a
+ Int
tagLen
            padLen :: Int
padLen = Int
plainLen forall a. Num a => a -> a -> a
- Int
payloadWithoutPaddingSiz
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int
packetLen, Int
headerLen, Int
plainLen, Int
tagLen, Int
padLen)
    -- length: assuming 2byte length
    writeLen :: a -> IO ()
writeLen a
len = WriteBuffer -> Int64 -> IO ()
encodeInt'2 WriteBuffer
wbuf forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
len
    writeEpn :: a -> IO ()
writeEpn a
1 = WriteBuffer -> Word8 -> IO ()
write8  WriteBuffer
wbuf forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
epn
    writeEpn a
2 = WriteBuffer -> Word16 -> IO ()
write16 WriteBuffer
wbuf forall a b. (a -> b) -> a -> b
$ 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 -> Int -> Buffer -> IO ()
protectHeader Buffer
headerBeg Buffer
pnBeg Int
epnLen Buffer
maskBeg = do
    IO ()
shuffleFlag
    Int -> IO ()
shufflePN Int
0
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
epnLen forall a. Ord a => a -> a -> Bool
>= Int
2) forall a b. (a -> b) -> a -> b
$ Int -> IO ()
shufflePN Int
1
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
epnLen forall a. Ord a => a -> a -> Bool
>= Int
3) forall a b. (a -> b) -> a -> b
$ Int -> IO ()
shufflePN Int
2
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
epnLen forall a. Eq a => a -> a -> Bool
== Int
4) forall a b. (a -> b) -> a -> b
$ Int -> IO ()
shufflePN Int
3
  where
    mask :: Int -> IO a
mask Int
n = forall a. Storable a => Ptr a -> IO a
peek (Buffer
maskBeg forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
n)
    shuffleFlag :: IO ()
shuffleFlag = do
        Flags Raw
flags <- forall a. Word8 -> Flags a
Flags forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Buffer -> Int -> IO Word8
peek8 Buffer
headerBeg Int
0
        Word8
mask0 <- forall {a}. Storable a => Int -> IO a
mask Int
0
        let Flags Word8
proFlags = Flags Raw -> Word8 -> Flags Protected
protectFlags Flags Raw
flags Word8
mask0
        Word8 -> Buffer -> Int -> IO ()
poke8 Word8
proFlags Buffer
headerBeg Int
0
    shufflePN :: Int -> IO ()
shufflePN Int
n = do
        Word8
p0 <- Buffer -> Int -> IO Word8
peek8 Buffer
pnBeg Int
n
        Word8
maskn1 <- forall {a}. Storable a => Int -> IO a
mask (Int
n forall a. Num a => a -> a -> a
+ Int
1)
        let pp0 :: Word8
pp0 = Word8
p0 forall a. Bits a => a -> a -> a
`xor` Word8
maskn1
        Word8 -> Buffer -> Int -> IO ()
poke8 Word8
pp0 Buffer
pnBeg Int
n

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

mkBS :: Buffer -> Int -> IO ByteString
mkBS :: Buffer -> Int -> IO ByteString
mkBS Buffer
ptr Int
siz = do
    ForeignPtr Word8
fptr <- forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Buffer
ptr
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fptr Int
0 Int
siz