content: {-# LANGUAGE OverloadedStrings #-}
  
  module Network.QUIC.Packet.Decode (
      decodePacket,
      decodePackets,
      decodeCryptPackets,
      decodeStatelessResetToken,
  ) where
  
  import qualified Control.Exception as E
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Short as Short
  
  import Network.QUIC.Imports
  import Network.QUIC.Packet.Header
  import Network.QUIC.Types
  
  ----------------------------------------------------------------
  
  -- Server uses this.
  decodeCryptPackets
      :: ByteString -> Bool -> IO [(CryptPacket, EncryptionLevel, Int)]
  decodeCryptPackets bs0 checkQuicBit = unwrap <$> decodePackets bs0 checkQuicBit
    where
      unwrap (PacketIC c l s : xs) = loop (c, l, s) xs
      unwrap (_ : xs) = unwrap xs
      unwrap [] = []
      loop p (PacketIC c l s : xs) = p : loop (c, l, s) xs
      -- For anti-amplification, adding the length of broken packets
      -- as if it is pddings.
      loop (c, l, s) (PacketIB BrokenPacket siz : xs) = loop (c, l, s + siz) xs
      loop p (_ : xs) = loop p xs
      loop p [] = [p]
  
  -- Client uses this.
  decodePackets :: ByteString -> Bool -> IO [PacketI]
  decodePackets bs0 checkQuicBit = loop bs0 id
    where
      loop "" build = return $ build [] -- fixme
      loop bs build = do
          (pkt, rest) <- decodePacket bs checkQuicBit
          loop rest (build . (pkt :))
  
  decodePacket :: ByteString -> Bool -> IO (PacketI, ByteString)
  decodePacket bs checkQuicBit = E.handle handler $ withReadBuffer bs $ \rbuf -> do
      save rbuf
      proFlags <- Flags <$> read8 rbuf
      if checkQuicBit && not (isQuic proFlags)
          then
              return (PacketIB BrokenPacket len, "")
          else do
              let short = isShort proFlags
              pkt <- decode rbuf proFlags short
              siz <- savingSize rbuf
              let rest = BS.drop siz bs
              return (pkt, rest)
    where
      decode rbuf _proFlags True = do
          header <- Short . makeCID <$> extractShortByteString rbuf myCIDLength
          cpkt <- CryptPacket header <$> makeShortCrypt bs rbuf
          siz <- savingSize rbuf
          return $ PacketIC cpkt RTT1Level siz
      decode rbuf proFlags False = do
          (ver, dCID, sCID) <- decodeLongHeader rbuf
          case ver of
              Negotiation -> do
                  decodeVersionNegotiationPacket rbuf dCID sCID
              _ -> case decodeLongHeaderPacketType ver proFlags of
                  RetryPacketType -> do
                      decodeRetryPacket rbuf proFlags ver dCID sCID
                  RTT0PacketType -> do
                      let header = RTT0 ver dCID sCID
                      cpkt <- CryptPacket header <$> makeLongCrypt bs rbuf
                      siz <- savingSize rbuf
                      return $ PacketIC cpkt RTT0Level siz
                  InitialPacketType -> do
                      tokenLen <- fromIntegral <$> decodeInt' rbuf
                      token <- extractByteString rbuf tokenLen
                      let header = Initial ver dCID sCID token
                      cpkt <- CryptPacket header <$> makeLongCrypt bs rbuf
                      siz <- savingSize rbuf
                      return $ PacketIC cpkt InitialLevel siz
                  HandshakePacketType -> do
                      let header = Handshake ver dCID sCID
                      crypt <- CryptPacket header <$> makeLongCrypt bs rbuf
                      siz <- savingSize rbuf
                      return $ PacketIC crypt HandshakeLevel siz
      handler BufferOverrun = return (PacketIB BrokenPacket len, "")
      len = BS.length bs
  
  makeShortCrypt :: ByteString -> ReadBuffer -> IO Crypt
  makeShortCrypt bs rbuf = do
      len <- remainingSize rbuf
      here <- savingSize rbuf
      ff rbuf len
      return $ Crypt here bs 0
  
  makeLongCrypt :: ByteString -> ReadBuffer -> IO Crypt
  makeLongCrypt bs rbuf = do
      len <- fromIntegral <$> decodeInt' rbuf
      here <- savingSize rbuf
      ff rbuf len
      let pkt = BS.take (here + len) bs
      return $ Crypt here pkt 0
  
  ----------------------------------------------------------------
  
  decodeLongHeader :: ReadBuffer -> IO (Version, CID, CID)
  decodeLongHeader rbuf = do
      ver <- Version <$> read32 rbuf
      dcidlen <- fromIntegral <$> read8 rbuf
      dCID <- makeCID <$> extractShortByteString rbuf dcidlen
      scidlen <- fromIntegral <$> read8 rbuf
      sCID <- makeCID <$> extractShortByteString rbuf scidlen
      return (ver, dCID, sCID)
  
  decodeVersionNegotiationPacket :: ReadBuffer -> CID -> CID -> IO PacketI
  decodeVersionNegotiationPacket rbuf dCID sCID = do
      siz <- remainingSize rbuf
      vers <- decodeVersions siz id
      return $ PacketIV $ VersionNegotiationPacket dCID sCID vers
    where
      decodeVersions siz vers
          | siz >= 4 = do
              ver <- Version <$> read32 rbuf
              decodeVersions (siz - 4) ((ver :) . vers)
          | otherwise = return $ vers []
  
  decodeRetryPacket
      :: ReadBuffer -> Flags Protected -> Version -> CID -> CID -> IO PacketI
  decodeRetryPacket rbuf _proFlags version dCID sCID = do
      rsiz <- remainingSize rbuf
      token <- extractByteString rbuf (rsiz - 16)
      siz <- savingSize rbuf
      pseudo <- extractByteString rbuf $ negate siz
      tag <- extractByteString rbuf 16
      return $ PacketIR $ RetryPacket version dCID sCID token (Right (pseudo, tag))
  
  ----------------------------------------------------------------
  
  decodeStatelessResetToken :: ByteString -> Maybe StatelessResetToken
  decodeStatelessResetToken bs
      | len < 21 = Nothing
      | otherwise = Just $ StatelessResetToken $ Short.toShort token
    where
      len = BS.length bs
      (_, token) = BS.splitAt (len - 16) bs
  