content: {-# LANGUAGE BinaryLiterals #-}
  
  module Network.QUIC.Packet.Header (
      isLong,
      isShort,
      isQuic,
      protectFlags,
      unprotectFlags,
      encodeLongHeaderFlags,
      encodeShortHeaderFlags,
      decodeLongHeaderPacketType,
      encodePktNumLength,
      decodePktNumLength,
      versionNegotiationPacketType,
      retryPacketType,
  ) where
  
  import Network.QUIC.Imports
  import Network.QUIC.Types
  
  {-# INLINE isLong #-}
  isLong :: Word8 -> Bool
  isLong flags = testBit flags 7
  
  {-# INLINE isShort #-}
  isShort :: Flags Protected -> Bool
  isShort (Flags flags) = not $ testBit flags 7
  
  {-# INLINE isQuic #-}
  isQuic :: Flags Protected -> Bool
  isQuic (Flags flags) = testBit flags 6
  
  ----------------------------------------------------------------
  
  unprotectFlags :: Flags Protected -> Word8 -> Flags Raw
  unprotectFlags (Flags proFlags) mask1 = Flags flags
    where
      mask = mask1 .&. flagBits proFlags
      flags = proFlags `xor` mask
  
  protectFlags :: Flags Raw -> Word8 -> Flags Protected
  protectFlags (Flags flags) mask1 = Flags proFlags
    where
      mask = mask1 .&. flagBits flags
      proFlags = flags `xor` mask
  
  {-# INLINE flagBits #-}
  {- FOURMOLU_DISABLE -}
  flagBits :: Word8 -> Word8
  flagBits flags
      | isLong flags = 0b00001111 -- long header
      | otherwise    = 0b00011111 -- short header
  {- FOURMOLU_ENABLE -}
  
  ----------------------------------------------------------------
  
  randomizeQuicBit :: Word8 -> Bool -> IO Word8
  randomizeQuicBit flags quicBit
      | quicBit = do
          r <- getRandomOneByte
          return ((flags .&. 0b10111111) .|. (r .&. 0b01000000))
      | otherwise = return flags
  
  {-# INLINE encodeShortHeaderFlags #-}
  {- FOURMOLU_DISABLE -}
  encodeShortHeaderFlags
      :: Flags Raw -> Flags Raw -> Bool -> Bool -> IO (Flags Raw)
  encodeShortHeaderFlags (Flags fg) (Flags pp) quicBit keyPhase =
      Flags <$> randomizeQuicBit flags quicBit
    where
      flags =
                          0b01000000
              .|. (fg .&. 0b00111100)
              .|. (pp .&. 0b00000011)
              .|. (if keyPhase then 0b00000100 else 0b00000000)
  {- FOURMOLU_ENABLE -}
  
  {-# INLINE encodeLongHeaderFlags #-}
  encodeLongHeaderFlags
      :: Version
      -> LongHeaderPacketType
      -> Flags Raw
      -> Flags Raw
      -> Bool
      -> IO (Flags Raw)
  encodeLongHeaderFlags ver typ (Flags fg) (Flags pp) quicBit =
      Flags <$> randomizeQuicBit flags quicBit
    where
      Flags tp = longHeaderPacketType ver typ
      flags =
          tp
              .|. (fg .&. 0b00001100)
              .|. (pp .&. 0b00000011)
  
  {-# INLINE longHeaderPacketType #-}
  {- FOURMOLU_DISABLE -}
  longHeaderPacketType :: Version -> LongHeaderPacketType -> Flags Raw
  longHeaderPacketType Version2 InitialPacketType   = Flags 0b11010000
  longHeaderPacketType Version2 RTT0PacketType      = Flags 0b11100000
  longHeaderPacketType Version2 HandshakePacketType = Flags 0b11110000
  longHeaderPacketType Version2 RetryPacketType     = Flags 0b11000000
  longHeaderPacketType _        InitialPacketType   = Flags 0b11000000
  longHeaderPacketType _        RTT0PacketType      = Flags 0b11010000
  longHeaderPacketType _        HandshakePacketType = Flags 0b11100000
  longHeaderPacketType _        RetryPacketType     = Flags 0b11110000
  {- FOURMOLU_ENABLE -}
  
  retryPacketType :: Version -> IO (Flags Raw)
  retryPacketType Version2 = do
      r <- getRandomOneByte
      let flags = 0b11000000 .|. (r .&. 0b00001111)
      return $ Flags flags
  retryPacketType _ = do
      r <- getRandomOneByte
      let flags = 0b11110000 .|. (r .&. 0b00001111)
      return $ Flags flags
  
  versionNegotiationPacketType :: IO (Flags Raw)
  versionNegotiationPacketType = do
      r <- getRandomOneByte
      let flags = 0b10000000 .|. (r .&. 0b01111111)
      return $ Flags flags
  
  {-# INLINE decodeLongHeaderPacketType #-}
  {- FOURMOLU_DISABLE -}
  decodeLongHeaderPacketType :: Version -> Flags Protected -> LongHeaderPacketType
  decodeLongHeaderPacketType Version2 (Flags flags) = case flags .&. 0b00110000 of
      0b00010000 -> InitialPacketType
      0b00100000 -> RTT0PacketType
      0b00110000 -> HandshakePacketType
      _          -> RetryPacketType
  decodeLongHeaderPacketType _ (Flags flags) = case flags .&. 0b00110000 of
      0b00000000 -> InitialPacketType
      0b00010000 -> RTT0PacketType
      0b00100000 -> HandshakePacketType
      _          -> RetryPacketType
  {- FOURMOLU_ENABLE -}
  
  {-# INLINE encodePktNumLength #-}
  encodePktNumLength :: Int -> Flags Raw
  encodePktNumLength epnLen = Flags $ fromIntegral (epnLen - 1)
  
  {-# INLINE decodePktNumLength #-}
  decodePktNumLength :: Flags Raw -> Int
  decodePktNumLength (Flags flags) = fromIntegral (flags .&. 0b11) + 1
  