packages feed

quic (empty) → 0.0.0

raw patch · 109 files changed

+20582/−0 lines, 109 filesdep +QuickCheckdep +arraydep +asyncsetup-changed

Dependencies added: QuickCheck, array, async, base, base16-bytestring, bytestring, containers, crypto-token, cryptonite, data-default-class, doctest, fast-logger, filepath, hspec, http2, iproute, memory, network, network-byte-order, psqueues, quic, random, stm, tls, tls-session-manager, unix-time, unliftio, unliftio-core, x509

Files

+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2017, IIJ Innovation Institute Inc.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++  * Redistributions of source code must retain the above copyright+    notice, this list of conditions and the following disclaimer.+  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in+    the documentation and/or other materials provided with the+    distribution.+  * Neither the name of the copyright holders nor the names of its+    contributors may be used to endorse or promote products derived+    from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.
+ Network/QUIC.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE PatternSynonyms #-}++-- | This main module provides APIs for QUIC.+module Network.QUIC (+  -- * Connection+    Connection+  , abortConnection+  -- * Stream+  , Stream+  , StreamId+  , streamId+  -- ** Category+  , isClientInitiatedBidirectional+  , isServerInitiatedBidirectional+  , isClientInitiatedUnidirectional+  , isServerInitiatedUnidirectional+  -- ** Opening+  , stream+  , unidirectionalStream+  , acceptStream+  -- ** Closing+  , closeStream+  , shutdownStream+  , resetStream+  , stopStream+  -- * IO+  , recvStream+  , sendStream+  , sendStreamMany+  -- * Information+  , ConnectionInfo(..)+  , getConnectionInfo+  -- * Statistics+  , ConnectionStats(..)+  , getConnectionStats+  -- * Synchronization+  , wait0RTTReady+  , wait1RTTReady+  , waitEstablished+  -- * Exceptions and Errors+  , QUICException(..)+  , TransportError(.., NoError, InternalError, ConnectionRefused, FlowControlError, StreamLimitError, StreamStateError, FinalSizeError, FrameEncodingError, TransportParameterError, ConnectionIdLimitError, ProtocolViolation, InvalidToken, ApplicationError, CryptoBufferExceeded, KeyUpdateError, AeadLimitReached, NoViablePath)+  , cryptoError+  , ApplicationProtocolError(..)+  ) where++import Network.QUIC.Connection+import Network.QUIC.IO+import Network.QUIC.Info+import Network.QUIC.Stream+import Network.QUIC.Types
+ Network/QUIC/Client.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE PatternSynonyms #-}++-- | This main module provides APIs for QUIC clients.+--   When a new better network interface is up,+--   migration is done automatically.+module Network.QUIC.Client (+  -- * Running a QUIC client+    run+  -- * Configration+  , ClientConfig+  , defaultClientConfig+  , ccServerName+  , ccPortName+  , ccALPN+  , ccUse0RTT+  , ccResumption+  , ccCiphers+  , ccGroups+--  , ccCredentials+  , ccValidate+  , ccAutoMigration+  -- * Resumption+  , ResumptionInfo+  , getResumptionInfo+  , isResumptionPossible+  , is0RTTPossible+  -- * Migration+  , migrate+  ) where++import Network.QUIC.Client.Run+import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Types
+ Network/QUIC/Client/Reader.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Network.QUIC.Client.Reader (+    readerClient+  , recvClient+  , ConnectionControl(..)+  , controlConnection+  ) where++import Control.Concurrent+import qualified Data.ByteString as BS+import Data.List (intersect)+import Network.Socket (Socket, getPeerName, close)+import qualified Network.Socket.ByteString as NSB+import qualified UnliftIO.Exception as E++import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Crypto+import Network.QUIC.Exception+import Network.QUIC.Imports+import Network.QUIC.Packet+import Network.QUIC.Parameters+import Network.QUIC.Qlog+import Network.QUIC.Recovery+import Network.QUIC.Socket+import Network.QUIC.Types++-- | readerClient dies when the socket is closed.+readerClient :: [Version] -> Socket -> Connection -> IO ()+readerClient myVers s0 conn = handleLogUnit logAction $ do+    getServerAddr conn >>= loop+  where+    loop msa0 = do+        ito <- readMinIdleTimeout conn+        mbs <- timeout ito $ do+            case msa0 of+              Nothing  ->     NSB.recv     s0 maximumUdpPayloadSize+              Just sa0 -> do+                  (bs, sa) <- NSB.recvFrom s0 maximumUdpPayloadSize+                  return $ if sa == sa0 then bs else ""+        case mbs of+          Nothing -> close s0+          Just "" -> loop msa0+          Just bs -> do+            now <- getTimeMicrosecond+            let bytes = BS.length bs+            addRxBytes conn bytes+            pkts <- decodePackets bs+            mapM_ (putQ now bytes) pkts+            loop msa0+    logAction msg = connDebugLog conn ("debug: readerClient: " <> msg)+    putQ _ _ (PacketIB BrokenPacket) = return ()+    putQ t _ (PacketIV pkt@(VersionNegotiationPacket dCID sCID peerVers)) = do+        qlogReceived conn pkt t+        mver <- case myVers of+          []  -> return Nothing+          [_] -> return Nothing+          _:myVers' -> case myVers' `intersect` peerVers of+                  []    -> return Nothing+                  ver:_ -> do+                      ok <- checkCIDs conn dCID (Left sCID)+                      return $ if ok then Just ver else Nothing+        E.throwTo (mainThreadId conn) $ VerNego mver+    putQ t z (PacketIC pkt lvl) = writeRecvQ (connRecvQ conn) $ mkReceivedPacket pkt t z lvl+    putQ t _ (PacketIR pkt@(RetryPacket ver dCID sCID token ex)) = do+        qlogReceived conn pkt t+        ok <- checkCIDs conn dCID ex+        when ok $ do+            resetPeerCID conn sCID+            setPeerAuthCIDs conn $ \auth -> auth { retrySrcCID  = Just sCID }+            initializeCoder conn InitialLevel $ initialSecrets ver sCID+            setToken conn token+            setRetried conn True+            releaseByRetry (connLDCC conn) >>= mapM_ put+      where+        put ppkt = putOutput conn $ OutRetrans ppkt++checkCIDs :: Connection -> CID -> Either CID (ByteString,ByteString) -> IO Bool+checkCIDs conn dCID (Left sCID) = do+    localCID <- getMyCID conn+    remoteCID <- getPeerCID conn+    return (dCID == localCID && sCID == remoteCID)+checkCIDs conn dCID (Right (pseudo0,tag)) = do+    localCID <- getMyCID conn+    remoteCID <- getPeerCID conn+    ver <- getVersion conn+    let ok = calculateIntegrityTag ver remoteCID pseudo0 == tag+    return (dCID == localCID && ok)++recvClient :: RecvQ -> IO ReceivedPacket+recvClient = readRecvQ++----------------------------------------------------------------++-- | How to control a connection.+data ConnectionControl = ChangeServerCID+                       | ChangeClientCID+                       | NATRebinding+                       | ActiveMigration+                       deriving (Eq, Show)++controlConnection :: Connection -> ConnectionControl -> IO Bool+controlConnection conn typ+  | isClient conn = do+        waitEstablished conn+        controlConnection' conn typ+  | otherwise     = return False++controlConnection' :: Connection -> ConnectionControl -> IO Bool+controlConnection' conn ChangeServerCID = do+    mn <- timeout (Microseconds 1000000) $ waitPeerCID conn -- fixme+    case mn of+      Nothing              -> return False+      Just (CIDInfo n _ _) -> do+          sendFrames conn RTT1Level [RetireConnectionID n]+          return True+controlConnection' conn ChangeClientCID = do+    cidInfo <- getNewMyCID conn+    x <- (+1) <$> getMyCIDSeqNum conn+    sendFrames conn RTT1Level [NewConnectionID cidInfo x]+    return True+controlConnection' conn NATRebinding = do+    rebind conn $ Microseconds 5000 -- nearly 0+    return True+controlConnection' conn ActiveMigration = do+    mn <- timeout (Microseconds 1000000) $ waitPeerCID conn -- fixme+    case mn of+      Nothing  -> return False+      mcidinfo -> do+          rebind conn $ Microseconds 5000000+          validatePath conn mcidinfo+          return True++rebind :: Connection -> Microseconds -> IO ()+rebind conn microseconds = do+    s0:_ <- getSockets conn+    msa0 <- getServerAddr conn+    s1 <- case msa0 of+      Nothing  -> getPeerName s0 >>= udpNATRebindingConnectedSocket+      Just sa0 -> udpNATRebindingSocket sa0+    _ <- addSocket conn s1+    v <- getVersion conn+    let reader = readerClient [v] s1 conn -- versions are dummy+    forkIO reader >>= addReader conn+    fire conn microseconds $ close s0
+ Network/QUIC/Client/Run.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Network.QUIC.Client.Run (+    run+  , migrate+  ) where++import qualified Network.Socket as NS+import UnliftIO.Async+import UnliftIO.Concurrent+import qualified UnliftIO.Exception as E++import Network.QUIC.Client.Reader+import Network.QUIC.Closer+import Network.QUIC.Common+import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Crypto+import Network.QUIC.Handshake+import Network.QUIC.Imports+import Network.QUIC.Logger+import Network.QUIC.Parameters+import Network.QUIC.QLogger+import Network.QUIC.Receiver+import Network.QUIC.Recovery+import Network.QUIC.Sender+import Network.QUIC.Socket+import Network.QUIC.Types++----------------------------------------------------------------++-- | Running a QUIC client.+--   A UDP socket is created according to 'ccServerName' and 'ccPortName'.+--+--   If 'ccAutoMigration' is 'True', a unconnected socket is made.+--   Otherwise, a connected socket is made.+--   Use the 'migrate' API for the connected socket.+run :: ClientConfig -> (Connection -> IO a) -> IO a+-- Don't use handleLogUnit here because of a return value.+run conf client = case ccVersions conf of+  []     -> E.throwIO NoVersionIsSpecified+  ver1:_ -> do+      ex <- E.try $ runClient conf client ver1+      case ex of+        Right v                        -> return v+        Left (NextVersion Nothing)     -> E.throwIO VersionNegotiationFailed+        Left (NextVersion (Just ver2)) -> runClient conf client ver2++runClient :: ClientConfig -> (Connection -> IO a) -> Version -> IO a+runClient conf client0 ver = do+    E.bracket open clse $ \(ConnRes conn send recv myAuthCIDs reader) -> do+        forkIO reader    >>= addReader conn+        forkIO timeouter >>= addTimeouter conn+        handshaker <- handshakeClient conf conn myAuthCIDs+        let client = do+                if ccUse0RTT conf then+                    wait0RTTReady conn+                  else+                    wait1RTTReady conn+                setToken conn $ resumptionToken $ ccResumption conf+                client0 conn+            ldcc = connLDCC conn+            supporters = foldr1 concurrently_ [handshaker+                                              ,sender   conn send+                                              ,receiver conn recv+                                              ,resender  ldcc+                                              ,ldccTimer ldcc+                                              ]+            runThreads = do+                er <- race supporters client+                case er of+                  Left () -> E.throwIO MustNotReached+                  Right r -> return r+        E.trySyncOrAsync runThreads >>= closure conn ldcc+  where+    open = createClientConnection conf ver+    clse connRes = do+        let conn = connResConnection connRes+        setDead conn+        freeResources conn+        killReaders conn+        socks <- getSockets conn+        mapM_ NS.close socks+        join $ replaceKillTimeouter conn++createClientConnection :: ClientConfig -> Version -> IO ConnRes+createClientConnection conf@ClientConfig{..} ver = do+    (s0,sa0) <- if ccAutoMigration then+                  udpClientSocket ccServerName ccPortName+                else+                  udpClientConnectedSocket ccServerName ccPortName+    q <- newRecvQ+    sref <- newIORef [s0]+    let send buf siz = do+            s:_ <- readIORef sref+            if ccAutoMigration then+                void $ NS.sendBufTo s buf siz sa0+              else+                void $ NS.sendBuf s buf siz+        recv = recvClient q+    myCID   <- newCID+    peerCID <- newCID+    now <- getTimeMicrosecond+    (qLog, qclean) <- dirQLogger ccQLog now peerCID "client"+    let debugLog msg | ccDebugLog = stdoutLogger msg+                     | otherwise  = return ()+    debugLog $ "Original CID: " <> bhow peerCID+    let myAuthCIDs   = defaultAuthCIDs { initSrcCID = Just myCID }+        peerAuthCIDs = defaultAuthCIDs { initSrcCID = Just peerCID, origDstCID = Just peerCID }+    conn <- clientConnection conf ver myAuthCIDs peerAuthCIDs debugLog qLog ccHooks sref q+    addResource conn qclean+    initializeCoder conn InitialLevel $ initialSecrets ver peerCID+    setupCryptoStreams conn -- fixme: cleanup+    let pktSiz0 = fromMaybe 0 ccPacketSize+        pktSiz = (defaultPacketSize sa0 `max` pktSiz0) `min` maximumPacketSize sa0+    setMaxPacketSize conn pktSiz+    setInitialCongestionWindow (connLDCC conn) pktSiz+    setAddressValidated conn+    when ccAutoMigration $ setServerAddr conn sa0+    let reader = readerClient ccVersions s0 conn -- dies when s0 is closed.+    return $ ConnRes conn send recv myAuthCIDs reader++-- | Creating a new socket and execute a path validation+--   with a new connection ID. Typically, this is used+--   for migration in the case where 'ccAutoMigration' is 'False'.+--   But this can also be used even when the value is 'True'.+migrate :: Connection -> IO Bool+migrate conn = controlConnection conn ActiveMigration
+ Network/QUIC/Closer.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Closer (closure) where++import Foreign.Marshal.Alloc+import qualified Network.Socket as NS+import UnliftIO.Concurrent+import qualified UnliftIO.Exception as E+import Foreign.Ptr++import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Packet+import Network.QUIC.Recovery+import Network.QUIC.Sender+import Network.QUIC.Types++closure :: Connection -> LDCC -> Either E.SomeException a -> IO a+closure conn ldcc (Right x) = do+    closure' conn ldcc $ ConnectionClose NoError 0 ""+    return x+closure conn ldcc (Left se)+  | Just e@(TransportErrorIsSent err desc) <- E.fromException se = do+        closure' conn ldcc $ ConnectionClose err 0 desc+        E.throwIO e+  | Just e@(ApplicationProtocolErrorIsSent err desc) <- E.fromException se = do+        closure' conn ldcc $ ConnectionCloseApp err desc+        E.throwIO e+  | Just (Abort err desc) <- E.fromException se = do+        closure' conn ldcc $ ConnectionCloseApp err desc+        E.throwIO $ ApplicationProtocolErrorIsSent err desc+  | Just (VerNego ver) <- E.fromException se = do+        E.throwIO $ NextVersion ver+  | otherwise = E.throwIO se++closure' :: Connection -> LDCC -> Frame -> IO ()+closure' conn ldcc frame = do+    killReaders conn+    killTimeouter <- replaceKillTimeouter conn+    socks@(s:_) <- clearSockets conn+    let bufsiz = maximumUdpPayloadSize+    sendBuf <- mallocBytes (bufsiz * 3)+    siz <- encodeCC conn frame sendBuf bufsiz+    let recvBuf = sendBuf `plusPtr` (bufsiz * 2)+        recv = NS.recvBuf s recvBuf bufsiz+        hook = onCloseCompleted $ connHooks conn+    send <- if isClient conn then do+               msa <- getServerAddr conn+               return $ case msa of+                 Nothing -> NS.sendBuf   s sendBuf siz+                 Just sa -> NS.sendBufTo s sendBuf siz sa+            else+              return $ NS.sendBuf s sendBuf siz+    pto <- getPTO ldcc+    void $ forkFinally (closer pto send recv hook) $ \_ -> do+        free sendBuf+        mapM_ NS.close socks+        killTimeouter++encodeCC :: Connection -> Frame -> Buffer -> BufferSize -> IO Int+encodeCC conn frame sendBuf0 bufsiz0 = do+    lvl0 <- getEncryptionLevel conn+    let lvl | lvl0 == RTT0Level = InitialLevel+            | otherwise         = lvl0+    if lvl == HandshakeLevel then do+        siz0 <- encCC sendBuf0 bufsiz0 InitialLevel+        let sendBuf1 = sendBuf0 `plusPtr` siz0+            bufsiz1 = bufsiz0 - siz0+        siz1 <- encCC sendBuf1 bufsiz1 HandshakeLevel+        return (siz0 + siz1)+      else+        encCC sendBuf0 bufsiz0 lvl+  where+    encCC sendBuf bufsiz lvl = do+        header <- mkHeader conn lvl+        mypn <- nextPacketNumber conn+        let plain = Plain (Flags 0) mypn [frame] 0+            ppkt = PlainPacket header plain+        siz <- fst <$> encodePlainPacket conn sendBuf bufsiz ppkt Nothing+        if siz >= 0 then do+            now <- getTimeMicrosecond+            qlogSent conn ppkt now+            return siz+          else+            return 0++closer :: Microseconds -> IO Int -> IO Int -> IO () -> IO ()+closer (Microseconds pto) send recv hook = loop (3 :: Int)+  where+    loop 0 = return ()+    loop n = do+        _ <- send+        getTimeMicrosecond >>= skip (Microseconds pto)+        mx <- timeout (Microseconds (pto .>>. 1)) $ recv+        case mx of+          Nothing -> hook+          Just 0  -> return ()+          Just _  -> loop (n - 1)+    skip tmo@(Microseconds duration) base = do+        mx <- timeout tmo recv+        case mx of+          Nothing -> return ()+          Just 0  -> return ()+          Just _  -> do+              Microseconds elapsed <- getElapsedTimeMicrosecond base+              let duration' = duration - elapsed+              when (duration' >= 5000) $ skip (Microseconds duration') base
+ Network/QUIC/Common.hs view
@@ -0,0 +1,22 @@+module Network.QUIC.Common where++import qualified Network.Socket as NS++import Network.QUIC.Connection+import Network.QUIC.Parameters+import Network.QUIC.Types++----------------------------------------------------------------++data ConnRes = ConnRes Connection SendBuf Receive AuthCIDs (IO ())++connResConnection :: ConnRes -> Connection+connResConnection (ConnRes conn _ _ _ _) = conn++defaultPacketSize :: NS.SockAddr -> Int+defaultPacketSize NS.SockAddrInet6{} = defaultQUICPacketSizeForIPv6+defaultPacketSize _                  = defaultQUICPacketSizeForIPv4++maximumPacketSize :: NS.SockAddr -> Int+maximumPacketSize NS.SockAddrInet6{} = 1500 - 40 - 8 -- fixme+maximumPacketSize _                  = 1500 - 20 - 8 -- fixme
+ Network/QUIC/Config.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++module Network.QUIC.Config where++import Data.IP+import Network.Socket+import Network.TLS hiding (Version, HostName, Hooks)+import Network.TLS.QUIC++import Network.QUIC.Imports+import Network.QUIC.Parameters+import Network.QUIC.Stream+import Network.QUIC.Types++----------------------------------------------------------------++-- | Hooks.+data Hooks = Hooks {+    onCloseCompleted :: IO ()+  , onPlainCreated  :: EncryptionLevel -> Plain -> Plain+  , onTransportParametersCreated :: Parameters -> Parameters+  , onTLSExtensionCreated :: [ExtensionRaw] -> [ExtensionRaw]+  , onTLSHandshakeCreated :: [(EncryptionLevel,CryptoData)] -> ([(EncryptionLevel,CryptoData)],Bool)+  , onResetStreamReceived :: Stream -> ApplicationProtocolError -> IO ()+  }++-- | Default hooks.+defaultHooks :: Hooks+defaultHooks = Hooks {+    onCloseCompleted = return ()+  , onPlainCreated  = \_l p -> p+  , onTransportParametersCreated = id+  , onTLSExtensionCreated = id+  , onTLSHandshakeCreated = (, False)+  , onResetStreamReceived = \_ _ -> return ()+  }++----------------------------------------------------------------++-- | Client configuration.+data ClientConfig = ClientConfig {+    ccVersions      :: [Version] -- ^ Versions in the preferred order.+  , ccCiphers       :: [Cipher] -- ^ Cipher candidates defined in TLS 1.3.+  , ccGroups        :: [Group] -- ^ Key exchange group candidates defined in TLS 1.3.+  , ccParameters    :: Parameters+  , ccKeyLog        :: String -> IO ()+  , ccQLog          :: Maybe FilePath+  , ccCredentials   :: Credentials -- ^ TLS credentials.+  , ccHooks         :: Hooks+  , ccUse0RTT       :: Bool -- ^ Use 0-RTT on the 2nd connection if possible.+  -- client original+  , ccServerName    :: HostName -- ^ Used to create a socket and SNI for TLS.+  , ccPortName      :: ServiceName -- ^ Used to create a socket.+  , ccALPN          :: Version -> IO (Maybe [ByteString]) -- ^ An ALPN provider.+  , ccValidate      :: Bool -- ^ Authenticating a server based on its certificate.+  , ccResumption    :: ResumptionInfo  -- ^ Use resumption on the 2nd connection if possible.+  , ccPacketSize    :: Maybe Int -- ^ QUIC packet size (UDP payload size)+  , ccDebugLog      :: Bool+  , ccAutoMigration :: Bool -- ^ If 'True', use a unconnected socket for auto migration. Otherwise, use a connected socket.+  }++-- | The default value for client configuration.+defaultClientConfig :: ClientConfig+defaultClientConfig = ClientConfig {+    ccVersions    = [Version1,Draft29]+                         -- intentionally excluding cipher_TLS13_CHACHA20POLY1305_SHA256 due to cryptonite limitation+  , ccCiphers       = supportedCiphers defaultSupported+  , ccGroups        = supportedGroups defaultSupported+  , ccParameters    = defaultParameters+  , ccKeyLog        = \_ -> return ()+  , ccQLog          = Nothing+  , ccCredentials   = mempty+  , ccHooks         = defaultHooks+  , ccUse0RTT       = False+  -- client original+  , ccServerName    = "127.0.0.1"+  , ccPortName      = "4433"+  , ccALPN          = \_ -> return Nothing+  , ccValidate      = True+  , ccResumption    = defaultResumptionInfo+  , ccPacketSize    = Nothing+  , ccDebugLog      = False+  , ccAutoMigration = True+  }++----------------------------------------------------------------++-- | Server configuration.+data ServerConfig = ServerConfig {+    scVersions       :: [Version] -- ^ Versions in the preferred order.+  , scCiphers        :: [Cipher] -- ^ Cipher candidates defined in TLS 1.3.+  , scGroups         :: [Group] -- ^ Key exchange group candidates defined in TLS 1.3.+  , scParameters     :: Parameters+  , scKeyLog         :: String -> IO ()+  , scQLog           :: Maybe FilePath+  , scCredentials    :: Credentials -- ^ Server certificate information.+  , scHooks          :: Hooks+  , scUse0RTT        :: Bool -- ^ Use 0-RTT on the 2nd connection if possible.+  -- server original+  , scAddresses      :: [(IP,PortNumber)] -- ^ Server addresses assigned to used network interfaces.+  , scALPN           :: Maybe (Version -> [ByteString] -> IO ByteString) -- ^ ALPN handler.+  , scRequireRetry   :: Bool -- ^ Requiring QUIC retry.+  , scSessionManager :: SessionManager -- ^ A session manager of TLS 1.3.+  , scDebugLog       :: Maybe FilePath+  }++-- | The default value for server configuration.+defaultServerConfig :: ServerConfig+defaultServerConfig = ServerConfig {+    scVersions       = [Version1,Draft29]+                         -- intentionally excluding cipher_TLS13_CHACHA20POLY1305_SHA256 due to cryptonite limitation+  , scCiphers        = supportedCiphers defaultSupported+  , scGroups         = supportedGroups defaultSupported+  , scParameters     = defaultParameters+  , scKeyLog         = \_ -> return ()+  , scQLog           = Nothing+  , scCredentials    = mempty+  , scHooks          = defaultHooks+  , scUse0RTT        = False+  -- server original+  , scAddresses      = [("127.0.0.1",4433)]+  , scALPN           = Nothing+  , scRequireRetry   = False+  , scSessionManager = noSessionManager+  , scDebugLog       = Nothing+  }
+ Network/QUIC/Connection.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Connection (+    module Network.QUIC.Connection.PacketNumber+  , module Network.QUIC.Connection.Crypto+  , module Network.QUIC.Connection.Migration+  , module Network.QUIC.Connection.Misc+  , module Network.QUIC.Connection.State+  , module Network.QUIC.Connection.Stream+  , module Network.QUIC.Connection.StreamTable+  , module Network.QUIC.Connection.Queue+  , module Network.QUIC.Connection.Role+  , module Network.QUIC.Connection.Timeout+  , module Network.QUIC.Connection.Types+  ) where++import Network.QUIC.Connection.Crypto+import Network.QUIC.Connection.Migration+import Network.QUIC.Connection.Misc+import Network.QUIC.Connection.PacketNumber+import Network.QUIC.Connection.Queue+import Network.QUIC.Connection.Role+import Network.QUIC.Connection.State+import Network.QUIC.Connection.Stream+import Network.QUIC.Connection.StreamTable+import Network.QUIC.Connection.Timeout+import Network.QUIC.Connection.Types
+ Network/QUIC/Connection/Crypto.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Connection.Crypto (+    setEncryptionLevel+  , waitEncryptionLevel+  , putOffCrypto+  --+  , getCipher+  , setCipher+  , getTLSMode+  , getApplicationProtocol+  , setNegotiated+  --+  , dropSecrets+  --+  , initializeCoder+  , initializeCoder1RTT+  , updateCoder1RTT+  , getCoder+  , getProtector+  --+  , getCurrentKeyPhase+  , setCurrentKeyPhase+  ) where++import Control.Concurrent.STM+import Network.TLS.QUIC++import Network.QUIC.Connection.Types+import Network.QUIC.Connector+import Network.QUIC.Crypto+import Network.QUIC.CryptoFusion+import Network.QUIC.Imports+import Network.QUIC.Types++----------------------------------------------------------------++setEncryptionLevel :: Connection -> EncryptionLevel -> IO ()+setEncryptionLevel Connection{..} lvl = do+    let q = connRecvQ+    atomically $ do+        writeTVar (encryptionLevel connState) lvl+        case lvl of+          HandshakeLevel -> do+              readTVar (pendingQ ! RTT0Level)      >>= mapM_ (prependRecvQ q)+              readTVar (pendingQ ! HandshakeLevel) >>= mapM_ (prependRecvQ q)+          RTT1Level      ->+              readTVar (pendingQ ! RTT1Level)      >>= mapM_ (prependRecvQ q)+          _              -> return ()++putOffCrypto :: Connection -> EncryptionLevel -> ReceivedPacket -> IO ()+putOffCrypto Connection{..} lvl rpkt =+    atomically $ modifyTVar' (pendingQ ! lvl) (rpkt :)++waitEncryptionLevel :: Connection -> EncryptionLevel -> IO ()+waitEncryptionLevel Connection{..} lvl = atomically $ do+    l <- readTVar $ encryptionLevel connState+    check (l >= lvl)++----------------------------------------------------------------++getCipher :: Connection -> EncryptionLevel -> IO Cipher+getCipher Connection{..} lvl = readArray ciphers lvl++setCipher :: Connection -> EncryptionLevel -> Cipher -> IO ()+setCipher Connection{..} lvl cipher = writeArray ciphers lvl cipher++----------------------------------------------------------------++getTLSMode :: Connection -> IO HandshakeMode13+getTLSMode Connection{..} = tlsHandshakeMode <$> readIORef negotiated++getApplicationProtocol :: Connection -> IO (Maybe NegotiatedProtocol)+getApplicationProtocol Connection{..} = applicationProtocol <$> readIORef negotiated++setNegotiated :: Connection -> HandshakeMode13 -> Maybe NegotiatedProtocol -> ApplicationSecretInfo -> IO ()+setNegotiated Connection{..} mode mproto appSecInf =+    writeIORef negotiated Negotiated {+        tlsHandshakeMode = mode+      , applicationProtocol = mproto+      , applicationSecretInfo = appSecInf+      }++----------------------------------------------------------------++dropSecrets :: Connection -> EncryptionLevel -> IO ()+dropSecrets Connection{..} lvl = do+    writeArray coders lvl initialCoder+    writeArray protectors lvl initialProtector++----------------------------------------------------------------++initializeCoder :: Connection -> EncryptionLevel -> TrafficSecrets a -> IO ()+initializeCoder conn lvl sec = do+    cipher <- getCipher conn lvl+    (coder, protector, _) <- genCoder (isClient conn) cipher sec+    writeArray (coders conn) lvl coder+    writeArray (protectors conn) lvl protector++initializeCoder1RTT :: Connection -> TrafficSecrets ApplicationSecret -> IO ()+initializeCoder1RTT conn sec = do+    cipher <- getCipher conn RTT1Level+    (coder, protector, supp) <- genCoder (isClient conn) cipher sec+    let coder1 = Coder1RTT coder sec supp+    writeArray (coders1RTT conn) False coder1+    writeArray (protectors conn) RTT1Level protector+    updateCoder1RTT conn True++updateCoder1RTT :: Connection -> Bool -> IO ()+updateCoder1RTT conn nextPhase = do+    cipher <- getCipher conn RTT1Level+    Coder1RTT _ secN supp <- readArray (coders1RTT conn) (not nextPhase)+    let secN1 = updateSecret cipher secN+    coderN1 <- genCoder1RTT (isClient conn) cipher secN1 supp+    let nextCoder = Coder1RTT coderN1 secN1 supp+    writeArray (coders1RTT conn) nextPhase nextCoder++updateSecret :: Cipher -> TrafficSecrets ApplicationSecret -> TrafficSecrets ApplicationSecret+updateSecret cipher (ClientTrafficSecret cN, ServerTrafficSecret sN) = secN1+  where+    Secret cN1 = nextSecret cipher $ Secret cN+    Secret sN1 = nextSecret cipher $ Secret sN+    secN1 = (ClientTrafficSecret cN1, ServerTrafficSecret sN1)++genCoder :: Bool -> Cipher -> TrafficSecrets a -> IO (Coder, Protector, Supplement)+genCoder cli cipher (ClientTrafficSecret c, ServerTrafficSecret s) = do+    fctxt <- fusionNewContext+    fctxr <- fusionNewContext+    fusionSetup cipher fctxt txPayloadKey txPayloadIV+    fusionSetup cipher fctxr rxPayloadKey rxPayloadIV+    supp <- fusionSetupSupplement cipher txHeaderKey+    let enc = fusionEncrypt fctxt supp+        dec = fusionDecrypt fctxr+        coder = Coder enc dec+    let set = fusionSetSample supp+        get = fusionGetMask supp+    let protector = Protector set get unp+    return (coder, protector, supp)+  where+    txSecret | cli           = Secret c+             | otherwise     = Secret s+    rxSecret | cli           = Secret s+             | otherwise     = Secret c+    txPayloadKey = aeadKey cipher txSecret+    txPayloadIV  = initialVector cipher txSecret+    txHeaderKey  = headerProtectionKey cipher txSecret+    rxPayloadKey = aeadKey cipher rxSecret+    rxPayloadIV  = initialVector cipher rxSecret+    rxHeaderKey  = headerProtectionKey cipher rxSecret+    unp = protectionMask cipher rxHeaderKey++genCoder1RTT :: Bool -> Cipher -> TrafficSecrets a -> Supplement -> IO Coder+genCoder1RTT cli cipher (ClientTrafficSecret c, ServerTrafficSecret s) supp = do+    fctxt <- fusionNewContext+    fctxr <- fusionNewContext+    fusionSetup cipher fctxt txPayloadKey txPayloadIV+    fusionSetup cipher fctxr rxPayloadKey rxPayloadIV+    let enc = fusionEncrypt fctxt supp+        dec = fusionDecrypt fctxr+        coder = Coder enc dec+    return coder+  where+    txSecret | cli           = Secret c+             | otherwise     = Secret s+    rxSecret | cli           = Secret s+             | otherwise     = Secret c+    txPayloadKey = aeadKey cipher txSecret+    txPayloadIV  = initialVector cipher txSecret+    rxPayloadKey = aeadKey cipher rxSecret+    rxPayloadIV  = initialVector cipher rxSecret++getCoder :: Connection -> EncryptionLevel -> Bool -> IO Coder+getCoder conn RTT1Level k = coder1RTT <$> readArray (coders1RTT conn) k+getCoder conn lvl       _ = readArray (coders conn) lvl++getProtector :: Connection -> EncryptionLevel -> IO Protector+getProtector conn lvl = readArray (protectors conn) lvl++----------------------------------------------------------------++getCurrentKeyPhase :: Connection -> IO (Bool, PacketNumber)+getCurrentKeyPhase Connection{..} = readIORef currentKeyPhase++setCurrentKeyPhase :: Connection -> Bool -> PacketNumber -> IO ()+setCurrentKeyPhase Connection{..} k pn = writeIORef currentKeyPhase (k, pn)
+ Network/QUIC/Connection/Migration.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Connection.Migration (+    getMyCID+  , getMyCIDs+  , getPeerCID+  , isMyCID+  , myCIDsInclude+  , shouldUpdateMyCID+  , shouldUpdatePeerCID+  , resetPeerCID+  , getNewMyCID+  , getMyCIDSeqNum+  , setMyCID+  , setPeerCIDAndRetireCIDs+  , retirePeerCID+  , retireMyCID+  , addPeerCID+  , waitPeerCID+  , choosePeerCIDForPrivacy+  , setPeerStatelessResetToken+  , isStatelessRestTokenValid+  , setMigrationStarted+  , isPathValidating+  , checkResponse+  , validatePath+  ) where++import Control.Concurrent.STM+import qualified Data.IntMap.Strict as IntMap+import qualified Data.Map.Strict as Map++import Network.QUIC.Connection.Queue+import Network.QUIC.Connection.Types+import Network.QUIC.Imports+import Network.QUIC.Qlog+import Network.QUIC.Types++----------------------------------------------------------------++getMyCID :: Connection -> IO CID+getMyCID Connection{..} = cidInfoCID . usedCIDInfo <$> readIORef myCIDDB++getMyCIDs :: Connection -> IO [CID]+getMyCIDs Connection{..} = Map.keys . revInfos <$> readIORef myCIDDB++getMyCIDSeqNum :: Connection -> IO Int+getMyCIDSeqNum Connection{..} = cidInfoSeq . usedCIDInfo <$> readIORef myCIDDB++getPeerCID :: Connection -> IO CID+getPeerCID Connection{..} = cidInfoCID . usedCIDInfo <$> readTVarIO peerCIDDB++isMyCID :: Connection -> CID -> IO Bool+isMyCID Connection{..} cid =+    (== cid) . cidInfoCID . usedCIDInfo <$> readIORef myCIDDB++shouldUpdateMyCID :: Connection -> Int -> IO Bool+shouldUpdateMyCID Connection{..} nseq = do+    useq <- cidInfoSeq . usedCIDInfo <$> readIORef myCIDDB+    return (nseq > useq)++myCIDsInclude :: Connection -> CID -> IO (Maybe Int)+myCIDsInclude Connection{..} cid =+    Map.lookup cid . revInfos <$> readIORef myCIDDB++----------------------------------------------------------------++-- | Reseting to Initial CID in the client side.+resetPeerCID :: Connection -> CID -> IO ()+resetPeerCID Connection{..} cid = atomically $ writeTVar peerCIDDB $ newCIDDB cid++----------------------------------------------------------------++-- | Sending NewConnectionID+getNewMyCID :: Connection -> IO CIDInfo+getNewMyCID Connection{..} = do+    cid <- newCID+    srt <- newStatelessResetToken+    atomicModifyIORef' myCIDDB $ new cid srt++----------------------------------------------------------------++-- | Receiving NewConnectionID+addPeerCID :: Connection -> CIDInfo -> IO ()+addPeerCID Connection{..} cidInfo = atomically $ do+    db <- readTVar peerCIDDB+    case Map.lookup (cidInfoCID cidInfo) (revInfos db) of+      Nothing -> modifyTVar' peerCIDDB $ add cidInfo+      Just _  -> return ()++shouldUpdatePeerCID :: Connection -> IO Bool+shouldUpdatePeerCID Connection{..} =+    not . triggeredByMe <$> readTVarIO peerCIDDB++-- | Automatic CID update+choosePeerCIDForPrivacy :: Connection -> IO ()+choosePeerCIDForPrivacy conn = do+    mr <- atomically $ do+        mncid <- pickPeerCID conn+        case mncid of+          Nothing   -> return ()+          Just ncid -> do+              setPeerCID conn ncid False+              return ()+        return mncid+    case mr of+      Nothing   -> return ()+      Just ncid -> qlogCIDUpdate conn $ Remote $ cidInfoCID ncid++-- | Only for the internal "migration" API+waitPeerCID :: Connection -> IO CIDInfo+waitPeerCID conn@Connection{..} = do+    r <- atomically $ do+        let ref = peerCIDDB+        db <- readTVar ref+        mncid <- pickPeerCID conn+        check $ isJust mncid+        let u = usedCIDInfo db+        setPeerCID conn (fromJust mncid) True+        return u+    qlogCIDUpdate conn $ Remote $ cidInfoCID r+    return r++pickPeerCID :: Connection -> STM (Maybe CIDInfo)+pickPeerCID Connection{..} = do+    db <- readTVar peerCIDDB+    let n = cidInfoSeq $ usedCIDInfo db+        mcidinfo = IntMap.lookup (n + 1) $ cidInfos db+    return mcidinfo++setPeerCID :: Connection -> CIDInfo -> Bool -> STM ()+setPeerCID Connection{..} cidInfo pri =+    modifyTVar' peerCIDDB $ set cidInfo pri++-- | After sending RetireConnectionID+retirePeerCID :: Connection -> Int -> IO ()+retirePeerCID Connection{..} n =+    atomically $ modifyTVar' peerCIDDB $ del n++----------------------------------------------------------------++-- | Receiving NewConnectionID+setPeerCIDAndRetireCIDs :: Connection -> Int -> IO [Int]+setPeerCIDAndRetireCIDs Connection{..} n = atomically $ do+    db <- readTVar peerCIDDB+    let (db', ns) = arrange n db+    writeTVar peerCIDDB db'+    return ns++arrange :: Int -> CIDDB -> (CIDDB, [Int])+arrange n db@CIDDB{..} = (db', dropSeqnums)+  where+    (toDrops, cidInfos') = IntMap.partitionWithKey (\k _ -> k < n) cidInfos+    dropSeqnums = IntMap.foldrWithKey (\k _ ks -> k:ks) [] toDrops+    dropCIDs = IntMap.foldr (\c r -> cidInfoCID c : r) [] toDrops+    -- IntMap.findMin is a partial function.+    -- But receiver guarantees that there is at least one cidinfo.+    usedCIDInfo' | cidInfoSeq usedCIDInfo >= n = usedCIDInfo+                 | otherwise            = snd $ IntMap.findMin cidInfos'+    revInfos' = foldr (\k m -> Map.delete k m) revInfos dropCIDs+    db' = db {+        usedCIDInfo = usedCIDInfo'+      , cidInfos    = cidInfos'+      , revInfos    = revInfos'+      }++----------------------------------------------------------------++-- | Peer starts using a new CID.+setMyCID :: Connection -> CID -> IO ()+setMyCID conn@Connection{..} ncid = do+    r <- atomicModifyIORef' myCIDDB findSet+    when r $ qlogCIDUpdate conn $ Local ncid+  where+    findSet db@CIDDB{..}+      | cidInfoCID usedCIDInfo == ncid = (db, False)+      | otherwise = case Map.lookup ncid revInfos of+          Nothing -> (db, False)+          Just n -> case IntMap.lookup n cidInfos of+            Nothing -> (db, False)+            Just ncidinfo -> (set ncidinfo False db, True)++-- | Receiving RetireConnectionID+retireMyCID :: Connection -> Int -> IO (Maybe CIDInfo)+retireMyCID Connection{..} n = atomicModifyIORef' myCIDDB $ del' n++----------------------------------------------------------------++set :: CIDInfo -> Bool -> CIDDB -> CIDDB+set cidInfo pri db = db'+  where+    db' = db {+        usedCIDInfo = cidInfo+      , triggeredByMe = pri+      }++add :: CIDInfo -> CIDDB -> CIDDB+add cidInfo@CIDInfo{..} db@CIDDB{..} = db'+  where+    db' = db {+        cidInfos = IntMap.insert cidInfoSeq cidInfo cidInfos+      , revInfos = Map.insert cidInfoCID cidInfoSeq revInfos+      }++new :: CID -> StatelessResetToken -> CIDDB -> (CIDDB, CIDInfo)+new cid srt db@CIDDB{..} = (db', cidInfo)+  where+   cidInfo = CIDInfo nextSeqNum cid srt+   db' = db {+       nextSeqNum = nextSeqNum + 1+     , cidInfos = IntMap.insert nextSeqNum cidInfo cidInfos+     , revInfos = Map.insert cid nextSeqNum revInfos+     }++del :: Int -> CIDDB -> CIDDB+del n db@CIDDB{..} = db'+  where+    db' = case IntMap.lookup n cidInfos of+      Nothing -> db+      Just cidInfo -> db {+          cidInfos = IntMap.delete n cidInfos+        , revInfos = Map.delete (cidInfoCID cidInfo) revInfos+        }++del' :: Int -> CIDDB -> (CIDDB, Maybe CIDInfo)+del' n db@CIDDB{..} = (db', mcidInfo)+  where+    mcidInfo = IntMap.lookup n cidInfos+    db' = case mcidInfo of+      Nothing -> db+      Just cidInfo -> db {+          cidInfos = IntMap.delete n cidInfos+        , revInfos = Map.delete (cidInfoCID cidInfo) revInfos+        }++----------------------------------------------------------------++setPeerStatelessResetToken :: Connection -> StatelessResetToken -> IO ()+setPeerStatelessResetToken Connection{..} srt =+    atomically $ modifyTVar' peerCIDDB adjust+  where+    adjust db@CIDDB{..} = db'+      where+        db' = case IntMap.lookup 0 cidInfos of+          Nothing      -> db+          Just cidinfo -> let cidinfo' = cidinfo { cidInfoSRT = srt }+                          in db {+                               cidInfos = IntMap.insert 0 cidinfo'+                                        $ IntMap.delete 0 cidInfos+                             , usedCIDInfo = cidinfo'+                             }++isStatelessRestTokenValid :: Connection -> CID -> StatelessResetToken -> IO Bool+isStatelessRestTokenValid Connection{..} cid srt = srtCheck <$> readTVarIO peerCIDDB+  where+    srtCheck CIDDB{..} = case Map.lookup cid revInfos of+      Nothing -> False+      Just n  -> case IntMap.lookup n cidInfos of+        Nothing -> False+        Just (CIDInfo _ _ srt0) -> srt == srt0++----------------------------------------------------------------++validatePath :: Connection -> Maybe CIDInfo -> IO ()+validatePath conn Nothing = do+    pdat <- newPathData+    setChallenges conn [pdat]+    putOutput conn $ OutControl RTT1Level [PathChallenge pdat] $ return ()+    waitResponse conn+validatePath conn (Just (CIDInfo retiredSeqNum _ _)) = do+    pdat <- newPathData+    setChallenges conn [pdat]+    putOutput conn $ OutControl RTT1Level [PathChallenge pdat, RetireConnectionID retiredSeqNum] $ return ()+    waitResponse conn+    retirePeerCID conn retiredSeqNum++setChallenges :: Connection -> [PathData] -> IO ()+setChallenges Connection{..} pdats =+    atomically $ writeTVar migrationState $ SendChallenge pdats++setMigrationStarted :: Connection -> IO ()+setMigrationStarted Connection{..} =+    atomically $ writeTVar migrationState MigrationStarted++isPathValidating :: Connection -> IO Bool+isPathValidating Connection{..} = do+    s <- readTVarIO migrationState+    case s of+      SendChallenge _  -> return True+      MigrationStarted -> return True+      _                -> return False++waitResponse :: Connection -> IO ()+waitResponse Connection{..} = atomically $ do+    state <- readTVar migrationState+    check (state == RecvResponse)+    writeTVar migrationState NonMigration++checkResponse :: Connection -> PathData -> IO ()+checkResponse Connection{..} pdat = do+    state <- readTVarIO migrationState+    case state of+      SendChallenge pdats+        | pdat `elem` pdats -> atomically $ writeTVar migrationState RecvResponse+      _ -> return ()
+ Network/QUIC/Connection/Misc.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++module Network.QUIC.Connection.Misc (+    setVersion+  , getVersion+  , getSockets+  , addSocket+  , clearSockets+  , getPeerAuthCIDs+  , setPeerAuthCIDs+  , getMyParameters+  , getPeerParameters+  , setPeerParameters+  , delayedAck+  , resetDealyedAck+  , setMaxPacketSize+  , addReader+  , killReaders+  , addTimeouter+  , replaceKillTimeouter+  , addResource+  , freeResources+  , readMinIdleTimeout+  , setMinIdleTimeout+  , sendFrames+  , closeConnection+  , abortConnection+  ) where++import Network.Socket+import System.Mem.Weak+import UnliftIO.Concurrent+import qualified UnliftIO.Exception as E++import Network.QUIC.Connection.Queue+import Network.QUIC.Connection.Timeout+import Network.QUIC.Connection.Types+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Parameters+import Network.QUIC.Types++----------------------------------------------------------------++setVersion :: Connection -> Version -> IO ()+setVersion Connection{..} ver = writeIORef quicVersion ver++getVersion :: Connection -> IO Version+getVersion Connection{..} = readIORef quicVersion++----------------------------------------------------------------++getSockets :: Connection -> IO [Socket]+getSockets Connection{..} = readIORef sockets++addSocket :: Connection -> Socket -> IO Socket+addSocket Connection{..} s1 = atomicModifyIORef' sockets $+    \ss@(s0:_) -> (s1:ss,s0)++clearSockets :: Connection -> IO [Socket]+clearSockets Connection{..} = atomicModifyIORef sockets $ \ss -> ([],ss)++----------------------------------------------------------------++getPeerAuthCIDs :: Connection -> IO AuthCIDs+getPeerAuthCIDs Connection{..} = readIORef handshakeCIDs++setPeerAuthCIDs :: Connection -> (AuthCIDs -> AuthCIDs) -> IO ()+setPeerAuthCIDs Connection{..} f = atomicModifyIORef'' handshakeCIDs f++----------------------------------------------------------------++getMyParameters :: Connection -> Parameters+getMyParameters Connection{..} = myParameters++----------------------------------------------------------------++getPeerParameters :: Connection -> IO Parameters+getPeerParameters Connection{..} = readIORef peerParameters++setPeerParameters :: Connection -> Parameters -> IO ()+setPeerParameters Connection{..} params = writeIORef peerParameters params++----------------------------------------------------------------++delayedAck :: Connection -> IO ()+delayedAck conn@Connection{..} = do+    (oldcnt,send) <- atomicModifyIORef' delayedAckCount check+    when (oldcnt == 0) $ do+        new <- cfire conn (Microseconds 20000) sendAck+        join $ atomicModifyIORef' delayedAckCancel (new,)+    when send $ do+        let new = return ()+        join $ atomicModifyIORef' delayedAckCancel (new,)+        sendAck+  where+    sendAck = putOutput conn $ OutControl RTT1Level [] $ return ()+    check 1 = (0,   (1,  True))+    check n = (n+1, (n, False))++resetDealyedAck :: Connection -> IO ()+resetDealyedAck Connection{..} = do+    writeIORef delayedAckCount 0+    let new = return ()+    join $ atomicModifyIORef' delayedAckCancel (new,)++----------------------------------------------------------------++setMaxPacketSize :: Connection -> Int -> IO ()+setMaxPacketSize Connection{..} n = writeIORef (maxPacketSize connState) n++----------------------------------------------------------------++addResource :: Connection -> IO () -> IO ()+addResource Connection{..} f = atomicModifyIORef'' connResources $ \fs -> f' >> fs+  where+    f' = f `E.catch` (\(E.SomeException _) -> return ())++freeResources :: Connection -> IO ()+freeResources Connection{..} =+    join $ atomicModifyIORef' connResources (return (),)++----------------------------------------------------------------++addReader :: Connection -> ThreadId -> IO ()+addReader Connection{..} tid = do+    wtid <- mkWeakThreadId tid+    atomicModifyIORef'' readers $ \m -> do+        m+        deRefWeak wtid >>= mapM_ killThread++killReaders :: Connection -> IO ()+killReaders Connection{..} = join $ readIORef readers++----------------------------------------------------------------++addTimeouter :: Connection -> ThreadId -> IO ()+addTimeouter Connection{..} tid = do+    wtid <- mkWeakThreadId tid+    writeIORef tmouter (deRefWeak wtid >>= mapM_ killThread)++replaceKillTimeouter :: Connection -> IO (IO ())+replaceKillTimeouter Connection{..} = atomicModifyIORef' tmouter $ \m -> (return (), m)++----------------------------------------------------------------++readMinIdleTimeout :: Connection -> IO Microseconds+readMinIdleTimeout Connection{..} = readIORef minIdleTimeout++setMinIdleTimeout :: Connection -> Microseconds -> IO ()+setMinIdleTimeout Connection{..} us+  | us == Microseconds 0 = return ()+  | otherwise            = atomicModifyIORef'' minIdleTimeout modify+  where+    modify us0 = min us us0++----------------------------------------------------------------++sendFrames :: Connection -> EncryptionLevel -> [Frame] -> IO ()+sendFrames conn lvl frames = putOutput conn $ OutControl lvl frames $ return ()++-- | Closing a connection with/without a transport error.+--   Internal threads should use this.+closeConnection :: TransportError -> ReasonPhrase -> IO ()+closeConnection err desc = E.throwIO quicexc+  where+    quicexc = TransportErrorIsSent err desc++-- | Closing a connection with an application protocol error.+abortConnection :: Connection -> ApplicationProtocolError -> ReasonPhrase -> IO ()+abortConnection conn err desc = E.throwTo (mainThreadId conn) $ Abort err desc
+ Network/QUIC/Connection/PacketNumber.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Connection.PacketNumber (+    nextPacketNumber+  , setPeerPacketNumber+  , getPeerPacketNumber+  ) where++import Network.QUIC.Connection.Types+import Network.QUIC.Connector+import Network.QUIC.Imports hiding (range)+import Network.QUIC.Types++----------------------------------------------------------------+-- My packet numbers++nextPacketNumber :: Connection -> IO PacketNumber+nextPacketNumber Connection{..} = atomicModifyIORef' (packetNumber connState) inc+  where+    inc pn = (pn + 1, pn)++----------------------------------------------------------------+-- Peer's max packet number for RTT1++getPeerPacketNumber :: Connection -> IO PacketNumber+getPeerPacketNumber Connection{..} = readIORef peerPacketNumber++setPeerPacketNumber :: Connection -> PacketNumber -> IO ()+setPeerPacketNumber Connection{..} n = atomicModifyIORef'' peerPacketNumber set+  where+    set m = max m n
+ Network/QUIC/Connection/Queue.hs view
@@ -0,0 +1,50 @@+module Network.QUIC.Connection.Queue where++import Control.Concurrent.STM++import Network.QUIC.Connection.Types+import Network.QUIC.Stream+import Network.QUIC.Types++takeInput :: Connection -> IO Input+takeInput conn = atomically $ readTQueue (inputQ conn)++putInput :: Connection -> Input -> IO ()+putInput conn inp = atomically $ writeTQueue (inputQ conn) inp++takeCrypto :: Connection -> IO Crypto+takeCrypto conn = atomically $ readTQueue (cryptoQ conn)++putCrypto :: Connection -> Crypto -> IO ()+putCrypto conn inp = atomically $ writeTQueue (cryptoQ conn) inp++takeOutputSTM :: Connection -> STM Output+takeOutputSTM conn = readTQueue (outputQ conn)++tryPeekOutput :: Connection -> IO (Maybe Output)+tryPeekOutput conn = atomically $ tryPeekTQueue (outputQ conn)++putOutput :: Connection -> Output -> IO ()+putOutput conn out = atomically $ writeTQueue (outputQ conn) out++----------------------------------------------------------------++takeSendStreamQ :: Connection -> IO TxStreamData+takeSendStreamQ conn = atomically $ readTQueue $ sharedSendStreamQ $ shared conn++takeSendStreamQSTM :: Connection -> STM TxStreamData+takeSendStreamQSTM conn = readTQueue $ sharedSendStreamQ $ shared conn++tryPeekSendStreamQ :: Connection -> IO (Maybe TxStreamData)+tryPeekSendStreamQ conn = atomically $ tryPeekTQueue $ sharedSendStreamQ $ shared conn++putSendStreamQ :: Connection -> TxStreamData -> IO ()+putSendStreamQ conn out = atomically $ writeTQueue (sharedSendStreamQ $ shared conn) out++----------------------------------------------------------------++readMigrationQ :: Connection -> IO ReceivedPacket+readMigrationQ conn = atomically $ readTQueue $ migrationQ conn++writeMigrationQ :: Connection -> ReceivedPacket -> IO ()+writeMigrationQ conn x = atomically $ writeTQueue (migrationQ conn) x
+ Network/QUIC/Connection/Role.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Connection.Role (+    setToken+  , getToken+  , getResumptionInfo+  , setRetried+  , getRetried+  , setResumptionSession+  , setNewToken+  , setRegister+  , getRegister+  , getUnregister+  , setTokenManager+  , getTokenManager+  , setBaseThreadId+  , getBaseThreadId+  , setCertificateChain+  , getCertificateChain+  , setServerAddr+  , getServerAddr+  ) where++import Control.Concurrent+import qualified Crypto.Token as CT+import Data.X509 (CertificateChain)+import Network.Socket (SockAddr)++import Network.QUIC.Connection.Types+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Types++----------------------------------------------------------------++setToken :: Connection -> Token -> IO ()+setToken Connection{..} token = atomicModifyIORef'' roleInfo $+    \ci -> ci { clientInitialToken = token }++getToken :: Connection -> IO Token+getToken conn@Connection{..}+  | isClient conn = clientInitialToken <$> readIORef roleInfo+  | otherwise     = return emptyToken++----------------------------------------------------------------++-- | Getting information about resumption.+getResumptionInfo :: Connection -> IO ResumptionInfo+getResumptionInfo Connection{..} = resumptionInfo <$> readIORef roleInfo++----------------------------------------------------------------++setRetried :: Connection -> Bool -> IO ()+setRetried conn@Connection{..} r+  | isClient conn = atomicModifyIORef'' roleInfo $ \ci -> ci {+        resumptionInfo = (resumptionInfo ci) { resumptionRetry = r}+        }+  | otherwise     = atomicModifyIORef'' roleInfo $ \si -> si { askRetry = r }++getRetried :: Connection -> IO Bool+getRetried conn@Connection{..}+  | isClient conn = resumptionRetry . resumptionInfo <$> readIORef roleInfo+  | otherwise     = askRetry <$> readIORef roleInfo++----------------------------------------------------------------++setResumptionSession :: Connection -> SessionEstablish+setResumptionSession Connection{..} si sd = atomicModifyIORef'' roleInfo $ \ci -> ci {+    resumptionInfo = (resumptionInfo ci) { resumptionSession = Just (si,sd) }+  }++setNewToken :: Connection -> Token -> IO ()+setNewToken Connection{..} token = atomicModifyIORef'' roleInfo $ \ci -> ci {+    resumptionInfo = (resumptionInfo ci) { resumptionToken = token }+  }++----------------------------------------------------------------++setRegister :: Connection -> (CID -> Connection -> IO ()) -> (CID -> IO ()) -> IO ()+setRegister Connection{..} regisrer unregister = atomicModifyIORef'' roleInfo $ \si -> si {+    registerCID = regisrer+  , unregisterCID = unregister+  }++getRegister :: Connection -> IO (CID -> Connection -> IO ())+getRegister Connection{..} = registerCID <$> readIORef roleInfo++getUnregister :: Connection -> IO (CID -> IO ())+getUnregister Connection{..} = unregisterCID <$> readIORef roleInfo++----------------------------------------------------------------++setTokenManager :: Connection -> CT.TokenManager -> IO ()+setTokenManager Connection{..} mgr = atomicModifyIORef'' roleInfo $+    \si -> si { tokenManager = mgr }++getTokenManager :: Connection -> IO CT.TokenManager+getTokenManager Connection{..} = tokenManager <$> readIORef roleInfo++----------------------------------------------------------------++setBaseThreadId :: Connection -> ThreadId -> IO ()+setBaseThreadId Connection{..} tid = atomicModifyIORef'' roleInfo $+    \si -> si { baseThreadId = tid }++getBaseThreadId :: Connection -> IO ThreadId+getBaseThreadId Connection{..} = baseThreadId <$> readIORef roleInfo++----------------------------------------------------------------++setCertificateChain :: Connection -> Maybe CertificateChain -> IO ()+setCertificateChain Connection{..} mcc = atomicModifyIORef'' roleInfo $+    \si -> si { certChain = mcc }++getCertificateChain :: Connection -> IO (Maybe CertificateChain)+getCertificateChain Connection{..} = certChain <$> readIORef roleInfo++----------------------------------------------------------------++setServerAddr :: Connection -> SockAddr -> IO ()+setServerAddr Connection{..} sa = atomicModifyIORef'' roleInfo $+    \si -> si { serverAddr = Just sa }++getServerAddr :: Connection -> IO (Maybe SockAddr)+getServerAddr Connection{..} = serverAddr <$> readIORef roleInfo
+ Network/QUIC/Connection/State.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Connection.State (+    setConnection0RTTReady+  , isConnection1RTTReady+  , setConnection1RTTReady+  , isConnectionEstablished+  , setConnectionEstablished+  , wait0RTTReady+  , wait1RTTReady+  , waitEstablished+  , readConnectionFlowTx+  , addTxData+  , getTxData+  , setTxMaxData+  , getTxMaxData+  , addRxData+  , getRxData+  , addRxMaxData+  , getRxMaxData+  , getRxDataWindow+  , addTxBytes+  , getTxBytes+  , addRxBytes+  , getRxBytes+  , setAddressValidated+  , waitAntiAmplificationFree+  , checkAntiAmplificationFree+  ) where++import Control.Concurrent.STM++import Network.QUIC.Connection.Types+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Recovery+import Network.QUIC.Stream++----------------------------------------------------------------++setConnectionState :: Connection -> ConnectionState -> IO ()+setConnectionState Connection{..} st =+    atomically $ writeTVar (connectionState connState) st++setConnection0RTTReady :: Connection -> IO ()+setConnection0RTTReady conn = setConnectionState conn ReadyFor0RTT++setConnection1RTTReady :: Connection -> IO ()+setConnection1RTTReady conn = do+    setConnectionState conn ReadyFor1RTT+    writeIORef (shared1RTTReady $ shared conn) True++setConnectionEstablished :: Connection -> IO ()+setConnectionEstablished conn = setConnectionState conn Established++----------------------------------------------------------------++isConnection1RTTReady :: Connection -> IO Bool+isConnection1RTTReady Connection{..} = atomically $ do+    st <- readTVar $ connectionState connState+    return (st >= ReadyFor1RTT)++----------------------------------------------------------------++-- | Waiting until 0-RTT data can be sent.+wait0RTTReady :: Connection -> IO ()+wait0RTTReady Connection{..} = atomically $ do+    cs <- readTVar $ connectionState connState+    check (cs >= ReadyFor0RTT)++-- | Waiting until 1-RTT data can be sent.+wait1RTTReady :: Connection -> IO ()+wait1RTTReady Connection{..} = atomically $ do+    cs <- readTVar $ connectionState connState+    check (cs >= ReadyFor1RTT)++-- | For clients, waiting until HANDSHAKE_DONE is received.+--   For servers, waiting until a TLS stack reports that the handshake is complete.+waitEstablished :: Connection -> IO ()+waitEstablished Connection{..} = atomically $ do+    cs <- readTVar $ connectionState connState+    check (cs >= Established)++----------------------------------------------------------------++readConnectionFlowTx :: Connection -> STM Flow+readConnectionFlowTx Connection{..} = readTVar flowTx++----------------------------------------------------------------++addTxData :: Connection -> Int -> STM ()+addTxData Connection{..} n = modifyTVar' flowTx add+  where+    add flow = flow { flowData = flowData flow + n }++getTxData :: Connection -> IO Int+getTxData Connection{..} = atomically $ flowData <$> readTVar flowTx++setTxMaxData :: Connection -> Int -> IO ()+setTxMaxData Connection{..} n = atomically $ modifyTVar' flowTx set+  where+    set flow+      | flowMaxData flow < n = flow { flowMaxData = n }+      | otherwise            = flow++getTxMaxData :: Connection -> STM Int+getTxMaxData Connection{..} = flowMaxData <$> readTVar flowTx++----------------------------------------------------------------++addRxData :: Connection -> Int -> IO ()+addRxData Connection{..} n = atomicModifyIORef'' flowRx add+  where+    add flow = flow { flowData = flowData flow + n }++getRxData :: Connection -> IO Int+getRxData Connection{..} = flowData <$> readIORef flowRx++addRxMaxData :: Connection -> Int -> IO Int+addRxMaxData Connection{..} n = atomicModifyIORef' flowRx add+  where+    add flow = (flow { flowMaxData = m }, m)+      where+        m = flowMaxData flow + n++getRxMaxData :: Connection -> IO Int+getRxMaxData Connection{..} = flowMaxData <$> readIORef flowRx++getRxDataWindow :: Connection -> IO Int+getRxDataWindow Connection{..} = flowWindow <$> readIORef flowRx++----------------------------------------------------------------++addTxBytes :: Connection -> Int -> IO ()+addTxBytes Connection{..} n = atomically $ modifyTVar' bytesTx (+ n)++getTxBytes :: Connection -> IO Int+getTxBytes Connection{..} = readTVarIO bytesTx++addRxBytes :: Connection -> Int -> IO ()+addRxBytes Connection{..} n = atomically $ modifyTVar' bytesRx (+ n)++getRxBytes :: Connection -> IO Int+getRxBytes Connection{..} = readTVarIO bytesRx++----------------------------------------------------------------++setAddressValidated :: Connection -> IO ()+setAddressValidated Connection{..} = atomically $ writeTVar addressValidated True++-- Three times rule for anti amplification+waitAntiAmplificationFree :: Connection -> Int -> IO ()+waitAntiAmplificationFree conn@Connection{..} siz = do+    ok <- checkAntiAmplificationFree conn siz+    unless ok $ do+        beforeAntiAmp connLDCC+        atomically (checkAntiAmplificationFreeSTM conn siz >>= check)+        -- setLossDetectionTimer is called eventually.++checkAntiAmplificationFreeSTM :: Connection -> Int -> STM Bool+checkAntiAmplificationFreeSTM Connection{..} siz = do+    validated <- readTVar addressValidated+    if validated then+        return True+      else do+        tx <- readTVar bytesTx+        rx <- readTVar bytesRx+        return (tx + siz <= 3 * rx)++checkAntiAmplificationFree :: Connection -> Int -> IO Bool+checkAntiAmplificationFree conn siz =+    atomically $ checkAntiAmplificationFreeSTM conn siz
+ Network/QUIC/Connection/Stream.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Connection.Stream (+    getMyStreamId+  , waitMyNewStreamId+  , waitMyNewUniStreamId+  , setMyMaxStreams+  , setMyUniMaxStreams+  , getPeerMaxStreams+  , setPeerMaxStreams+  ) where++import Control.Concurrent.STM++import Network.QUIC.Connection.Types+import Network.QUIC.Imports+import Network.QUIC.Types++getMyStreamId :: Connection -> IO Int+getMyStreamId Connection{..} = do+    next <- currentStream <$> readTVarIO myStreamId+    return $ next - 4++waitMyNewStreamId :: Connection -> IO StreamId+waitMyNewStreamId Connection{..} = get myStreamId++waitMyNewUniStreamId :: Connection -> IO StreamId+waitMyNewUniStreamId Connection{..} = get myUniStreamId++get :: TVar Concurrency -> IO Int+get tvar = atomically $ do+    conc@Concurrency{..} <- readTVar tvar+    check (currentStream < maxStreams * 4 + streamType)+    let currentStream' = currentStream + 4+    writeTVar tvar conc { currentStream = currentStream' }+    return currentStream++setMyMaxStreams :: Connection -> Int -> IO ()+setMyMaxStreams Connection{..} = set myStreamId++setMyUniMaxStreams :: Connection -> Int -> IO ()+setMyUniMaxStreams Connection{..} = set myUniStreamId++set :: TVar Concurrency -> Int -> IO ()+set tvar mx = atomically $ modifyTVar tvar $ \c -> c { maxStreams = mx }++setPeerMaxStreams :: Connection -> Int -> IO ()+setPeerMaxStreams Connection{..} n =+    atomicModifyIORef'' peerStreamId $ \c -> c { maxStreams = n }++getPeerMaxStreams :: Connection -> IO Int+getPeerMaxStreams Connection{..} = atomicModifyIORef' peerStreamId inc+  where+    inc c = (c { maxStreams = next}, next)+      where+        next = maxStreams c + 1
+ Network/QUIC/Connection/StreamTable.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Connection.StreamTable (+    createStream+  , findStream+  , addStream+  , delStream+  , initialRxMaxStreamData+  , setupCryptoStreams+  , clearCryptoStream+  , getCryptoStream+  ) where++import Network.QUIC.Connection.Misc+import Network.QUIC.Connection.Queue+import Network.QUIC.Connection.Types+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Parameters+import Network.QUIC.Stream+import Network.QUIC.Types++createStream :: Connection -> StreamId -> IO Stream+createStream conn sid = do+      strm <- addStream conn sid+      putInput conn $ InpStream strm+      return strm++findStream :: Connection -> StreamId -> IO (Maybe Stream)+findStream Connection{..} sid = lookupStream sid <$> readIORef streamTable++addStream :: Connection -> StreamId -> IO Stream+addStream conn@Connection{..} sid = do+    strm <- newStream conn sid+    peerParams <- getPeerParameters conn+    let txMaxStreamData | isClient conn = clientInitial sid peerParams+                        | otherwise     = serverInitial sid peerParams+    setTxMaxStreamData strm txMaxStreamData+    let rxMaxStreamData = initialRxMaxStreamData conn sid+    setRxMaxStreamData strm rxMaxStreamData+    atomicModifyIORef'' streamTable $ insertStream sid strm+    return strm++delStream :: Connection -> Stream -> IO ()+delStream Connection{..} strm =+    atomicModifyIORef'' streamTable $ deleteStream $ streamId strm++initialRxMaxStreamData :: Connection -> StreamId -> Int+initialRxMaxStreamData conn sid+    | isClient conn = clientInitial sid params+    | otherwise     = serverInitial sid params+  where+    params = getMyParameters conn++clientInitial :: StreamId -> Parameters -> Int+clientInitial sid params+  | isClientInitiatedBidirectional  sid = initialMaxStreamDataBidiRemote params+  | isServerInitiatedBidirectional  sid = initialMaxStreamDataBidiLocal  params+  -- intentionally not using isClientInitiatedUnidirectional+  | otherwise                           = initialMaxStreamDataUni        params++serverInitial :: StreamId -> Parameters -> Int+serverInitial sid params+  | isServerInitiatedBidirectional  sid = initialMaxStreamDataBidiRemote params+  | isClientInitiatedBidirectional  sid = initialMaxStreamDataBidiLocal  params+  | otherwise                           = initialMaxStreamDataUni        params++----------------------------------------------------------------++setupCryptoStreams :: Connection -> IO ()+setupCryptoStreams conn@Connection{..} = do+    stbl0 <- readIORef streamTable+    stbl <- insertCryptoStreams conn stbl0+    writeIORef streamTable stbl++clearCryptoStream :: Connection -> EncryptionLevel -> IO ()+clearCryptoStream Connection{..} lvl =+    atomicModifyIORef'' streamTable $ deleteCryptoStream lvl++----------------------------------------------------------------++getCryptoStream :: Connection -> EncryptionLevel -> IO (Maybe Stream)+getCryptoStream Connection{..} lvl =+    lookupCryptoStream lvl <$> readIORef streamTable
+ Network/QUIC/Connection/Timeout.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE DeriveDataTypeable #-}++module Network.QUIC.Connection.Timeout (+    timeouter+  , timeout+  , fire+  , cfire+  , delay+  ) where++import Control.Concurrent+import Control.Concurrent.STM+import Data.Typeable+import GHC.Event+import System.IO.Unsafe (unsafePerformIO)+import qualified UnliftIO.Exception as E++import Network.QUIC.Connection.Types+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Types++data TimeoutException = TimeoutException deriving (Show, Typeable)++instance E.Exception TimeoutException where+  fromException = E.asyncExceptionFromException+  toException = E.asyncExceptionToException++globalTimeoutQ :: TQueue (IO ())+globalTimeoutQ = unsafePerformIO newTQueueIO+{-# NOINLINE globalTimeoutQ #-}++timeouter :: IO ()+timeouter = forever $ join $ atomically (readTQueue globalTimeoutQ)++timeout :: Microseconds -> IO a -> IO (Maybe a)+timeout (Microseconds ms) action = do+    tid <- myThreadId+    timmgr <- getSystemTimerManager+    let killMe = E.throwTo tid TimeoutException+        onTimeout = atomically $ writeTQueue globalTimeoutQ killMe+        setup = registerTimeout timmgr ms onTimeout+        cleanup key = unregisterTimeout timmgr key+    E.handleSyncOrAsync (\TimeoutException -> return Nothing) $+        E.bracket setup cleanup $ \_ -> Just <$> action++fire :: Connection -> Microseconds -> TimeoutCallback -> IO ()+fire conn (Microseconds microseconds) action = do+    timmgr <- getSystemTimerManager+    void $ registerTimeout timmgr microseconds action'+  where+    action' = do+        alive <- getAlive conn+        when alive action `E.catchSyncOrAsync` ignore++cfire :: Connection -> Microseconds -> TimeoutCallback -> IO (IO ())+cfire conn (Microseconds microseconds) action = do+    timmgr <- getSystemTimerManager+    key <- registerTimeout timmgr microseconds action'+    let cancel = unregisterTimeout timmgr key+    return cancel+  where+    action' = do+        alive <- getAlive conn+        when alive action `E.catchSyncOrAsync` ignore++delay :: Microseconds -> IO ()+delay (Microseconds microseconds) = threadDelay microseconds
+ Network/QUIC/Connection/Types.hs view
@@ -0,0 +1,367 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}++module Network.QUIC.Connection.Types where++import Control.Concurrent+import Control.Concurrent.STM+import qualified Crypto.Token as CT+import Data.Array.IO+import Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as IntMap+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map+import Data.X509 (CertificateChain)+import Foreign.Ptr+import Network.Socket (Socket, SockAddr)+import Network.TLS.QUIC++import Network.QUIC.Config+import Network.QUIC.Connector+import Network.QUIC.Crypto+import Network.QUIC.CryptoFusion+import Network.QUIC.Imports+import Network.QUIC.Logger+import Network.QUIC.Parameters+import Network.QUIC.Qlog+import Network.QUIC.Recovery+import Network.QUIC.Stream+import Network.QUIC.Types++----------------------------------------------------------------++dummySecrets :: TrafficSecrets a+dummySecrets = (ClientTrafficSecret "", ServerTrafficSecret "")++----------------------------------------------------------------++data RoleInfo = ClientInfo { clientInitialToken :: Token -- new or retry token+                           , resumptionInfo     :: ResumptionInfo+                           , serverAddr         :: Maybe SockAddr+                           }+              | ServerInfo { tokenManager    :: ~CT.TokenManager+                           , registerCID     :: CID -> Connection -> IO ()+                           , unregisterCID   :: CID -> IO ()+                           , askRetry        :: Bool+                           , baseThreadId    :: ~ThreadId+                           , certChain       :: Maybe CertificateChain+                           }++defaultClientRoleInfo :: RoleInfo+defaultClientRoleInfo = ClientInfo {+    clientInitialToken = emptyToken+  , resumptionInfo = defaultResumptionInfo+  , serverAddr     = Nothing+  }++defaultServerRoleInfo :: RoleInfo+defaultServerRoleInfo = ServerInfo {+    tokenManager = undefined+  , registerCID = \_ _ -> return ()+  , unregisterCID = \_ -> return ()+  , askRetry = False+  , baseThreadId = undefined+  , certChain = Nothing+  }++-- fixme: limitation+data CIDDB = CIDDB {+    usedCIDInfo   :: CIDInfo+  , cidInfos      :: IntMap CIDInfo+  , revInfos      :: Map CID Int+  , nextSeqNum    :: Int  -- only for mine (new)+  , triggeredByMe :: Bool -- only for peer's+  } deriving (Show)++newCIDDB :: CID -> CIDDB+newCIDDB cid = CIDDB {+    usedCIDInfo   = cidInfo+  , cidInfos      = IntMap.singleton 0 cidInfo+  , revInfos      = Map.singleton cid 0+  , nextSeqNum    = 1+  , triggeredByMe = False+  }+  where+    cidInfo = CIDInfo 0 cid (StatelessResetToken "")++----------------------------------------------------------------++data MigrationState = NonMigration+                    | MigrationStarted+                    | SendChallenge [PathData]+                    | RecvResponse+                    deriving (Eq, Show)++data Coder = Coder {+    encrypt :: Buffer -> Int -> Buffer -> Int -> PacketNumber -> Buffer -> IO Int+  , decrypt :: Buffer -> Int -> Buffer -> Int -> PacketNumber -> Buffer -> IO Int+  }++initialCoder :: Coder+initialCoder = Coder {+    encrypt = \_ _ _ _ _ _ -> return (-1)+  , decrypt = \_ _ _ _ _ _ -> return (-1)+  }++data Coder1RTT = Coder1RTT {+    coder1RTT  :: Coder+  , secretN    :: TrafficSecrets ApplicationSecret+  , supplement :: ~Supplement+  }++initialCoder1RTT :: Coder1RTT+initialCoder1RTT = Coder1RTT {+    coder1RTT  = initialCoder+  , secretN    = (ClientTrafficSecret "", ServerTrafficSecret "")+  , supplement = undefined+  }++data Protector = Protector {+    setSample :: Ptr Word8 -> IO ()+  , getMask   :: IO (Ptr Word8)+  , unprotect :: Sample -> Mask+  }++initialProtector :: Protector+initialProtector = Protector {+    setSample = \_ -> return ()+  , getMask   = return nullPtr+  , unprotect = \_ -> Mask ""+  }++----------------------------------------------------------------++data Negotiated = Negotiated {+      tlsHandshakeMode :: HandshakeMode13+    , applicationProtocol :: Maybe NegotiatedProtocol+    , applicationSecretInfo :: ApplicationSecretInfo+    }++initialNegotiated :: Negotiated+initialNegotiated = Negotiated {+      tlsHandshakeMode = FullHandshake+    , applicationProtocol = Nothing+    , applicationSecretInfo = ApplicationSecretInfo defaultTrafficSecrets+    }++----------------------------------------------------------------++data Concurrency = Concurrency {+    currentStream :: Int+  , streamType    :: Int+  , maxStreams    :: Int+  }++newConcurrency :: Role -> Direction -> Int -> Concurrency+newConcurrency rl dir n = Concurrency typ typ n+ where+   bidi = dir == Bidirectional+   typ | rl == Client = if bidi then 0 else 2+       | otherwise    = if bidi then 1 else 3++----------------------------------------------------------------++-- | A quic connection to carry multiple streams.+data Connection = Connection {+    connState         :: ConnState+  -- Actions+  , connDebugLog      :: DebugLogger -- ^ A logger for debugging.+  , connQLog          :: QLogger+  , connHooks         :: Hooks+  -- Manage+  , connRecvQ         :: RecvQ+  , sockets           :: IORef [Socket]+  , readers           :: IORef (IO ())+  , tmouter           :: IORef (IO ())+  , mainThreadId      :: ThreadId+  -- Info+  , roleInfo          :: IORef RoleInfo+  , quicVersion       :: IORef Version+  -- Mine+  , myParameters      :: Parameters+  , myCIDDB           :: IORef CIDDB+  -- Peer+  , peerParameters    :: IORef Parameters+  , peerCIDDB         :: TVar CIDDB+  -- Queues+  , inputQ            :: InputQ+  , cryptoQ           :: CryptoQ+  , outputQ           :: OutputQ+  , migrationQ        :: MigrationQ+  , shared            :: Shared+  , delayedAckCount   :: IORef Int+  , delayedAckCancel  :: IORef (IO ())+  -- State+  , peerPacketNumber  :: IORef PacketNumber      -- for RTT1+  , streamTable       :: IORef StreamTable+  , myStreamId        :: TVar Concurrency+  , myUniStreamId     :: TVar Concurrency+  , peerStreamId      :: IORef Concurrency+  , flowTx            :: TVar Flow+  , flowRx            :: IORef Flow+  , migrationState    :: TVar MigrationState+  , minIdleTimeout    :: IORef Microseconds+  , bytesTx           :: TVar Int+  , bytesRx           :: TVar Int+  , addressValidated  :: TVar Bool+  -- TLS+  , pendingQ          :: Array   EncryptionLevel (TVar [ReceivedPacket])+  , ciphers           :: IOArray EncryptionLevel Cipher+  , coders            :: IOArray EncryptionLevel Coder+  , coders1RTT        :: IOArray Bool            Coder1RTT+  , protectors        :: IOArray EncryptionLevel Protector+  , currentKeyPhase   :: IORef (Bool, PacketNumber)+  , negotiated        :: IORef Negotiated+  , handshakeCIDs     :: IORef AuthCIDs+  -- Resources+  , connResources     :: IORef (IO ())+  -- Recovery+  , connLDCC          :: LDCC+  }++instance KeepQlog Connection where+    keepQlog conn = connQLog conn++instance Connector Connection where+    getRole            = role . connState+    getEncryptionLevel = readTVarIO . encryptionLevel . connState+    getMaxPacketSize   = readIORef  . maxPacketSize   . connState+    getConnectionState = readTVarIO . connectionState . connState+    getPacketNumber    = readIORef  . packetNumber    . connState+    getAlive           = readIORef  . connectionAlive . connState++setDead :: Connection -> IO ()+setDead conn = writeIORef (connectionAlive $ connState conn) False++makePendingQ :: IO (Array EncryptionLevel (TVar [ReceivedPacket]))+makePendingQ = do+    q1 <- newTVarIO []+    q2 <- newTVarIO []+    q3 <- newTVarIO []+    let lst = [(RTT0Level,q1),(HandshakeLevel,q2),(RTT1Level,q3)]+        arr = array (RTT0Level,RTT1Level) lst+    return arr++newConnection :: Role+              -> Parameters+              -> Version -> AuthCIDs -> AuthCIDs+              -> DebugLogger -> QLogger -> Hooks+              -> IORef [Socket]+              -> RecvQ+              -> IO Connection+newConnection rl myparams ver myAuthCIDs peerAuthCIDs debugLog qLog hooks sref recvQ = do+    outQ <- newTQueueIO+    let put x = atomically $ writeTQueue outQ $ OutRetrans x+    connstate <- newConnState rl+    Connection connstate debugLog qLog hooks recvQ sref+        <$> newIORef (return ())+        <*> newIORef (return ())+        <*> myThreadId+        -- Info+        <*> newIORef initialRoleInfo+        <*> newIORef ver+        -- Mine+        <*> return myparams+        <*> newIORef (newCIDDB myCID)+        -- Peer+        <*> newIORef baseParameters+        <*> newTVarIO (newCIDDB peerCID)+        -- Queues+        <*> newTQueueIO+        <*> newTQueueIO+        <*> return outQ+        <*> newTQueueIO+        <*> newShared+        <*> newIORef 0+        <*> newIORef (return ())+        -- State+        <*> newIORef 0+        <*> newIORef emptyStreamTable+        <*> newTVarIO (newConcurrency rl Bidirectional  0)+        <*> newTVarIO (newConcurrency rl Unidirectional 0)+        <*> newIORef  peerConcurrency+        <*> newTVarIO defaultFlow+        <*> newIORef defaultFlow { flowMaxData = initialMaxData myparams }+        <*> newTVarIO NonMigration+        <*> newIORef (milliToMicro $ maxIdleTimeout myparams)+        <*> newTVarIO 0+        <*> newTVarIO 0+        <*> newTVarIO False+        -- TLS+        <*> makePendingQ+        <*> newArray (InitialLevel,RTT1Level) defaultCipher+        <*> newArray (InitialLevel,HandshakeLevel) initialCoder+        <*> newArray (False,True) initialCoder1RTT+        <*> newArray (InitialLevel,RTT1Level) initialProtector+        <*> newIORef (False,0)+        <*> newIORef initialNegotiated+        <*> newIORef peerAuthCIDs+        -- Resources+        <*> newIORef (return ())+        -- Recovery+        <*> newLDCC connstate qLog put+  where+    isclient = rl == Client+    initialRoleInfo+      | isclient  = defaultClientRoleInfo+      | otherwise = defaultServerRoleInfo+    Just myCID   = initSrcCID myAuthCIDs+    Just peerCID = initSrcCID peerAuthCIDs+    peer | isclient  = Server+         | otherwise = Client+    peerConcurrency = newConcurrency peer Bidirectional (initialMaxStreamsBidi myparams)++defaultTrafficSecrets :: (ClientTrafficSecret a, ServerTrafficSecret a)+defaultTrafficSecrets = (ClientTrafficSecret "", ServerTrafficSecret "")++----------------------------------------------------------------++clientConnection :: ClientConfig+                 -> Version -> AuthCIDs -> AuthCIDs+                 -> DebugLogger -> QLogger -> Hooks+                 -> IORef [Socket]+                 -> RecvQ+                 -> IO Connection+clientConnection ClientConfig{..} ver myAuthCIDs peerAuthCIDs =+    newConnection Client ccParameters ver myAuthCIDs peerAuthCIDs++serverConnection :: ServerConfig+                 -> Version -> AuthCIDs -> AuthCIDs+                 -> DebugLogger -> QLogger -> Hooks+                 -> IORef [Socket]+                 -> RecvQ+                 -> IO Connection+serverConnection ServerConfig{..} ver myAuthCIDs peerAuthCIDs =+    newConnection Server scParameters ver myAuthCIDs peerAuthCIDs++----------------------------------------------------------------++newtype Input = InpStream Stream deriving Show+data   Crypto = InpHandshake EncryptionLevel ByteString deriving Show++data Output = OutControl   EncryptionLevel [Frame] (IO ())+            | OutHandshake [(EncryptionLevel,ByteString)]+            | OutRetrans   PlainPacket++type InputQ  = TQueue Input+type CryptoQ = TQueue Crypto+type OutputQ = TQueue Output+type MigrationQ = TQueue ReceivedPacket++----------------------------------------------------------------++type SendStreamQ = TQueue TxStreamData++data Shared = Shared {+    sharedCloseSent     :: IORef Bool+  , sharedCloseReceived :: IORef Bool+  , shared1RTTReady     :: IORef Bool+  , sharedSendStreamQ   :: SendStreamQ+  }++newShared :: IO Shared+newShared = Shared <$> newIORef False+                   <*> newIORef False+                   <*> newIORef False+                   <*> newTQueueIO
+ Network/QUIC/Connection/Types.hs-boot view
@@ -0,0 +1,3 @@+module Network.QUIC.Connection.Types where++data Connection
+ Network/QUIC/Connector.hs view
@@ -0,0 +1,60 @@+module Network.QUIC.Connector where++import Control.Concurrent.STM+import Data.IORef+import Network.QUIC.Types++class Connector a where+    getRole            :: a -> Role+    getEncryptionLevel :: a -> IO EncryptionLevel+    getMaxPacketSize   :: a -> IO Int+    getConnectionState :: a -> IO ConnectionState+    getPacketNumber    :: a -> IO PacketNumber+    getAlive           :: a -> IO Bool++----------------------------------------------------------------++data ConnState = ConnState {+    role            :: Role+  , connectionState :: TVar ConnectionState+  , packetNumber    :: IORef PacketNumber   -- squeezing three to one+  , encryptionLevel :: TVar EncryptionLevel -- to synchronize+  , maxPacketSize   :: IORef Int+  -- Explicitly separated from 'ConnectionState'+  -- It seems that STM triggers a dead-lock if+  -- it is used in the close function of bracket.+  , connectionAlive :: IORef Bool+  }++newConnState :: Role -> IO ConnState+newConnState rl =+    ConnState rl <$> newTVarIO Handshaking+                 <*> newIORef 0+                 <*> newTVarIO InitialLevel+                 <*> newIORef defaultQUICPacketSize+                 <*> newIORef True++----------------------------------------------------------------++data Role = Client | Server deriving (Eq, Show)++isClient :: Connector a => a -> Bool+isClient conn = getRole conn == Client++isServer :: Connector a => a -> Bool+isServer conn = getRole conn == Server++----------------------------------------------------------------++data ConnectionState = Handshaking+                     | ReadyFor0RTT+                     | ReadyFor1RTT+                     | Established+                     deriving (Eq, Ord, Show)++isConnectionEstablished :: Connector a => a -> IO Bool+isConnectionEstablished conn = do+    st <- getConnectionState conn+    return $ case st of+      Established -> True+      _           -> False
+ Network/QUIC/Crypto.hs view
@@ -0,0 +1,379 @@+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Crypto (+  -- * Payload encryption+    defaultCipher+  , initialSecrets+  , clientInitialSecret+  , serverInitialSecret+  , aeadKey+  , initialVector+  , nextSecret+  , headerProtectionKey+  , makeNonce+  , encryptPayload+  , encryptPayload'+  , decryptPayload+  , decryptPayload'+  -- * Header Protection+  , protectionMask+  , tagLength+  , sampleLength+  , bsXOR+--  , unprotectHeader+  -- * Types+  , PlainText+  , CipherText+  , Key(..)+  , IV(..)+  , CID+  , Secret(..)+  , AddDat(..)+  , Sample(..)+  , Mask(..)+  , Nonce(..)+  , Cipher+  , InitialSecret+  , TrafficSecrets+  , ClientTrafficSecret(..)+  , ServerTrafficSecret(..)+  -- * Misc+  , calculateIntegrityTag+  ) where++import Crypto.Cipher.AES+import qualified Crypto.Cipher.ChaCha as ChaCha+import qualified Crypto.Cipher.ChaChaPoly1305 as ChaChaPoly+import Crypto.Cipher.Types hiding (Cipher, IV)+import Crypto.Error (throwCryptoError, maybeCryptoError)+import qualified Crypto.MAC.Poly1305 as Poly1305+import qualified Data.ByteArray as Byte (convert, xor)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import qualified Data.ByteString.Internal as BS+import qualified Data.ByteString.Short as Short+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (peek, poke)+import Network.TLS hiding (Version)+import Network.TLS.Extra.Cipher+import Network.TLS.QUIC+import qualified UnliftIO.Exception as E++import Network.QUIC.Imports+import Network.QUIC.Types++----------------------------------------------------------------++defaultCipher :: Cipher+defaultCipher = cipher_TLS13_AES128GCM_SHA256++----------------------------------------------------------------++type PlainText  = ByteString+type CipherText = ByteString+type Salt       = ByteString++newtype Key    = Key    ByteString deriving (Eq)+newtype IV     = IV     ByteString deriving (Eq)+newtype Secret = Secret ByteString deriving (Eq)+newtype AddDat = AddDat ByteString deriving (Eq)+newtype Sample = Sample ByteString deriving (Eq)+newtype Mask   = Mask   ByteString deriving (Eq)+newtype Label  = Label  ByteString deriving (Eq)+newtype Nonce  = Nonce  ByteString deriving (Eq)++instance Show Key where+    show (Key x) = "Key=" ++ C8.unpack (enc16 x)+instance Show IV where+    show (IV x) = "IV=" ++ C8.unpack (enc16 x)+instance Show Secret where+    show (Secret x) = "Secret=" ++ C8.unpack (enc16 x)+instance Show AddDat where+    show (AddDat x) = "AddDat=" ++ C8.unpack (enc16 x)+instance Show Sample where+    show (Sample x) = "Sample=" ++ C8.unpack (enc16 x)+instance Show Mask where+    show (Mask x) = "Mask=" ++ C8.unpack (enc16 x)+instance Show Label where+    show (Label x) = "Label=" ++ C8.unpack (enc16 x)+instance Show Nonce where+    show (Nonce x) = "Nonce=" ++ C8.unpack (enc16 x)++----------------------------------------------------------------++initialSalt :: Version -> Salt+initialSalt Draft29     = "\xaf\xbf\xec\x28\x99\x93\xd2\x4c\x9e\x97\x86\xf1\x9c\x61\x11\xe0\x43\x90\xa8\x99"+initialSalt Version1    = "\x38\x76\x2c\xf7\xf5\x59\x34\xb3\x4d\x17\x9a\xe6\xa4\xc8\x0c\xad\xcc\xbb\x7f\x0a"+initialSalt (Version v) = E.impureThrow $ VersionIsUnknown v++data InitialSecret++initialSecrets :: Version -> CID -> TrafficSecrets InitialSecret+initialSecrets v c = (clientInitialSecret v c, serverInitialSecret v c)++clientInitialSecret :: Version -> CID -> ClientTrafficSecret InitialSecret+clientInitialSecret v c = ClientTrafficSecret $ initialSecret (Label "client in") v c++serverInitialSecret :: Version -> CID -> ServerTrafficSecret InitialSecret+serverInitialSecret v c = ServerTrafficSecret $ initialSecret (Label "server in") v c++initialSecret :: Label -> Version -> CID -> ByteString+initialSecret _ GreasingVersion  _  = "greasing !!!!"+initialSecret _ GreasingVersion2 _  = "greasing !!!!"+initialSecret (Label label) ver cid = secret+  where+    cipher    = defaultCipher+    hash      = cipherHash cipher+    iniSecret = hkdfExtract hash (initialSalt ver) $ fromCID cid+    hashSize  = hashDigestSize hash+    secret    = hkdfExpandLabel hash iniSecret label "" hashSize++aeadKey :: Cipher -> Secret -> Key+aeadKey = genKey (Label "quic key")++headerProtectionKey :: Cipher -> Secret -> Key+headerProtectionKey = genKey (Label "quic hp")++genKey :: Label -> Cipher -> Secret -> Key+genKey (Label label) cipher (Secret secret) = Key key+  where+    hash    = cipherHash cipher+    bulk    = cipherBulk cipher+    keySize = bulkKeySize bulk+    key     = hkdfExpandLabel hash secret label "" keySize++initialVector :: Cipher -> Secret -> IV+initialVector cipher (Secret secret) = IV iv+  where+    hash   = cipherHash cipher+    bulk   = cipherBulk cipher+    ivSize = max 8 (bulkIVSize bulk + bulkExplicitIV bulk)+    iv     = hkdfExpandLabel hash secret "quic iv" "" ivSize++nextSecret :: Cipher -> Secret -> Secret+nextSecret cipher (Secret secN) = Secret secN1+  where+    label    = "quic ku"+    hash     = cipherHash cipher+    hashSize = hashDigestSize hash+    secN1    = hkdfExpandLabel hash secN label "" hashSize++----------------------------------------------------------------++-- It would be nice to take [PlainText] and update AEAD context with+-- [PlainText]. But since each PlainText is not aligned to cipher block,+-- it's impossible.+cipherEncrypt :: Cipher -> Key -> Nonce -> PlainText -> AddDat -> [CipherText]+cipherEncrypt cipher+  | cipher == cipher_TLS13_AES128GCM_SHA256        = aes128gcmEncrypt+  | cipher == cipher_TLS13_AES128CCM_SHA256        = error "cipher_TLS13_AES128CCM_SHA256"+  | cipher == cipher_TLS13_AES256GCM_SHA384        = aes256gcmEncrypt+  | cipher == cipher_TLS13_CHACHA20POLY1305_SHA256 = chacha20poly1305Encrypt+  | otherwise                                      = error "cipherEncrypt"++cipherDecrypt :: Cipher -> Key -> Nonce -> CipherText -> AddDat -> Maybe PlainText+cipherDecrypt cipher+  | cipher == cipher_TLS13_AES128GCM_SHA256        = aes128gcmDecrypt+  | cipher == cipher_TLS13_AES128CCM_SHA256        = error "cipher_TLS13_AES128CCM_SHA256"+  | cipher == cipher_TLS13_AES256GCM_SHA384        = aes256gcmDecrypt+  | cipher == cipher_TLS13_CHACHA20POLY1305_SHA256 = chacha20poly1305Decrypt+  | otherwise                                      = error "cipherDecrypt"++-- IMPORTANT: Using 'let' so that parameters can be memorized.+aes128gcmEncrypt :: Key -> (Nonce -> PlainText -> AddDat -> [CipherText])+aes128gcmEncrypt (Key key) =+    let aes = throwCryptoError (cipherInit key) :: AES128+    in \(Nonce nonce) plaintext (AddDat ad) ->+      let aead = throwCryptoError $ aeadInit AEAD_GCM aes nonce+          (AuthTag tag0, ciphertext) = aeadSimpleEncrypt aead ad plaintext 16+          tag = Byte.convert tag0+      in [ciphertext,tag]++aes128gcmDecrypt :: Key -> (Nonce -> CipherText -> AddDat -> Maybe PlainText)+aes128gcmDecrypt (Key key) =+    let aes = throwCryptoError (cipherInit key) :: AES128+    in \(Nonce nonce) ciphertag (AddDat ad) ->+      let aead = throwCryptoError $ aeadInit AEAD_GCM aes nonce+          (ciphertext, tag) = BS.splitAt (BS.length ciphertag - 16) ciphertag+          authtag = AuthTag $ Byte.convert tag+       in aeadSimpleDecrypt aead ad ciphertext authtag++aes256gcmEncrypt :: Key -> (Nonce -> PlainText -> AddDat -> [CipherText])+aes256gcmEncrypt (Key key) =+    let aes = throwCryptoError (cipherInit key) :: AES256+    in \(Nonce nonce) plaintext (AddDat ad) ->+      let aead = throwCryptoError $ aeadInit AEAD_GCM aes nonce+          (AuthTag tag0, ciphertext) = aeadSimpleEncrypt aead ad plaintext 16+          tag = Byte.convert tag0+      in [ciphertext, tag]++aes256gcmDecrypt :: Key -> (Nonce -> CipherText -> AddDat -> Maybe PlainText)+aes256gcmDecrypt (Key key) =+    let aes = throwCryptoError (cipherInit key) :: AES256+    in \(Nonce nonce) ciphertag (AddDat ad) ->+      let aead = throwCryptoError $ aeadInit AEAD_GCM aes nonce+          (ciphertext, tag) = BS.splitAt (BS.length ciphertag - 16) ciphertag+          authtag = AuthTag $ Byte.convert tag+      in aeadSimpleDecrypt aead ad ciphertext authtag++chacha20poly1305Encrypt :: Key -> Nonce -> PlainText -> AddDat -> [CipherText]+chacha20poly1305Encrypt (Key key) (Nonce nonce) plaintext (AddDat ad) =+    [ciphertext,Byte.convert tag]+  where+    st1 = throwCryptoError (ChaChaPoly.nonce12 nonce >>= ChaChaPoly.initialize key)+    st2 = ChaChaPoly.finalizeAAD (ChaChaPoly.appendAAD ad st1)+    (ciphertext, st3) = ChaChaPoly.encrypt plaintext st2+    Poly1305.Auth tag = ChaChaPoly.finalize st3++chacha20poly1305Decrypt :: Key -> Nonce -> CipherText -> AddDat -> Maybe PlainText+chacha20poly1305Decrypt (Key key) (Nonce nonce) ciphertag (AddDat ad) = do+    st <- maybeCryptoError (ChaChaPoly.nonce12 nonce >>= ChaChaPoly.initialize key)+    let st2 = ChaChaPoly.finalizeAAD (ChaChaPoly.appendAAD ad st)+        (ciphertext, tag) = BS.splitAt (BS.length ciphertag - 16) ciphertag+        (plaintext, st3) = ChaChaPoly.decrypt ciphertext st2+        Poly1305.Auth tag' = ChaChaPoly.finalize st3+    if tag == Byte.convert tag' then Just plaintext else Nothing++----------------------------------------------------------------++makeNonce :: IV -> ByteString -> Nonce+makeNonce (IV iv) pn = Nonce nonce+  where+    nonce = bsXORpad iv pn++----------------------------------------------------------------++encryptPayload :: Cipher -> Key -> IV+               -> (PlainText -> ByteString -> PacketNumber -> [CipherText])+encryptPayload cipher key iv =+    let enc = cipherEncrypt cipher key+        mk  = makeNonce iv+    in \plaintext header pn -> let bytePN = bytestring64 $ fromIntegral pn+                                   nonce  = mk bytePN+                               in enc nonce plaintext (AddDat header)++encryptPayload' :: Cipher -> Key -> Nonce -> PlainText -> AddDat -> [CipherText]+encryptPayload' cipher key nonce plaintext header =+    cipherEncrypt cipher key nonce plaintext header++----------------------------------------------------------------++decryptPayload :: Cipher -> Key -> IV+               -> (CipherText -> ByteString -> PacketNumber -> Maybe PlainText)+decryptPayload cipher key iv =+    let dec = cipherDecrypt cipher key+        mk  = makeNonce iv+    in \ciphertext header pn -> let bytePN = bytestring64 (fromIntegral pn)+                                    nonce = mk bytePN+                                in dec nonce ciphertext (AddDat header)++decryptPayload' :: Cipher -> Key -> Nonce -> CipherText -> AddDat -> Maybe PlainText+decryptPayload' cipher key nonce ciphertext header =+    cipherDecrypt cipher key nonce ciphertext header++----------------------------------------------------------------++protectionMask :: Cipher -> Key -> (Sample -> Mask)+protectionMask cipher key =+    let f = cipherHeaderProtection cipher key+    in \sample -> f sample++cipherHeaderProtection :: Cipher -> Key -> (Sample -> Mask)+cipherHeaderProtection cipher key+  | cipher == cipher_TLS13_AES128GCM_SHA256        = aes128ecbEncrypt key+  | cipher == cipher_TLS13_AES128CCM_SHA256        = error "cipher_TLS13_AES128CCM_SHA256"+  | cipher == cipher_TLS13_AES256GCM_SHA384        = aes256ecbEncrypt key+  | cipher == cipher_TLS13_CHACHA20POLY1305_SHA256 = chachaEncrypt key+  | otherwise                                      = error "cipherHeaderProtection"++aes128ecbEncrypt :: Key -> (Sample -> Mask)+aes128ecbEncrypt (Key key) =+    let encrypt = ecbEncrypt (throwCryptoError (cipherInit key) :: AES128)+    in \(Sample sample) -> let mask = encrypt sample+                           in Mask mask++aes256ecbEncrypt :: Key -> (Sample -> Mask)+aes256ecbEncrypt (Key key) =+    let encrypt = ecbEncrypt (throwCryptoError (cipherInit key) :: AES256)+    in \(Sample sample) -> let mask = encrypt sample+                           in Mask mask++chachaEncrypt :: Key -> Sample -> Mask+chachaEncrypt (Key key) (Sample sample0) = Mask mask+  where+    -- fixme: cryptonite hard-codes the counter, sigh+    (_counter,nonce) = BS.splitAt 4 sample0+    st = ChaCha.initialize 20 key nonce+    (mask,_) = ChaCha.combine st "\x0\x0\x0\x0\x0"++tagLength :: Cipher -> Int+tagLength cipher+  | cipher == cipher_TLS13_AES128GCM_SHA256        = 16+  | cipher == cipher_TLS13_AES128CCM_SHA256        = 16+  | cipher == cipher_TLS13_AES256GCM_SHA384        = 16+  | cipher == cipher_TLS13_CHACHA20POLY1305_SHA256 = 16 -- fixme+  | otherwise                                      = error "tagLength"++sampleLength :: Cipher -> Int+sampleLength cipher+  | cipher == cipher_TLS13_AES128GCM_SHA256        = 16+  | cipher == cipher_TLS13_AES128CCM_SHA256        = 16+  | cipher == cipher_TLS13_AES256GCM_SHA384        = 16+  | cipher == cipher_TLS13_CHACHA20POLY1305_SHA256 = 16 -- fixme+  | otherwise                                      = error "sampleLength"++bsXOR :: ByteString -> ByteString -> ByteString+bsXOR = Byte.xor++-- XORing IV and a packet numbr with left padded.+--             src0+-- IV          +IIIIIIIIIIIIIIIIII--------++--                 diff          src1+-- PN          +000000000000000000+-------++--             dst+-- Nonce       +IIIIIIIIIIIIIIIIII--------++bsXORpad :: ByteString -> ByteString -> ByteString+bsXORpad (PS fp0 off0 len0) (PS fp1 off1 len1)+  | len0 < len1 = error "bsXORpad"+  | otherwise = BS.unsafeCreate len0 $ \dst ->+  withForeignPtr fp0 $ \p0 ->+    withForeignPtr fp1 $ \p1 -> do+        let src0 = p0 `plusPtr` off0+        let src1 = p1 `plusPtr` off1+        let diff = len0 - len1+        BS.memcpy dst src0 diff+        loop (dst `plusPtr` diff) (src0 `plusPtr` diff) src1 len1+  where+    loop :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()+    loop _ _ _ 0 = return ()+    loop dst src0 src1 len = do+        w1 <- peek src0+        w2 <- peek src1+        poke dst (w1 `xor` w2)+        loop (dst `plusPtr` 1) (src0 `plusPtr` 1) (src1 `plusPtr` 1) (len - 1)++{-+bsXORpad' :: ByteString -> ByteString -> ByteString+bsXORpad' iv pn = BS.pack $ zipWith xor ivl pnl+  where+    ivl = BS.unpack iv+    diff = BS.length iv - BS.length pn+    pnl = replicate diff 0 ++ BS.unpack pn+-}++----------------------------------------------------------------++calculateIntegrityTag :: Version -> CID -> ByteString -> ByteString+calculateIntegrityTag ver oCID pseudo0 =+    BS.concat $ aes128gcmEncrypt key nonce "" (AddDat pseudo)+  where+    (ocid, ocidlen) = unpackCID oCID+    pseudo = BS.concat [BS.singleton ocidlen+                       ,Short.fromShort ocid+                       ,pseudo0]+    key | ver == Version1 = Key "\xbe\x0c\x69\x0b\x9f\x66\x57\x5a\x1d\x76\x6b\x54\xe3\x68\xc8\x4e"+        | otherwise       = Key "\xcc\xce\x18\x7e\xd0\x9a\x09\xd0\x57\x28\x15\x5a\x6c\xb9\x6b\xe1"+    nonce | ver == Version1 = Nonce "\x46\x15\x99\xd3\x5d\x63\x2b\xf2\x23\x98\x25\xbb"+          | otherwise       = Nonce "\xe5\x49\x30\xf9\x7f\x21\x36\xf0\x53\x0a\x8c\x1c"
+ Network/QUIC/CryptoFusion.hs view
@@ -0,0 +1,146 @@+module Network.QUIC.CryptoFusion (+    FusionContext+  , fusionNewContext+  , fusionSetup+  , fusionEncrypt+  , fusionDecrypt+  , Supplement+  , fusionSetupSupplement+  , fusionSetSample+  , fusionGetMask+  ) where++import Foreign.C.Types+import Foreign.Ptr+import Foreign.ForeignPtr+import Network.TLS.Extra.Cipher++import Network.QUIC.Crypto+import Network.QUIC.Imports+import Network.QUIC.Types++----------------------------------------------------------------++data FusionContextOpaque+newtype FusionContext = FC (ForeignPtr FusionContextOpaque)++fusionNewContext :: IO FusionContext+fusionNewContext = FC <$> (c_aead_context_new >>= newForeignPtr p_aead_context_free)++----------------------------------------------------------------++fusionSetup :: Cipher -> FusionContext -> Key -> IV -> IO ()+fusionSetup cipher+  | cipher == cipher_TLS13_AES128GCM_SHA256        = fusionSetupAES128+  | cipher == cipher_TLS13_AES256GCM_SHA384        = fusionSetupAES256+  | otherwise                                      = error "fusionSetup"++fusionSetupAES128 :: FusionContext -> Key -> IV -> IO ()+fusionSetupAES128 (FC fctx) (Key key) (IV iv) = withForeignPtr fctx $ \pctx ->+    withByteString key $ \keyp ->+        withByteString iv $ \ivp -> void $ c_aes128gcm_setup pctx 0 keyp ivp++fusionSetupAES256 :: FusionContext -> Key -> IV -> IO ()+fusionSetupAES256 (FC fctx) (Key key) (IV iv) = withForeignPtr fctx $ \pctx ->+    withByteString key $ \keyp ->+        withByteString iv $ \ivp -> void $ c_aes256gcm_setup pctx 0 keyp ivp++----------------------------------------------------------------++fusionEncrypt :: FusionContext -> Supplement -> Buffer -> Int -> Buffer -> Int -> PacketNumber -> Buffer -> IO Int+fusionEncrypt (FC fctx) (SP fsupp) ibuf ilen abuf alen pn obuf =+    withForeignPtr fctx $ \pctx -> withForeignPtr fsupp $ \psupp -> do+        c_aead_do_encrypt pctx obuf ibuf ilen' pn' abuf alen' psupp+        return (ilen + 16) -- fixme+  where+    pn' = fromIntegral pn+    ilen' = fromIntegral ilen+    alen' = fromIntegral alen++fusionDecrypt :: FusionContext -> Buffer -> Int -> Buffer -> Int -> PacketNumber -> Buffer -> IO Int+fusionDecrypt (FC fctx) ibuf ilen abuf alen pn buf =+    withForeignPtr fctx $ \pctx ->+        fromIntegral <$> c_aead_do_decrypt pctx buf ibuf ilen' pn' abuf alen'+  where+    pn' = fromIntegral pn+    ilen' = fromIntegral ilen+    alen' = fromIntegral alen++----------------------------------------------------------------++data SupplementOpaque+newtype Supplement = SP (ForeignPtr SupplementOpaque)++fusionSetupSupplement :: Cipher -> Key -> IO Supplement+fusionSetupSupplement cipher (Key hpkey) = withByteString hpkey $ \hpkeyp ->+  SP <$> (c_supplement_new hpkeyp keylen >>= newForeignPtr p_supplement_free)+ where+  keylen+    | cipher == cipher_TLS13_AES128GCM_SHA256 = 16+    | otherwise                               = 32++fusionSetSample :: Supplement -> Ptr Word8 -> IO ()+fusionSetSample (SP fsupp) p = withForeignPtr fsupp $ \psupp ->+  c_supplement_set_sample psupp p++fusionGetMask :: Supplement -> IO (Ptr Word8)+fusionGetMask (SP fsupp) = withForeignPtr fsupp c_supplement_get_mask++----------------------------------------------------------------++foreign import ccall unsafe "aead_context_new"+    c_aead_context_new :: IO (Ptr FusionContextOpaque)++foreign import ccall unsafe "&aead_context_free"+    p_aead_context_free :: FunPtr (Ptr FusionContextOpaque -> IO ())++foreign import ccall unsafe "aes128gcm_setup"+    c_aes128gcm_setup :: Ptr FusionContextOpaque+                      -> CInt       -- dummy+                      -> Ptr Word8  -- key+                      -> Ptr Word8  -- iv+                      -> IO CInt++foreign import ccall unsafe "aes256gcm_setup"+    c_aes256gcm_setup :: Ptr FusionContextOpaque+                      -> CInt       -- dummy+                      -> Ptr Word8  -- key+                      -> Ptr Word8  -- iv+                      -> IO CInt+{-+foreign import ccall unsafe "aesgcm_dispose_crypto"+    c_aesgcm_dispose_crypto :: FusionContext -> IO ()+-}++foreign import ccall unsafe "aead_do_encrypt"+    c_aead_do_encrypt :: Ptr FusionContextOpaque+                      -> Ptr Word8 -- output+                      -> Ptr Word8 -- input+                      -> CSize     -- input length+                      -> CULong    -- sequence+                      -> Ptr Word8 -- AAD+                      -> CSize     -- AAD length+                      -> Ptr SupplementOpaque+                      -> IO ()++foreign import ccall unsafe "aead_do_decrypt"+    c_aead_do_decrypt :: Ptr FusionContextOpaque+                      -> Ptr Word8 -- output+                      -> Ptr Word8 -- input+                      -> CSize     -- input length+                      -> CULong    -- sequence+                      -> Ptr Word8 -- AAD+                      -> CSize     -- AAD length+                      -> IO CSize++foreign import ccall unsafe "supplement_new"+    c_supplement_new :: Ptr Word8 -> CInt -> IO (Ptr SupplementOpaque)++foreign import ccall unsafe "&supplement_free"+    p_supplement_free :: FunPtr (Ptr SupplementOpaque -> IO ())++foreign import ccall unsafe "supplement_set_sample"+    c_supplement_set_sample :: Ptr SupplementOpaque -> Ptr Word8 -> IO ()++foreign import ccall unsafe "supplement_get_mask"+    c_supplement_get_mask :: Ptr SupplementOpaque -> IO (Ptr Word8)
+ Network/QUIC/Exception.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Network.QUIC.Exception (+    handleLogT+  , handleLogUnit+  ) where++import qualified GHC.IO.Exception as E+import qualified System.IO.Error as E+import qualified UnliftIO.Exception as E++import Network.QUIC.Logger++-- Catch all exceptions including asynchronous ones.+handleLogUnit :: DebugLogger -> IO () -> IO ()+handleLogUnit logAction action = action `E.catchSyncOrAsync` handler+  where+    handler :: E.SomeException -> IO ()+    handler se = case E.fromException se of+      -- threadWait: invalid argument (Bad file descriptor)+      Just e | E.ioeGetErrorType e == E.InvalidArgument -> return ()+      -- recvBuf: does not exist (Connection refused)+      Just e | E.ioeGetErrorType e == E.NoSuchThing     -> return ()+      _                                                 -> logAction $ bhow se++-- Log and throw an exception+handleLogT :: DebugLogger -> IO a -> IO a+handleLogT logAction action = action `E.catchAny` handler+  where+    handler (E.SomeException e) = do+        logAction $ bhow e+        E.throwIO e
+ Network/QUIC/Handshake.hs view
@@ -0,0 +1,261 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Network.QUIC.Handshake where++import qualified Network.TLS as TLS+import Network.TLS.QUIC+import qualified UnliftIO.Exception as E++import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Info+import Network.QUIC.Logger+import Network.QUIC.Parameters+import Network.QUIC.Qlog+import Network.QUIC.Recovery+import Network.QUIC.TLS+import Network.QUIC.Types++----------------------------------------------------------------++newtype HndState = HndState+    { hsRecvCnt :: Int  -- number of 'recv' calls since last 'send'+    }++newHndStateRef :: IO (IORef HndState)+newHndStateRef = newIORef HndState { hsRecvCnt = 0 }++sendCompleted :: IORef HndState -> IO ()+sendCompleted hsr = atomicModifyIORef'' hsr $ \hs -> hs { hsRecvCnt = 0 }++recvCompleted :: IORef HndState -> IO Int+recvCompleted hsr = atomicModifyIORef' hsr $ \hs ->+    let cnt = hsRecvCnt hs in (hs { hsRecvCnt = cnt + 1 }, cnt)++rxLevelChanged :: IORef HndState -> IO ()+rxLevelChanged = sendCompleted++----------------------------------------------------------------++sendCryptoData :: Connection -> Output -> IO ()+sendCryptoData = putOutput++recvCryptoData :: Connection -> IO Crypto+recvCryptoData = takeCrypto++recvTLS :: Connection -> IORef HndState -> CryptLevel -> IO (Either TLS.TLSError ByteString)+recvTLS conn hsr level =+    case level of+            CryptInitial           -> go InitialLevel+            CryptMasterSecret      -> failure "QUIC does not receive data < TLS 1.3"+            CryptEarlySecret       -> failure "QUIC does not send early data with TLS library"+            CryptHandshakeSecret   -> go HandshakeLevel+            CryptApplicationSecret -> go RTT1Level+  where+    failure = return . Left . internalError++    go expected = do+        InpHandshake actual bs <- recvCryptoData conn+        if bs == "" then+            return $ Left TLS.Error_EOF+          else if actual /= expected then+            failure $ "encryption level mismatch: expected " ++ show expected ++ " but got " ++ show actual+          else do+            when (isClient conn) $ do+                n <- recvCompleted hsr+                -- Sending ACKs for three times rule+                when ((n `mod` 3) == 1) $+                    sendCryptoData conn $ OutControl HandshakeLevel [] $ return ()+            return $ Right bs++sendTLS :: Connection -> IORef HndState -> [(CryptLevel, ByteString)] -> IO ()+sendTLS conn hsr x = do+    mapM convertLevel x >>= sendCryptoData conn . OutHandshake+    sendCompleted hsr+  where+    convertLevel (CryptInitial, bs) = return (InitialLevel, bs)+    convertLevel (CryptMasterSecret, _) = errorTLS "QUIC does not send data < TLS 1.3"+    convertLevel (CryptEarlySecret, _) = errorTLS "QUIC does not receive early data with TLS library"+    convertLevel (CryptHandshakeSecret, bs) = return (HandshakeLevel, bs)+    convertLevel (CryptApplicationSecret, bs) = return (RTT1Level, bs)++internalError :: String -> TLS.TLSError+internalError msg     = TLS.Error_Protocol (msg, True, TLS.InternalError)+-- unexpectedMessage msg = TLS.Error_Protocol (msg, True, TLS.UnexpectedMessage)++----------------------------------------------------------------++handshakeClient :: ClientConfig -> Connection -> AuthCIDs -> IO (IO ())+handshakeClient conf conn myAuthCIDs = do+    qlogParamsSet conn (ccParameters conf, "local") -- fixme+    handshakeClient' conf conn myAuthCIDs <$> getVersion conn <*> newHndStateRef++handshakeClient' :: ClientConfig -> Connection -> AuthCIDs -> Version -> IORef HndState -> IO ()+handshakeClient' conf conn myAuthCIDs ver hsr = handshaker+  where+    handshaker = clientHandshaker qc conf ver myAuthCIDs setter use0RTT `E.catch` sendCCTLSError+    qc = QUICCallbacks { quicSend = sendTLS conn hsr+                       , quicRecv = recvTLS conn hsr+                       , quicInstallKeys = installKeysClient+                       , quicNotifyExtensions = setPeerParams conn+                       , quicDone = done+                       }+    setter = setResumptionSession conn+    installKeysClient _ctx (InstallEarlyKeys Nothing) = return ()+    installKeysClient _ctx (InstallEarlyKeys (Just (EarlySecretInfo cphr cts))) = do+        setCipher conn RTT0Level cphr+        initializeCoder conn RTT0Level (cts, ServerTrafficSecret "")+        setConnection0RTTReady conn+    installKeysClient _ctx (InstallHandshakeKeys (HandshakeSecretInfo cphr tss)) = do+        setCipher conn HandshakeLevel cphr+        setCipher conn RTT1Level cphr+        initializeCoder conn HandshakeLevel tss+        setEncryptionLevel conn HandshakeLevel+        rxLevelChanged hsr+    installKeysClient ctx (InstallApplicationKeys appSecInf@(ApplicationSecretInfo tss)) = do+        storeNegotiated conn ctx appSecInf+        initializeCoder1RTT conn tss+        setEncryptionLevel conn RTT1Level+        rxLevelChanged hsr+        setConnection1RTTReady conn+        cidInfo <- getNewMyCID conn+        putOutput conn $ OutHandshake [] -- for h3spec testing+        sendFrames conn RTT1Level [NewConnectionID cidInfo 0]+    done _ctx = do+        info <- getConnectionInfo conn+        connDebugLog conn $ bhow info+    use0RTT = ccUse0RTT conf++----------------------------------------------------------------++handshakeServer :: ServerConfig -> Connection -> AuthCIDs -> IO (IO ())+handshakeServer conf conn myAuthCIDs =+    handshakeServer' conf conn myAuthCIDs <$> getVersion conn <*> newHndStateRef++handshakeServer' :: ServerConfig -> Connection -> AuthCIDs -> Version -> IORef HndState -> IO ()+handshakeServer' conf conn myAuthCIDs ver hsr = handshaker+  where+    handshaker = serverHandshaker qc conf ver myAuthCIDs `E.catch` sendCCTLSError+    qc = QUICCallbacks { quicSend = sendTLS conn hsr+                       , quicRecv = recvTLS conn hsr+                       , quicInstallKeys = installKeysServer+                       , quicNotifyExtensions = setPeerParams conn+                       , quicDone = done+                       }+    installKeysServer _ctx (InstallEarlyKeys Nothing) = return ()+    installKeysServer _ctx (InstallEarlyKeys (Just (EarlySecretInfo cphr cts))) = do+        setCipher conn RTT0Level cphr+        initializeCoder conn RTT0Level (cts, ServerTrafficSecret "")+        setConnection0RTTReady conn+    installKeysServer _ctx (InstallHandshakeKeys (HandshakeSecretInfo cphr tss)) = do+        setCipher conn HandshakeLevel cphr+        setCipher conn RTT1Level cphr+        initializeCoder conn HandshakeLevel tss+        setEncryptionLevel conn HandshakeLevel+        rxLevelChanged hsr+    installKeysServer ctx (InstallApplicationKeys appSecInf@(ApplicationSecretInfo tss)) = do+        storeNegotiated conn ctx appSecInf+        initializeCoder1RTT conn tss+        -- will switch to RTT1Level after client Finished+        -- is received and verified+    done ctx = do+        setEncryptionLevel conn RTT1Level+        TLS.getClientCertificateChain ctx >>= setCertificateChain conn+        fire conn (Microseconds 100000) $ do+            let ldcc = connLDCC conn+            discarded0 <- getAndSetPacketNumberSpaceDiscarded ldcc RTT0Level+            unless discarded0 $ dropSecrets conn RTT0Level+            discarded1 <- getAndSetPacketNumberSpaceDiscarded ldcc HandshakeLevel+            unless discarded1 $ do+                dropSecrets conn HandshakeLevel+                onPacketNumberSpaceDiscarded (connLDCC conn) HandshakeLevel+            clearCryptoStream conn HandshakeLevel+            clearCryptoStream conn RTT1Level+        setConnection1RTTReady conn+        setConnectionEstablished conn+--        sendFrames conn RTT1Level [HandshakeDone]+        --+        info <- getConnectionInfo conn+        connDebugLog conn $ bhow info++----------------------------------------------------------------++setPeerParams :: Connection -> TLS.Context -> [ExtensionRaw] -> IO ()+setPeerParams conn _ctx ps0 = do+    ver <- getVersion conn+    let mps | ver == Version1 = getTP extensionID_QuicTransportParameters ps0+            | otherwise       = getTP 0xffa5 ps0+    setPP mps+  where+    getTP _ [] = Nothing+    getTP n (ExtensionRaw extid bs : ps)+      | extid == n = Just bs+      | otherwise  = getTP n ps+    setPP Nothing = return ()+    setPP (Just bs) = do+        let mparams = decodeParameters bs+        case mparams of+          Nothing     -> sendCCParamError+          Just params -> do+              checkAuthCIDs params+              checkInvalid params+              setParams params+              qlogParamsSet conn (params,"remote")++    checkAuthCIDs params = do+        peerAuthCIDs <- getPeerAuthCIDs conn+        ensure (initialSourceConnectionId params) $ initSrcCID peerAuthCIDs+        when (isClient conn) $ do+            ensure (originalDestinationConnectionId params) $ origDstCID peerAuthCIDs+            ensure (retrySourceConnectionId params) $ retrySrcCID peerAuthCIDs+    ensure _ Nothing = return ()+    ensure v0 v1+      | v0 == v1  = return ()+      | otherwise = sendCCParamError+    checkInvalid params = do+        when (maxUdpPayloadSize params < 1200) sendCCParamError+        when (ackDelayExponent params > 20) sendCCParamError+        when (maxAckDelay params >= 2^(14 :: Int)) sendCCParamError+        when (isServer conn) $ do+            when (isJust $ originalDestinationConnectionId params) sendCCParamError+            when (isJust $ preferredAddress params) sendCCParamError+            when (isJust $ retrySourceConnectionId params) sendCCParamError+            when (isJust $ statelessResetToken params) sendCCParamError+    setParams params = do+        setPeerParameters conn params+        mapM_ (setPeerStatelessResetToken conn) $ statelessResetToken params+        setTxMaxData conn $ initialMaxData params+        setMinIdleTimeout conn $ milliToMicro $ maxIdleTimeout params+        setMaxAckDaley (connLDCC conn) $ milliToMicro $ maxAckDelay params+        setMyMaxStreams conn $ initialMaxStreamsBidi params+        setMyUniMaxStreams conn $ initialMaxStreamsUni params++storeNegotiated :: Connection -> TLS.Context -> ApplicationSecretInfo -> IO ()+storeNegotiated conn ctx appSecInf = do+    appPro <- TLS.getNegotiatedProtocol ctx+    minfo <- TLS.contextGetInformation ctx+    let mode = fromMaybe FullHandshake (minfo >>= TLS.infoTLS13HandshakeMode)+    setNegotiated conn mode appPro appSecInf++----------------------------------------------------------------++sendCCParamError :: IO ()+sendCCParamError = E.throwIO WrongTransportParameter++sendCCTLSError :: TLS.TLSException -> IO ()+sendCCTLSError (TLS.HandshakeFailed (TLS.Error_Misc "WrongTransportParameter")) = closeConnection TransportParameterError "Transport parametter error"+sendCCTLSError e = closeConnection err msg+  where+    tlserr = getErrorCause e+    err = cryptoError $ errorToAlertDescription tlserr+    msg = shortpack $ errorToAlertMessage tlserr++getErrorCause :: TLS.TLSException -> TLS.TLSError+getErrorCause (TLS.HandshakeFailed e) = e+getErrorCause (TLS.Terminated _ _ e)  = e+getErrorCause e =+    let msg = "unexpected TLS exception: " ++ show e+     in TLS.Error_Protocol (msg, True, TLS.InternalError)
+ Network/QUIC/IO.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.IO where++import Control.Concurrent.STM+import qualified Data.ByteString as BS+import qualified UnliftIO.Exception as E++import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Parameters+import Network.QUIC.Stream+import Network.QUIC.Types++-- | Creating a bidirectional stream.+stream :: Connection -> IO Stream+stream conn = do+    sid <- waitMyNewStreamId conn+    addStream conn sid++-- | Creating a unidirectional stream.+unidirectionalStream :: Connection -> IO Stream+unidirectionalStream conn = do+    sid <- waitMyNewUniStreamId conn+    addStream conn sid++-- | Sending data in the stream.+sendStream :: Stream -> ByteString -> IO ()+sendStream s dat = sendStreamMany s [dat]++----------------------------------------------------------------++data Blocked = BothBlocked Stream Int Int+             | ConnBlocked Int+             | StrmBlocked Stream Int+             deriving Show++addTx :: Connection -> Stream -> Int -> IO ()+addTx conn s len = atomically $ do+    addTxStreamData s len+    addTxData conn len++-- | Sending a list of data in the stream.+sendStreamMany :: Stream -> [ByteString] -> IO ()+sendStreamMany _   [] = return ()+sendStreamMany s dats0 = do+    sclosed <- isTxStreamClosed s+    when sclosed $ E.throwIO StreamIsClosed+    -- fixme: size check for 0RTT+    let len = totalLen dats0+    ready <- isConnection1RTTReady conn+    if not ready then do+        -- 0-RTT+        putSendStreamQ conn $ TxStreamData s dats0 len False+        addTx conn s len+      else+        flowControl dats0 len False+  where+    conn = streamConnection s+    flowControl dats len wait = do+        -- 1-RTT+        eblocked <- checkBlocked s len wait+        case eblocked of+          Right n+            | len == n  -> do+                  putSendStreamQ conn $ TxStreamData s dats len False+                  addTx conn s n+            | otherwise -> do+                  let (dats1,dats2) = split n dats+                  putSendStreamQ conn $ TxStreamData s dats1 n False+                  addTx conn s n+                  flowControl dats2 (len - n) False+          Left blocked  -> do+              -- fixme: RTT0Level?+              sendBlocked conn RTT1Level blocked+              flowControl dats len True++sendBlocked :: Connection -> EncryptionLevel -> Blocked -> IO ()+sendBlocked conn lvl blocked = sendFrames conn lvl frames+  where+    frames = case blocked of+      StrmBlocked strm n   -> [StreamDataBlocked (streamId strm) n]+      ConnBlocked n        -> [DataBlocked n]+      BothBlocked strm n m -> [StreamDataBlocked (streamId strm) n, DataBlocked m]++split :: Int -> [BS.ByteString] -> ([BS.ByteString],[BS.ByteString])+split n0 dats0 = loop n0 dats0 id+  where+    loop 0 bss      build = (build [], bss)+    loop _ []       build = (build [], [])+    loop n (bs:bss) build = case len `compare` n of+        GT -> let (bs1,bs2) = BS.splitAt n bs+              in (build [bs1], bs2:bss)+        EQ -> (build [bs], bss)+        LT -> loop (n - len) bss (build . (bs :))+      where+        len = BS.length bs++checkBlocked :: Stream -> Int -> Bool -> IO (Either Blocked Int)+checkBlocked s len wait = atomically $ do+    let conn = streamConnection s+    strmFlow <- readStreamFlowTx s+    connFlow <- readConnectionFlowTx conn+    let strmWindow = flowWindow strmFlow+        connWindow = flowWindow connFlow+        minFlow = min strmWindow connWindow+        n = min len minFlow+    when wait $ check (n > 0)+    if n > 0 then+        return $ Right n+      else do+        let cs = len > strmWindow+            cw = len > connWindow+            blocked+              | cs && cw  = BothBlocked s (flowMaxData strmFlow) (flowMaxData connFlow)+              | cs        = StrmBlocked s (flowMaxData strmFlow)+              | otherwise = ConnBlocked (flowMaxData connFlow)+        return $ Left blocked++----------------------------------------------------------------++-- | Sending FIN in a stream.+--   'closeStream' should be called later.+shutdownStream :: Stream -> IO ()+shutdownStream s = do+    sclosed <- isTxStreamClosed s+    when sclosed $ E.throwIO StreamIsClosed+    setTxStreamClosed s+    putSendStreamQ (streamConnection s) $ TxStreamData s [] 0 True++-- | Closing a stream without an error.+--   This sends FIN if necessary.+closeStream :: Stream -> IO ()+closeStream s = do+    let conn = streamConnection s+    let sid = streamId s+    sclosed <- isTxStreamClosed s+    unless sclosed $ do+        setTxStreamClosed s+        setRxStreamClosed s+        putSendStreamQ conn $ TxStreamData s [] 0 True+    delStream conn s+    when ((isClient conn && isServerInitiatedBidirectional sid)+       || (isServer conn && isClientInitiatedBidirectional sid)) $ do+        n <- getPeerMaxStreams conn+        putOutput conn $ OutControl RTT1Level [MaxStreams Unidirectional n] $ return ()++-- | Accepting a stream initiated by the peer.+acceptStream :: Connection -> IO Stream+acceptStream conn = do+    InpStream s <- takeInput conn+    return s++-- | Receiving data in the stream. In the case where a FIN is received+--   an empty bytestring is returned.+recvStream :: Stream -> Int -> IO ByteString+recvStream s n = do+    bs <- takeRecvStreamQwithSize s n+    let len = BS.length bs+        conn = streamConnection s+    addRxStreamData s len+    addRxData conn len+    window <- getRxStreamWindow s+    let sid = streamId s+        initialWindow = initialRxMaxStreamData conn sid+    when (window <= (initialWindow .>>. 1)) $ do+        newMax <- addRxMaxStreamData s initialWindow+        sendFrames conn RTT1Level [MaxStreamData sid newMax]+        fire conn (Microseconds 50000) $ do+            newMax' <- getRxMaxStreamData s+            sendFrames conn RTT1Level [MaxStreamData sid newMax']+    cwindow <- getRxDataWindow conn+    let cinitialWindow = initialMaxData $ getMyParameters conn+    when (cwindow <= (cinitialWindow .>>. 1)) $ do+        newMax <- addRxMaxData conn cinitialWindow+        sendFrames conn RTT1Level [MaxData newMax]+        fire conn (Microseconds 50000) $ do+            newMax' <- getRxMaxData conn+            sendFrames conn RTT1Level [MaxData newMax']+    return bs++-- | Closing a stream with an error code.+--   This sends RESET_STREAM to the peer.+--   This is an alternative of 'closeStream'.+resetStream :: Stream -> ApplicationProtocolError -> IO ()+resetStream s aerr = do+    let conn = streamConnection s+    let sid = streamId s+    sclosed <- isTxStreamClosed s+    unless sclosed $ do+        setTxStreamClosed s+        setRxStreamClosed s+        lvl <- getEncryptionLevel conn+        let frame = ResetStream sid aerr 0+        putOutput conn $ OutControl lvl [frame] $ return ()+    delStream conn s++-- | Asking the peer to stop sending.+--   This sends STOP_SENDING to the peer+--   and it will send RESET_STREAM back.+--   'closeStream' should be called later.+stopStream :: Stream -> ApplicationProtocolError -> IO ()+stopStream s aerr = do+    let conn = streamConnection s+    let sid = streamId s+    sclosed <- isRxStreamClosed s+    unless sclosed $ do+        setRxStreamClosed s+        lvl <- getEncryptionLevel conn+        let frame = StopSending sid aerr+        putOutput conn $ OutControl lvl [frame] $ return ()
+ Network/QUIC/Imports.hs view
@@ -0,0 +1,57 @@+module Network.QUIC.Imports (+    Bytes+  , ByteString(..)+  , ShortByteString(..)+  , Builder+  , module Control.Applicative+  , module Control.Monad+  , module Data.Bits+  , module Data.Foldable+  , module Data.IORef+  , module Data.Int+  , module Data.Monoid+  , module Data.Ord+  , module Data.Word+  , module Data.Array+  , module Data.Array.IO+  , module Data.Maybe+  , module Numeric+  , module Network.ByteOrder+  , module Network.QUIC.Utils+  , (.<<.), (.>>.)+  , atomicModifyIORef''+  ) where++import Control.Applicative+import Control.Monad+import Data.Array+import Data.Array.IO+import Data.Bits+import Data.ByteString.Builder (Builder)+import Data.ByteString.Internal (ByteString(..))+import Data.ByteString.Short.Internal (ShortByteString(..))+import Data.Foldable+import Data.IORef+import Data.Int+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.Word+import Network.ByteOrder+import Network.QUIC.Utils+import Numeric++-- | All internal byte sequences.+--   `ByteString` should be used for FFI related stuff.+type Bytes = ShortByteString++infixl 8 .<<.+(.<<.) :: Bits a => a -> Int -> a+(.<<.) = unsafeShiftL++infixl 8 .>>.+(.>>.) :: Bits a => a -> Int -> a+(.>>.) = unsafeShiftR++atomicModifyIORef'' :: IORef a -> (a -> a) -> IO ()+atomicModifyIORef'' ref f = atomicModifyIORef' ref $ \x -> (f x, ())
+ Network/QUIC/Info.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Info where++import qualified Data.ByteString.Char8 as C8+import qualified Network.Socket as NS+import Network.TLS hiding (Version, HandshakeFailed)++import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Types++----------------------------------------------------------------++-- | Information about a connection.+data ConnectionInfo = ConnectionInfo {+    version :: Version+  , cipher :: Cipher+  , alpn :: Maybe ByteString+  , handshakeMode :: HandshakeMode13+  , retry :: Bool+  , localSockAddr :: NS.SockAddr+  , remoteSockAddr :: NS.SockAddr+  , localCID :: CID+  , remoteCID :: CID+  }++-- | Getting information about a connection.+getConnectionInfo :: Connection -> IO ConnectionInfo+getConnectionInfo conn = do+    s:_    <- getSockets conn+    mysa   <- NS.getSocketName s+    peersa <- if isClient conn then do+                  msa <- getServerAddr conn+                  case msa of+                    Nothing -> NS.getPeerName s+                    Just sa -> return sa+                else+                  NS.getPeerName s+    mycid   <- getMyCID conn+    peercid <- getPeerCID conn+    c <- getCipher conn RTT1Level+    mproto <- getApplicationProtocol conn+    mode <- getTLSMode conn+    r <- getRetried conn+    v <- getVersion conn+    return ConnectionInfo {+        version = v+      , cipher = c+      , alpn = mproto+      , handshakeMode = mode+      , retry = r+      , localSockAddr  = mysa+      , remoteSockAddr = peersa+      , localCID  = mycid+      , remoteCID = peercid+      }++instance Show ConnectionInfo where+    show ConnectionInfo{..} = "Version: " ++ show version ++ "\n"+                           ++ "Cipher: " ++ show cipher ++ "\n"+                           ++ "ALPN: " ++ maybe "none" C8.unpack alpn ++ "\n"+                           ++ "Mode: " ++ show handshakeMode ++ "\n"+                           ++ "Local CID: " ++ show localCID ++ "\n"+                           ++ "Remote CID: " ++ show remoteCID ++ "\n"+                           ++ "Local SockAddr: " ++ show localSockAddr ++ "\n"+                           ++ "Remote SockAddr: " ++ show remoteSockAddr +++                           if retry then "\nQUIC retry" else ""++----------------------------------------------------------------++-- | Statistics of a connection.+data ConnectionStats = ConnectionStats {+    txBytes :: Int+  , rxBytes :: Int+  } deriving (Eq, Show)++-- | Getting statistics of a connection.+getConnectionStats :: Connection -> IO ConnectionStats+getConnectionStats conn = do+    tx <- getTxBytes conn+    rx <- getRxBytes conn+    return $ ConnectionStats {+        txBytes = tx+      , rxBytes = rx+      }
+ Network/QUIC/Internal.hs view
@@ -0,0 +1,33 @@+module Network.QUIC.Internal (+    module Network.QUIC.Config+  , module Network.QUIC.Connection+  , module Network.QUIC.Connector+  , module Network.QUIC.Crypto+  , module Network.QUIC.CryptoFusion+  , module Network.QUIC.Logger+  , module Network.QUIC.Packet+  , module Network.QUIC.Parameters+  , module Network.QUIC.Qlog+  , module Network.QUIC.Stream+  , module Network.QUIC.TLS+  , module Network.QUIC.Types+  , module Network.QUIC.Utils+  , module Network.QUIC.Recovery+  , module Network.QUIC.Client.Reader+  ) where++import Network.QUIC.Client.Reader (controlConnection,ConnectionControl(..))+import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Crypto+import Network.QUIC.CryptoFusion+import Network.QUIC.Logger+import Network.QUIC.Packet+import Network.QUIC.Parameters+import Network.QUIC.Qlog+import Network.QUIC.Recovery+import Network.QUIC.Stream+import Network.QUIC.TLS+import Network.QUIC.Types+import Network.QUIC.Utils
+ Network/QUIC/Logger.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Logger (+    Builder+  , DebugLogger+  , bhow+  , stdoutLogger+  , dirDebugLogger+  ) where++import System.FilePath+import System.Log.FastLogger+import Data.ByteString.Builder (byteString, toLazyByteString)+import qualified Data.ByteString.Char8 as C8+import qualified Data.ByteString.Lazy.Char8 as BL++import Network.QUIC.Imports+import Network.QUIC.Types++-- | A type for debug logger.+type DebugLogger = Builder -> IO ()++bhow :: Show a => a -> Builder+bhow = byteString . C8.pack . show++stdoutLogger :: DebugLogger+stdoutLogger b = BL.putStrLn $ toLazyByteString b++dirDebugLogger :: Maybe FilePath -> CID -> IO (DebugLogger, IO ())+dirDebugLogger Nothing _ = do+    let dLog ~_ = return ()+        clean = return ()+    return (dLog, clean)+dirDebugLogger (Just dir) cid = do+    let file = dir </> (show cid <> ".txt")+    (fastlogger, clean) <- newFastLogger1 (LogFileNoRotate file 4096)+    let dLog msg = do+            fastlogger (toLogStr msg <> "\n")+            stdoutLogger msg+    return (dLog, clean)
+ Network/QUIC/Packet.hs view
@@ -0,0 +1,42 @@+module Network.QUIC.Packet (+  -- * Encode+    encodeVersionNegotiationPacket+  , encodeRetryPacket+  , encodePlainPacket+  -- * Decode+  , decodePacket+  , decodePackets+  , decodeCryptPackets+  , decryptCrypt+  , decodeStatelessResetToken+  -- * Frame+  , encodeFrames+  , decodeFrames+  , countZero -- testing+  -- * Header+  , isLong+  , isShort+  , protectFlags+  , unprotectFlags+  , encodeLongHeaderFlags+  , encodeShortHeaderFlags+  , decodeLongHeaderPacketType+  , encodePktNumLength+  , decodePktNumLength+  , versionNegotiationPacketType+  , retryPacketType+  -- * Token+  , CryptoToken(..)+  , isRetryToken+  , generateToken+  , generateRetryToken+  , encryptToken+  , decryptToken+  ) where++import Network.QUIC.Packet.Decode+import Network.QUIC.Packet.Decrypt+import Network.QUIC.Packet.Encode+import Network.QUIC.Packet.Frame+import Network.QUIC.Packet.Header+import Network.QUIC.Packet.Token
+ Network/QUIC/Packet/Decode.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Packet.Decode (+    decodePacket+  , decodePackets+  , decodeCryptPackets+  , decodeStatelessResetToken+  ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Short as Short+import qualified UnliftIO.Exception as E++import Network.QUIC.Imports+import Network.QUIC.Packet.Header+import Network.QUIC.Types++----------------------------------------------------------------++decodeCryptPackets :: ByteString -> IO [(CryptPacket,EncryptionLevel)]+decodeCryptPackets bs0 = unwrap <$> decodePackets bs0+  where+    unwrap (PacketIC c l:xs) = (c,l) : unwrap xs+    unwrap (_:xs)            = unwrap xs+    unwrap []                = []++-- Client uses this.+decodePackets :: ByteString -> IO [PacketI]+decodePackets bs0 = loop bs0 id+  where+    loop "" build = return $ build [] -- fixme+    loop bs build = do+        (pkt, rest) <- decodePacket bs+        loop rest (build . (pkt :))++-- Server uses this.+decodePacket :: ByteString -> IO (PacketI, ByteString)+decodePacket bs = E.handle handler $ withReadBuffer bs $ \rbuf -> do+    save rbuf+    proFlags <- Flags <$> read8 rbuf+    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+        return $ PacketIC cpkt RTT1Level+    decode rbuf proFlags False = do+        (ver, dCID, sCID) <- decodeLongHeader rbuf+        case ver of+          Negotiation      -> do+              decodeVersionNegotiationPacket rbuf dCID sCID+          _                -> case decodeLongHeaderPacketType proFlags of+            RetryPacketType     -> do+                decodeRetryPacket rbuf proFlags ver dCID sCID+            RTT0PacketType      -> do+                let header = RTT0 ver dCID sCID+                cpkt <- CryptPacket header <$> makeLongCrypt bs rbuf+                return $ PacketIC cpkt RTT0Level+            InitialPacketType   -> do+                tokenLen <- fromIntegral <$> decodeInt' rbuf+                token <- extractByteString rbuf tokenLen+                let header = Initial ver dCID sCID token+                cpkt <- CryptPacket header <$> makeLongCrypt bs rbuf+                return $ PacketIC cpkt InitialLevel+            HandshakePacketType -> do+                let header = Handshake ver dCID sCID+                crypt <- CryptPacket header <$> makeLongCrypt bs rbuf+                return $ PacketIC crypt HandshakeLevel+    handler BufferOverrun = return (PacketIB BrokenPacket,"")++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
+ Network/QUIC/Packet/Decrypt.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Packet.Decrypt (+    decryptCrypt+  ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import Foreign.Ptr+import Network.ByteOrder++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.Types++----------------------------------------------------------------++decryptCrypt :: Connection -> Buffer -> BufferSize -> Crypt -> EncryptionLevel -> IO (Maybe Plain)+decryptCrypt conn decBuf _bufsiz Crypt{..} lvl = do -- fixme: bufsiz is not used+    cipher <- getCipher conn lvl+    protector <- getProtector conn lvl+    let proFlags = Flags (cryptPacket `BS.index` 0)+        sampleOffset = cryptPktNumOffset + 4+        sampleLen = sampleLength cipher+        sample = Sample $ BS.take sampleLen $ BS.drop sampleOffset cryptPacket+        makeMask = unprotect protector+        Mask mask = makeMask sample+    case BS.uncons mask of+      Nothing -> return Nothing+      Just (mask1,mask2) -> do+        let rawFlags@(Flags flags) = unprotectFlags proFlags mask1+            epnLen = decodePktNumLength rawFlags+            epn = BS.take epnLen $ BS.drop cryptPktNumOffset cryptPacket+            bytePN = bsXOR mask2 epn+            headerLen = cryptPktNumOffset + epnLen+            (proHeader, ciphertext) = BS.splitAt headerLen cryptPacket+            ilen = BS.length ciphertext+        peerPN <- if lvl == RTT1Level then getPeerPacketNumber conn else return 0+        let pn = decodePacketNumber peerPN (toEncodedPacketNumber bytePN) epnLen+        header <- BS.create headerLen $ \p -> do+            void $ copy p proHeader+            poke8 flags p 0+            void $ copy (p `plusPtr` cryptPktNumOffset) $ BS.take epnLen bytePN+        let keyPhase | lvl == RTT1Level = flags `testBit` 2+                     | otherwise        = False+        coder <- getCoder conn lvl keyPhase+        siz <- withByteString ciphertext $ \ibuf ->+                   withByteString header $ \abuf -> do+            let ilen' = fromIntegral ilen+                alen' = fromIntegral headerLen+            decrypt coder ibuf ilen' abuf alen' pn decBuf+        let rrMask | lvl == RTT1Level = 0x18+                   | otherwise        = 0x0c+            marks | flags .&. rrMask == 0 = defaultPlainMarks+                  | otherwise             = setIllegalReservedBits defaultPlainMarks+        if siz < 0 then+            return Nothing+          else do+            mframes <- decodeFrames decBuf siz+            case mframes of+              Nothing -> do+                  let marks' = setUnknownFrame marks+                  return $ Just $ Plain rawFlags pn [] marks'+              Just frames -> do+                  let marks' | null frames = setNoFrames marks+                             | otherwise   = marks+                  return $ Just $ Plain rawFlags pn frames marks'++toEncodedPacketNumber :: ByteString -> EncodedPacketNumber+toEncodedPacketNumber bs = foldl' (\b a -> b * 256 + fromIntegral a) 0 $ BS.unpack bs
+ Network/QUIC/Packet/Encode.hs view
@@ -0,0 +1,211 @@+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 dCID sCID vers) = withWriteBuffer maximumQUICHeaderSize $ \wbuf -> do+    Flags flags <- versionNegotiationPacketType+    write8 wbuf flags+    -- ver .. sCID+    encodeLongHeader wbuf Negotiation dCID sCID+    -- vers+    mapM_ (\(Version ver) -> write32 wbuf ver) vers+    -- no header protection++----------------------------------------------------------------++encodeRetryPacket :: RetryPacket -> IO ByteString+encodeRetryPacket (RetryPacket ver dCID sCID token (Left odCID)) = withWriteBuffer maximumQUICHeaderSize $ \wbuf -> do+    save wbuf+    Flags flags <- retryPacketType+    write8 wbuf flags+    encodeLongHeader wbuf ver dCID sCID+    copyByteString wbuf token+    siz <- savingSize wbuf+    pseudo0 <- extractByteString wbuf $ negate siz+    let tag = calculateIntegrityTag ver odCID pseudo0+    copyByteString wbuf tag+    -- no header protection+encodeRetryPacket _ = error "encodeRetryPacket"++----------------------------------------------------------------++encodePlainPacket :: Connection -> Buffer -> BufferSize -> PlainPacket -> Maybe Int -> IO (Int,Int)+encodePlainPacket conn buf bufsiz ppkt@(PlainPacket _ plain) mlen = do+    let mlen' | isNoPaddings (plainMarks plain) = Nothing+              | otherwise                       = mlen+    wbuf <- newWriteBuffer buf bufsiz+    let encodeBuf = buf `plusPtr` bufsiz -- see sender+    encodePlainPacket' conn wbuf encodeBuf ppkt mlen'++encodePlainPacket' :: Connection -> WriteBuffer -> Buffer -> PlainPacket -> Maybe Int -> IO (Int,Int)+encodePlainPacket' conn wbuf encodeBuf (PlainPacket (Initial ver dCID sCID token) (Plain flags pn frames _)) mlen = do+    headerBeg <- currentOffset wbuf+    -- flag ... sCID+    (epn, epnLen) <- encodeLongHeaderPP conn wbuf InitialPacketType ver dCID sCID flags pn+    -- token+    encodeInt' wbuf $ fromIntegral $ BS.length token+    copyByteString wbuf token+    -- length .. payload+    protectPayloadHeader conn wbuf encodeBuf frames pn epn epnLen headerBeg mlen InitialLevel False++encodePlainPacket' conn wbuf encodeBuf (PlainPacket (RTT0 ver dCID sCID) (Plain flags pn frames _)) mlen = do+    headerBeg <- currentOffset wbuf+    -- flag ... sCID+    (epn, epnLen) <- encodeLongHeaderPP conn wbuf RTT0PacketType ver dCID sCID flags pn+    -- length .. payload+    protectPayloadHeader conn wbuf encodeBuf frames pn epn epnLen headerBeg mlen RTT0Level False++encodePlainPacket' conn wbuf encodeBuf (PlainPacket (Handshake ver dCID sCID) (Plain flags pn frames _)) mlen = do+    headerBeg <- currentOffset wbuf+    -- flag ... sCID+    (epn, epnLen) <- encodeLongHeaderPP conn wbuf HandshakePacketType ver dCID sCID flags pn+    -- length .. payload+    protectPayloadHeader conn wbuf encodeBuf frames pn epn epnLen headerBeg mlen HandshakeLevel False++encodePlainPacket' conn wbuf encodeBuf (PlainPacket (Short dCID) (Plain flags pn frames marks)) mlen = do+    headerBeg <- currentOffset wbuf+    -- flag+    let (epn, epnLen) | is4bytesPN marks = (fromIntegral pn, 4)+                      | otherwise        = encodePacketNumber 0 {- dummy -} pn+        pp = encodePktNumLength epnLen+    quicBit <- greaseQuicBit <$> getPeerParameters conn+    (keyPhase,_) <- getCurrentKeyPhase conn+    Flags flags' <- encodeShortHeaderFlags flags pp quicBit keyPhase+    write8 wbuf flags'+    -- dCID+    let (dcid, _) = unpackCID dCID+    copyShortByteString wbuf dcid+    protectPayloadHeader conn wbuf encodeBuf frames pn epn epnLen headerBeg mlen RTT1Level keyPhase++----------------------------------------------------------------++encodeLongHeader :: WriteBuffer+                 -> Version -> CID -> CID+                 -> IO ()+encodeLongHeader wbuf (Version ver) dCID sCID = do+    write32 wbuf ver+    let (dcid, dcidlen) = unpackCID dCID+    write8 wbuf dcidlen+    copyShortByteString wbuf dcid+    let (scid, scidlen) = unpackCID sCID+    write8 wbuf scidlen+    copyShortByteString wbuf scid++----------------------------------------------------------------++encodeLongHeaderPP :: Connection -> WriteBuffer+                   -> LongHeaderPacketType -> Version -> CID -> CID+                   -> Flags Raw+                   -> PacketNumber+                   -> IO (EncodedPacketNumber, Int)+encodeLongHeaderPP conn wbuf pkttyp ver dCID sCID flags pn = do+    let el@(_, pnLen) = encodePacketNumber 0 {- dummy -} pn+        pp = encodePktNumLength pnLen+    quicBit <- greaseQuicBit <$> getPeerParameters conn+    Flags flags' <- encodeLongHeaderFlags pkttyp flags pp quicBit+    write8 wbuf flags'+    encodeLongHeader wbuf ver dCID sCID+    return el++----------------------------------------------------------------++protectPayloadHeader :: Connection -> WriteBuffer -> Buffer -> [Frame] -> PacketNumber -> EncodedPacketNumber -> Int -> Buffer -> Maybe Int -> EncryptionLevel -> Bool -> IO (Int,Int)+protectPayloadHeader conn wbuf encodeBuf frames pn epn epnLen headerBeg mlen lvl keyPhase = do+    -- Real size is maximumUdpPayloadSize. But smaller is better.+    let encodeBufLen = 1500 - 20 - 8+    payloadWithoutPaddingSiz <- encodeFramesWithPadding encodeBuf encodeBufLen frames+    cipher <- getCipher conn lvl+    coder <- getCoder conn lvl keyPhase+    protector <- getProtector conn lvl+    -- before length or packer number+    lengthOrPNBeg <- currentOffset wbuf+    (packetLen, headerLen, plainLen, tagLen, padLen)+        <- calcLen cipher lengthOrPNBeg payloadWithoutPaddingSiz+    when (lvl /= RTT1Level) $ writeLen (epnLen + plainLen + tagLen)+    pnBeg <- currentOffset wbuf+    writeEpn epnLen+    -- payload+    cryptoBeg <- currentOffset wbuf+    let sampleBeg = pnBeg `plusPtr` 4+    setSample protector sampleBeg+    len <- encrypt coder encodeBuf plainLen headerBeg headerLen pn cryptoBeg+    if len < 0 then+         return (-1, -1)+      else do+        -- protecting header+        maskBeg <- getMask protector+        if maskBeg == nullPtr then+            return (-1, -1)+          else do+            protectHeader headerBeg pnBeg epnLen maskBeg+            return (packetLen, padLen)+  where+    calcLen cipher lengthOrPNBeg payloadWithoutPaddingSiz = do+        let headerLen = (lengthOrPNBeg `minusPtr` headerBeg)+                      -- length: assuming 2byte length+                      + (if lvl /= RTT1Level then 2 else 0)+                      + epnLen+        let tagLen = tagLength cipher+            plainLen = case mlen of+                Nothing          -> payloadWithoutPaddingSiz+                Just expectedLen -> expectedLen - headerLen - tagLen+            packetLen = headerLen + plainLen + tagLen+            padLen = plainLen - payloadWithoutPaddingSiz+        return (packetLen, headerLen, plainLen, tagLen, padLen)+    -- length: assuming 2byte length+    writeLen len = encodeInt'2 wbuf $ fromIntegral len+    writeEpn 1 = write8  wbuf $ fromIntegral epn+    writeEpn 2 = write16 wbuf $ fromIntegral epn+    writeEpn 3 = write24 wbuf epn+    writeEpn _ = write32 wbuf epn++----------------------------------------------------------------++protectHeader :: Buffer -> Buffer -> Int -> Buffer -> IO ()+protectHeader headerBeg pnBeg epnLen maskBeg = do+    shuffleFlag+    shufflePN 0+    when (epnLen >= 2) $ shufflePN 1+    when (epnLen >= 3) $ shufflePN 2+    when (epnLen == 4) $ shufflePN 3+  where+    mask n = peek (maskBeg `plusPtr` n)+    shuffleFlag = do+        flags <- Flags <$> peek8 headerBeg 0+        mask0 <- mask 0+        let Flags proFlags = protectFlags flags mask0+        poke8 proFlags headerBeg 0+    shufflePN n = do+        p0 <- peek8 pnBeg n+        maskn1 <- mask (n + 1)+        let pp0 = p0 `xor` maskn1+        poke8 pp0 pnBeg n
+ Network/QUIC/Packet/Frame.hs view
@@ -0,0 +1,351 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Packet.Frame (+    encodeFrames+  , encodeFramesWithPadding+  , decodeFrames+  , countZero -- testing+  ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Short as Short+import Foreign.Ptr (Ptr, plusPtr, minusPtr, alignPtr, castPtr)+import Foreign.Storable (peek, alignment)+import Network.Socket.Internal (zeroMemory)++import Network.QUIC.Imports+import Network.QUIC.Types++----------------------------------------------------------------++encodeFrames :: [Frame] -> IO ByteString+encodeFrames frames = withWriteBuffer 2048 $ \wbuf ->+  mapM_ (encodeFrame wbuf) frames++encodeFramesWithPadding :: Buffer+                        -> BufferSize+                        -> [Frame]+                        -> IO Int   -- ^ payload size without paddings+encodeFramesWithPadding buf siz frames = do+    zeroMemory buf $ fromIntegral siz -- padding+    wbuf <- newWriteBuffer buf siz+    save wbuf+    mapM_ (encodeFrame wbuf) frames+    savingSize wbuf++encodeFrame :: WriteBuffer -> Frame -> IO ()+encodeFrame wbuf (Padding n) = replicateM_ n $ write8 wbuf 0x00+encodeFrame wbuf Ping = write8 wbuf 0x01+encodeFrame wbuf (Ack (AckInfo largest range1 ranges) (Milliseconds delay)) = do+    write8 wbuf 0x02+    encodeInt' wbuf $ fromIntegral largest+    encodeInt' wbuf $ fromIntegral delay+    encodeInt' wbuf $ fromIntegral $ length ranges+    encodeInt' wbuf $ fromIntegral range1+    mapM_ putRanges ranges+  where+    putRanges (gap,rng) = do+        encodeInt' wbuf $ fromIntegral gap+        encodeInt' wbuf $ fromIntegral rng+encodeFrame wbuf (ResetStream sid (ApplicationProtocolError err) finalLen) = do+    write8 wbuf 0x04+    encodeInt' wbuf $ fromIntegral sid+    encodeInt' wbuf $ fromIntegral err+    encodeInt' wbuf $ fromIntegral finalLen+encodeFrame wbuf (StopSending sid (ApplicationProtocolError err)) = do+    write8 wbuf 0x05+    encodeInt' wbuf $ fromIntegral sid+    encodeInt' wbuf $ fromIntegral err+encodeFrame wbuf (CryptoF off cdata) = do+    write8 wbuf 0x06+    encodeInt' wbuf $ fromIntegral off+    encodeInt' wbuf $ fromIntegral $ BS.length cdata+    copyByteString wbuf cdata+encodeFrame wbuf (NewToken token) = do+    write8 wbuf 0x07+    encodeInt' wbuf $ fromIntegral $ BS.length token+    copyByteString wbuf token+encodeFrame wbuf (StreamF sid off dats fin) = do+    let flag0 = 0x08 .|. 0x02 -- len+        flag1 | off /= 0  = flag0 .|. 0x04 -- off+              | otherwise = flag0+        flag2 | fin       = flag1 .|. 0x01 -- fin+              | otherwise = flag1+    write8 wbuf flag2+    encodeInt' wbuf $ fromIntegral sid+    when (off /= 0) $ encodeInt' wbuf $ fromIntegral off+    encodeInt' wbuf $ fromIntegral $ totalLen dats+    mapM_ (copyByteString wbuf) dats+encodeFrame wbuf (MaxData n) = do+    write8 wbuf 0x10+    encodeInt' wbuf $ fromIntegral n+encodeFrame wbuf (MaxStreamData sid n) = do+    write8 wbuf 0x11+    encodeInt' wbuf $ fromIntegral sid+    encodeInt' wbuf $ fromIntegral n+encodeFrame wbuf (MaxStreams dir ms) = do+    case dir of+      Bidirectional  -> write8 wbuf 0x12+      Unidirectional -> write8 wbuf 0x13+    encodeInt' wbuf $ fromIntegral ms+encodeFrame wbuf (DataBlocked n) = do+    write8 wbuf 0x14+    encodeInt' wbuf $ fromIntegral n+encodeFrame wbuf (StreamDataBlocked sid n) = do+    write8 wbuf 0x15+    encodeInt' wbuf $ fromIntegral sid+    encodeInt' wbuf $ fromIntegral n+encodeFrame wbuf (StreamsBlocked dir ms) = do+    case dir of+      Bidirectional  -> write8 wbuf 0x16+      Unidirectional -> write8 wbuf 0x17+    encodeInt' wbuf $ fromIntegral ms+encodeFrame wbuf (NewConnectionID cidInfo rpt) = do+    write8 wbuf 0x18+    encodeInt' wbuf $ fromIntegral $ cidInfoSeq cidInfo+    encodeInt' wbuf $ fromIntegral rpt+    let (cid, len) = unpackCID $ cidInfoCID cidInfo+    write8 wbuf len+    copyShortByteString wbuf cid+    let StatelessResetToken token = cidInfoSRT cidInfo+    copyShortByteString wbuf token+encodeFrame wbuf (RetireConnectionID seqNum) = do+    write8 wbuf 0x19+    encodeInt' wbuf $ fromIntegral seqNum+encodeFrame wbuf (PathChallenge (PathData pdata)) = do+    write8 wbuf 0x1a+    copyByteString wbuf $ Short.fromShort pdata+encodeFrame wbuf (PathResponse (PathData pdata)) = do+    write8 wbuf 0x1b+    copyByteString wbuf $ Short.fromShort pdata+encodeFrame wbuf (ConnectionClose (TransportError err) ftyp reason) = do+    write8 wbuf 0x1c+    encodeInt' wbuf $ fromIntegral err+    encodeInt' wbuf $ fromIntegral ftyp+    encodeInt' wbuf $ fromIntegral $ Short.length reason+    copyShortByteString wbuf reason+encodeFrame wbuf (ConnectionCloseApp (ApplicationProtocolError err) reason) = do+    write8 wbuf 0x1d+    encodeInt' wbuf $ fromIntegral err+    encodeInt' wbuf $ fromIntegral $ Short.length reason+    copyShortByteString wbuf reason+encodeFrame wbuf HandshakeDone =+    write8 wbuf 0x1e+encodeFrame wbuf (UnknownFrame typ) =+    write8 wbuf $ fromIntegral typ++----------------------------------------------------------------++decodeFrames :: Buffer -> BufferSize -> IO (Maybe [Frame])+decodeFrames buf bufsiz = do+    rbuf <- newReadBuffer buf bufsiz+    loop id rbuf+  where+    loop frames rbuf = do+        ok <- (>= 1) <$> remainingSize rbuf+        if ok then do+            frame <- decodeFrame rbuf+            case frame of+              UnknownFrame _ -> return Nothing+              _              -> loop (frames . (frame:)) rbuf+          else+            return $ Just $ frames []++decodeFrame :: ReadBuffer -> IO Frame+decodeFrame rbuf = do+    ftyp <- fromIntegral <$> decodeInt' rbuf+    case ftyp :: FrameType of+      0x00 -> decodePadding rbuf+      0x01 -> return Ping+      0x02 -> decodeAck rbuf+   -- 0x03 -> Ack with ECN Counts+      0x04 -> decodeResetStream rbuf+      0x05 -> decodeStopSending rbuf+      0x06 -> decodeCrypto rbuf+      0x07 -> decodeNewToken rbuf+      x | 0x08 <= x && x <= 0x0f -> do+              let off = testBit x 2+                  len = testBit x 1+                  fin = testBit x 0+              decodeStream rbuf off len fin+      0x10 -> decodeMaxData rbuf+      0x11 -> decodeMaxStreamData rbuf+      0x12 -> decodeMaxStreams rbuf Bidirectional+      0x13 -> decodeMaxStreams rbuf Unidirectional+      0x14 -> decodeDataBlocked rbuf+      0x15 -> decodeStreamDataBlocked rbuf+      0x16 -> decodeStreamsBlocked rbuf Bidirectional+      0x17 -> decodeStreamsBlocked rbuf Unidirectional+      0x18 -> decodeNewConnectionID rbuf+      0x19 -> decodeRetireConnectionID rbuf+      0x1a -> decodePathChallenge rbuf+      0x1b -> decodePathResponse rbuf+      0x1c -> decodeConnectionClose rbuf+      0x1d -> decodeConnectionCloseApp rbuf+      0x1e -> return HandshakeDone+      x    -> return $ UnknownFrame x++decodePadding :: ReadBuffer -> IO Frame+decodePadding rbuf = do+    n <- withCurrentOffSet rbuf $ \beg -> do+        rest <- remainingSize rbuf+        let end = beg `plusPtr` rest+        countZero beg end+    ff rbuf n+    return $ Padding (n + 1)++countZero :: Ptr Word8 -> Ptr Word8 -> IO Int+countZero beg0 end0+  | (end0 `minusPtr` beg0) <= ali = countBy1 beg0 end0 0+  | otherwise = do+    let beg1 = alignPtr beg0 ali+        end1' = alignPtr end0 ali+        end1 | end0 == end1' = end1'+             | otherwise     = end1' `plusPtr` negate ali+    n1        <- countBy1 beg0 beg1 0+    (n2,beg2) <- countBy8 (castPtr beg1) (castPtr end1) 0+    n3        <- countBy1 (castPtr beg2) end0 0+    return (n1 + n2 + n3)+  where+    ali = alignment (0 :: Word64)+    countBy1 :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int+    countBy1 beg end n+      | beg < end = do+            ftyp <- peek beg+            if ftyp == 0 then+                countBy1 (beg `plusPtr` 1) end (n + 1)+              else+                return n+      | otherwise = return n+    countBy8 :: Ptr Word64 -> Ptr Word64 -> Int -> IO (Int, Ptr Word64)+    countBy8 beg end n+      | beg < end = do+            ftyp <- peek beg+            if ftyp == 0 then+                countBy8 (beg `plusPtr` ali) end (n + ali)+              else+                return (n, beg)+      | otherwise = return (n, beg)++decodeCrypto :: ReadBuffer -> IO Frame+decodeCrypto rbuf = do+    off <- fromIntegral <$> decodeInt' rbuf+    len <- fromIntegral <$> decodeInt' rbuf+    cdata <- extractByteString rbuf len+    return $ CryptoF off cdata++decodeAck :: ReadBuffer -> IO Frame+decodeAck rbuf = do+    largest <- fromIntegral <$> decodeInt' rbuf+    delay   <- fromIntegral <$> decodeInt' rbuf+    count   <- fromIntegral <$> decodeInt' rbuf+    range1  <- fromIntegral <$> decodeInt' rbuf+    ranges  <- getRanges count id+    return $ Ack (AckInfo largest range1 ranges) $ Milliseconds delay+  where+    getRanges 0 build = return $ build []+    getRanges n build = do+        gap <- fromIntegral <$> decodeInt' rbuf+        rng <- fromIntegral <$> decodeInt' rbuf+        let n' = n - 1 :: Int+        getRanges n' (build . ((gap, rng) :))++decodeResetStream :: ReadBuffer -> IO Frame+decodeResetStream rbuf = do+    sID <- fromIntegral <$> decodeInt' rbuf+    err <- ApplicationProtocolError . fromIntegral <$> decodeInt' rbuf+    finalLen <- fromIntegral <$> decodeInt' rbuf+    return $ ResetStream sID err finalLen++decodeStopSending :: ReadBuffer -> IO Frame+decodeStopSending rbuf = do+    sID <- fromIntegral <$> decodeInt' rbuf+    err <- ApplicationProtocolError . fromIntegral <$> decodeInt' rbuf+    return $ StopSending sID err++decodeNewToken :: ReadBuffer -> IO Frame+decodeNewToken rbuf = do+    len <- fromIntegral <$> decodeInt' rbuf+    NewToken <$> extractByteString rbuf len++decodeStream :: ReadBuffer -> Bool -> Bool -> Bool -> IO Frame+decodeStream rbuf hasOff hasLen fin = do+    sID <- fromIntegral <$> decodeInt' rbuf+    off <- if hasOff then+             fromIntegral <$> decodeInt' rbuf+           else+             return 0+    dat <- if hasLen then do+             len <- fromIntegral <$> decodeInt' rbuf+             extractByteString rbuf len+           else do+             len <- remainingSize rbuf+             extractByteString rbuf len+    return $ StreamF sID off [dat] fin++----------------------------------------------------------------++decodeMaxData :: ReadBuffer -> IO Frame+decodeMaxData rbuf = MaxData . fromIntegral <$> decodeInt' rbuf++decodeMaxStreamData :: ReadBuffer -> IO Frame+decodeMaxStreamData rbuf = do+    sID <- fromIntegral <$> decodeInt' rbuf+    maxstrdata <- fromIntegral <$> decodeInt' rbuf+    return $ MaxStreamData sID maxstrdata++decodeMaxStreams :: ReadBuffer -> Direction -> IO Frame+decodeMaxStreams rbuf dir = MaxStreams dir . fromIntegral <$> decodeInt' rbuf++----------------------------------------------------------------++decodeDataBlocked :: ReadBuffer -> IO Frame+decodeDataBlocked rbuf = DataBlocked . fromIntegral <$> decodeInt' rbuf++decodeStreamDataBlocked :: ReadBuffer -> IO Frame+decodeStreamDataBlocked rbuf = do+    sID <- fromIntegral <$> decodeInt' rbuf+    msd <- fromIntegral <$> decodeInt' rbuf+    return $ StreamDataBlocked sID msd++decodeStreamsBlocked :: ReadBuffer -> Direction -> IO Frame+decodeStreamsBlocked rbuf dir = StreamsBlocked dir . fromIntegral <$> decodeInt' rbuf++----------------------------------------------------------------++decodeConnectionClose :: ReadBuffer -> IO Frame+decodeConnectionClose rbuf = do+    err    <- TransportError . fromIntegral <$> decodeInt' rbuf+    ftyp   <- fromIntegral <$> decodeInt' rbuf+    len    <- fromIntegral <$> decodeInt' rbuf+    reason <- extractShortByteString rbuf len+    return $ ConnectionClose err ftyp reason++decodeConnectionCloseApp  :: ReadBuffer -> IO Frame+decodeConnectionCloseApp rbuf = do+    err    <- ApplicationProtocolError . fromIntegral <$> decodeInt' rbuf+    len    <- fromIntegral <$> decodeInt' rbuf+    reason <- extractShortByteString rbuf len+    return $ ConnectionCloseApp err reason++decodeNewConnectionID :: ReadBuffer -> IO Frame+decodeNewConnectionID rbuf = do+    seqNum <- fromIntegral <$> decodeInt' rbuf+    rpt <- fromIntegral <$> decodeInt' rbuf+    cidLen <- fromIntegral <$> read8 rbuf+    cID <- makeCID <$> extractShortByteString rbuf cidLen+    token <- StatelessResetToken <$> extractShortByteString rbuf 16+    return $ NewConnectionID (CIDInfo seqNum cID token) rpt++decodeRetireConnectionID :: ReadBuffer -> IO Frame+decodeRetireConnectionID rbuf = do+    seqNum <- fromIntegral <$> decodeInt' rbuf+    return $ RetireConnectionID seqNum++decodePathChallenge :: ReadBuffer -> IO Frame+decodePathChallenge rbuf =+    PathChallenge . PathData <$> extractShortByteString rbuf 8++decodePathResponse :: ReadBuffer -> IO Frame+decodePathResponse rbuf =+    PathResponse . PathData <$> extractShortByteString rbuf 8
+ Network/QUIC/Packet/Header.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE BinaryLiterals #-}++module Network.QUIC.Packet.Header (+    isLong+  , isShort+  , 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++----------------------------------------------------------------++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 #-}+flagBits :: Word8 -> Word8+flagBits flags+  | isLong flags = 0b00001111 -- long header+  | otherwise    = 0b00011111 -- short header++----------------------------------------------------------------++randomizeQuicBit :: Word8 -> Bool -> IO Word8+randomizeQuicBit flags quicBit+  | quicBit = do+        r <- getRandomOneByte+        return ((flags .&. 0b10111111) .|. (r .&. 0b01000000))+  | otherwise = return flags++{-# INLINE encodeShortHeaderFlags #-}+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)++{-# INLINE encodeLongHeaderFlags #-}+encodeLongHeaderFlags :: LongHeaderPacketType -> Flags Raw -> Flags Raw -> Bool -> IO (Flags Raw)+encodeLongHeaderFlags typ (Flags fg) (Flags pp) quicBit =+    Flags <$> randomizeQuicBit flags quicBit+  where+    Flags tp = longHeaderPacketType typ+    flags =   tp+         .|. (fg .&. 0b00001100)+         .|. (pp .&. 0b00000011)++{-# INLINE longHeaderPacketType #-}+longHeaderPacketType :: LongHeaderPacketType -> Flags Raw+longHeaderPacketType InitialPacketType   = Flags 0b11000000+longHeaderPacketType RTT0PacketType      = Flags 0b11010000+longHeaderPacketType HandshakePacketType = Flags 0b11100000+longHeaderPacketType RetryPacketType     = Flags 0b11110000++retryPacketType :: IO (Flags Raw)+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 #-}+decodeLongHeaderPacketType :: Flags Protected -> LongHeaderPacketType+decodeLongHeaderPacketType (Flags flags) = case flags .&. 0b00110000 of+    0b00000000 -> InitialPacketType+    0b00010000 -> RTT0PacketType+    0b00100000 -> HandshakePacketType+    _          -> RetryPacketType++{-# 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
+ Network/QUIC/Packet/Number.hs view
@@ -0,0 +1,55 @@+module Network.QUIC.Packet.Number (+    encodePacketNumber+  , decodePacketNumber+  ) where++import Network.QUIC.Imports+import Network.QUIC.Types++----------------------------------------------------------------++-- |+--+-- >>> encodePacketNumber 0xabe8bc 0xac5c02 == (0x5c02,2)+-- True+-- >>> encodePacketNumber 0xa82f30ea 0xa82f9b32 == (0x9b32,2)+-- True+-- >>> encodePacketNumber 0xabe8bc 0xace8fe == (0xace8fe, 3)+-- True+encodePacketNumber :: PacketNumber -> PacketNumber -> (EncodedPacketNumber, Int)+encodePacketNumber largestPN pn = (diff, bytes)+  where+    enoughRange = (pn - largestPN) * 2+    (pnMask, bytes)+--      | enoughRange <      256 = (0x000000ff, 1)+      | enoughRange <    65536 = (0x0000ffff, 2)+      | enoughRange < 16777216 = (0x00ffffff, 3)+      | otherwise              = (0xffffffff, 4)+    diff = fromIntegral (pn .&. pnMask)++----------------------------------------------------------------++-- |+--+-- >>> decodePacketNumber 0xabe8bc 0x5c02 2 == 0xac5c02+-- True+-- >>> decodePacketNumber 0xa82f30ea 0x9b32 2 == 0xa82f9b32+-- True+-- >>> decodePacketNumber 0xabe8bc 0xace8fe 3 == 0xace8fe+-- True+decodePacketNumber :: PacketNumber -> EncodedPacketNumber -> Int -> PacketNumber+decodePacketNumber largestPN truncatedPN bytes+  | candidatePN <= expectedPN - pnHwin+ && candidatePN <  mx - pnWin          = candidatePN + pnWin+  | candidatePN >  expectedPN + pnHwin+ && candidatePN >= pnWin               = candidatePN - pnWin+  | otherwise                          = candidatePN+  where+    mx = 1 .<<. 62+    pnNbits = bytes * 8+    expectedPN = largestPN + 1+    pnWin = 1 .<<. pnNbits+    pnHwin = pnWin .>>. 1+    pnMask = pnWin - 1+    candidatePN = (expectedPN .&. complement pnMask)+              .|. fromIntegral truncatedPN
+ Network/QUIC/Packet/Token.hs view
@@ -0,0 +1,97 @@+module Network.QUIC.Packet.Token (+    CryptoToken(..)+  , isRetryToken+  , generateToken+  , generateRetryToken+  , encryptToken+  , decryptToken+  ) where++import qualified Crypto.Token as CT+import Data.UnixTime+import Foreign.C.Types+import Foreign.Ptr+import Foreign.Storable+import Network.ByteOrder++import Network.QUIC.Imports+import Network.QUIC.Types++----------------------------------------------------------------++data CryptoToken = CryptoToken {+    tokenQUICVersion :: Version+  , tokenCreatedTime :: TimeMicrosecond+  , tokenCIDs        :: Maybe (CID, CID, CID) -- local, remote, orig local+  }++isRetryToken :: CryptoToken -> Bool+isRetryToken token = isJust $ tokenCIDs token++----------------------------------------------------------------++generateToken :: Version -> IO CryptoToken+generateToken ver = do+    t <- getTimeMicrosecond+    return $ CryptoToken ver t Nothing++generateRetryToken :: Version -> CID -> CID -> CID -> IO CryptoToken+generateRetryToken ver l r o = do+    t <- getTimeMicrosecond+    return $ CryptoToken ver t $ Just (l,r,o)++----------------------------------------------------------------++encryptToken :: CT.TokenManager -> CryptoToken -> IO Token+encryptToken = CT.encryptToken++decryptToken :: CT.TokenManager -> Token -> IO (Maybe CryptoToken)+decryptToken = CT.decryptToken++----------------------------------------------------------------++cryptoTokenSize :: Int+cryptoTokenSize = 76 -- 4 + 8 + 1 + (1 + 20) * 3++-- length includes its field+instance Storable CryptoToken where+    sizeOf    ~_ = cryptoTokenSize+    alignment ~_ = 4+    peek ptr = do+        rbuf <- newReadBuffer (castPtr ptr) cryptoTokenSize+        ver  <- Version <$> read32 rbuf+        s <- CTime . fromIntegral <$> read64 rbuf+        let tim = UnixTime s 0+        typ <- read8 rbuf+        case typ of+          0 -> return $ CryptoToken ver tim Nothing+          _ -> do+              l <- pick rbuf+              r <- pick rbuf+              o <- pick rbuf+              return $ CryptoToken ver tim $ Just (l,r,o)+      where+        pick rbuf = do+            xlen0 <- fromIntegral <$> read8 rbuf+            let xlen = min xlen0 20+            x <- makeCID <$> extractShortByteString rbuf xlen+            ff rbuf (20 - xlen)+            return x+    poke ptr (CryptoToken (Version ver) tim mcids) = do+        wbuf <- newWriteBuffer (castPtr ptr) cryptoTokenSize+        write32 wbuf ver+        let CTime s = utSeconds tim+        write64 wbuf $ fromIntegral s+        case mcids of+          Nothing      -> write8 wbuf 0+          Just (l,r,o) -> do+              write8 wbuf 1+              bury wbuf l+              bury wbuf r+              bury wbuf o+      where+        bury wbuf x = do+            let (xcid, xlen) = unpackCID x+            write8 wbuf xlen+            copyShortByteString wbuf xcid+            ff wbuf (20 - fromIntegral xlen)
+ Network/QUIC/Parameters.hs view
@@ -0,0 +1,274 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternSynonyms #-}++module Network.QUIC.Parameters (+    Parameters(..)+  , defaultParameters+  , baseParameters -- only for Connection+  , encodeParameters+  , decodeParameters+  , AuthCIDs(..)+  , defaultAuthCIDs+  , setCIDsToParameters+  , getCIDsToParameters+  ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Short as Short+import System.IO.Unsafe (unsafeDupablePerformIO)++import Network.QUIC.Imports+import Network.QUIC.Types++encodeParameters :: Parameters -> ByteString+encodeParameters = encodeParameterList . toParameterList++decodeParameters :: ByteString -> Maybe Parameters+decodeParameters bs = fromParameterList <$> decodeParameterList bs++newtype Key = Key Word16 deriving (Eq, Show)+type Value = ByteString++type ParameterList = [(Key,Value)]++pattern OriginalDestinationConnectionId :: Key+pattern OriginalDestinationConnectionId  = Key 0x00+pattern MaxIdleTimeout                  :: Key+pattern MaxIdleTimeout                   = Key 0x01+pattern StateLessResetToken             :: Key+pattern StateLessResetToken              = Key 0x02+pattern MaxUdpPayloadSize               :: Key+pattern MaxUdpPayloadSize                = Key 0x03+pattern InitialMaxData                  :: Key+pattern InitialMaxData                   = Key 0x04+pattern InitialMaxStreamDataBidiLocal   :: Key+pattern InitialMaxStreamDataBidiLocal    = Key 0x05+pattern InitialMaxStreamDataBidiRemote  :: Key+pattern InitialMaxStreamDataBidiRemote   = Key 0x06+pattern InitialMaxStreamDataUni         :: Key+pattern InitialMaxStreamDataUni          = Key 0x07+pattern InitialMaxStreamsBidi           :: Key+pattern InitialMaxStreamsBidi            = Key 0x08+pattern InitialMaxStreamsUni            :: Key+pattern InitialMaxStreamsUni             = Key 0x09+pattern AckDelayExponent                :: Key+pattern AckDelayExponent                 = Key 0x0a+pattern MaxAckDelay                     :: Key+pattern MaxAckDelay                      = Key 0x0b+pattern DisableActiveMigration          :: Key+pattern DisableActiveMigration           = Key 0x0c+pattern PreferredAddress                :: Key+pattern PreferredAddress                 = Key 0x0d+pattern ActiveConnectionIdLimit         :: Key+pattern ActiveConnectionIdLimit          = Key 0x0e+pattern InitialSourceConnectionId       :: Key+pattern InitialSourceConnectionId        = Key 0x0f+pattern RetrySourceConnectionId         :: Key+pattern RetrySourceConnectionId          = Key 0x10+pattern Grease                          :: Key+pattern Grease                           = Key 0xff+pattern GreaseQuicBit                   :: Key+pattern GreaseQuicBit                    = Key 0x2ab2++-- | QUIC transport parameters.+data Parameters = Parameters {+    originalDestinationConnectionId :: Maybe CID+  , maxIdleTimeout                  :: Milliseconds+  , statelessResetToken             :: Maybe StatelessResetToken -- 16 bytes+  , maxUdpPayloadSize               :: Int+  , initialMaxData                  :: Int+  , initialMaxStreamDataBidiLocal   :: Int+  , initialMaxStreamDataBidiRemote  :: Int+  , initialMaxStreamDataUni         :: Int+  , initialMaxStreamsBidi           :: Int+  , initialMaxStreamsUni            :: Int+  , ackDelayExponent                :: Int+  , maxAckDelay                     :: Milliseconds+  , disableActiveMigration          :: Bool+  , preferredAddress                :: Maybe ByteString -- fixme+  , activeConnectionIdLimit         :: Int+  , initialSourceConnectionId       :: Maybe CID+  , retrySourceConnectionId         :: Maybe CID+  , grease                          :: Maybe ByteString+  , greaseQuicBit                   :: Bool+  } deriving (Eq,Show)++-- | The default value for QUIC transport parameters.+baseParameters :: Parameters+baseParameters = Parameters {+    originalDestinationConnectionId    = Nothing+  , maxIdleTimeout                     = Milliseconds 0 -- disabled+  , statelessResetToken                = Nothing+  , maxUdpPayloadSize                  = 65527+  , initialMaxData                     = 0+  , initialMaxStreamDataBidiLocal      = 0+  , initialMaxStreamDataBidiRemote     = 0+  , initialMaxStreamDataUni            = 0+  , initialMaxStreamsBidi              = 0+  , initialMaxStreamsUni               = 0+  , ackDelayExponent                   = 3+  , maxAckDelay                        = Milliseconds 25+  , disableActiveMigration             = False+  , preferredAddress                   = Nothing+  , activeConnectionIdLimit            = 2+  , initialSourceConnectionId          = Nothing+  , retrySourceConnectionId            = Nothing+  , grease                             = Nothing+  , greaseQuicBit                      = False+  }++decInt :: ByteString -> Int+decInt = fromIntegral . decodeInt++encInt :: Int -> ByteString+encInt = encodeInt . fromIntegral++decMilliseconds :: ByteString -> Milliseconds+decMilliseconds = Milliseconds . fromIntegral . decodeInt++encMilliseconds :: Milliseconds -> ByteString+encMilliseconds (Milliseconds n) = encodeInt $ fromIntegral n++fromParameterList :: ParameterList -> Parameters+fromParameterList kvs = foldl' update params kvs+  where+    params = baseParameters+    update x (OriginalDestinationConnectionId,v)+        = x { originalDestinationConnectionId = Just (toCID v) }+    update x (MaxIdleTimeout,v)+        = x { maxIdleTimeout = decMilliseconds v }+    update x (StateLessResetToken,v)+        = x { statelessResetToken = Just (StatelessResetToken $ Short.toShort v) }+    update x (MaxUdpPayloadSize,v)+        = x { maxUdpPayloadSize = decInt v }+    update x (InitialMaxData,v)+        = x { initialMaxData = decInt v }+    update x (InitialMaxStreamDataBidiLocal,v)+        = x { initialMaxStreamDataBidiLocal = decInt v }+    update x (InitialMaxStreamDataBidiRemote,v)+        = x { initialMaxStreamDataBidiRemote = decInt v }+    update x (InitialMaxStreamDataUni,v)+        = x { initialMaxStreamDataUni = decInt v }+    update x (InitialMaxStreamsBidi,v)+        = x { initialMaxStreamsBidi = decInt v }+    update x (InitialMaxStreamsUni,v)+        = x { initialMaxStreamsUni = decInt v }+    update x (AckDelayExponent,v)+        = x { ackDelayExponent = decInt v }+    update x (MaxAckDelay,v)+        = x { maxAckDelay = decMilliseconds v }+    update x (DisableActiveMigration,_)+        = x { disableActiveMigration = True }+    update x (PreferredAddress,v)+        = x { preferredAddress = Just v }+    update x (ActiveConnectionIdLimit,v)+        = x { activeConnectionIdLimit = decInt v }+    update x (InitialSourceConnectionId,v)+        = x { initialSourceConnectionId = Just (toCID v) }+    update x (RetrySourceConnectionId,v)+        = x { retrySourceConnectionId = Just (toCID v) }+    update x (Grease,v)+        = x { grease = Just v }+    update x (GreaseQuicBit,_)+        = x { greaseQuicBit = True }+    update x _ = x++diff :: Eq a => Parameters -> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key,Value)+diff params label key enc+  | val == val0 = Nothing+  | otherwise   = Just (key, enc val)+  where+    val = label params+    val0 = label baseParameters++toParameterList :: Parameters -> ParameterList+toParameterList p = catMaybes [+    diff p originalDestinationConnectionId+         OriginalDestinationConnectionId    (fromCID . fromJust)+  , diff p maxIdleTimeout          MaxIdleTimeout          encMilliseconds+  , diff p statelessResetToken     StateLessResetToken     encSRT+  , diff p maxUdpPayloadSize       MaxUdpPayloadSize       encInt+  , diff p initialMaxData          InitialMaxData          encInt+  , diff p initialMaxStreamDataBidiLocal  InitialMaxStreamDataBidiLocal  encInt+  , diff p initialMaxStreamDataBidiRemote InitialMaxStreamDataBidiRemote encInt+  , diff p initialMaxStreamDataUni InitialMaxStreamDataUni encInt+  , diff p initialMaxStreamsBidi   InitialMaxStreamsBidi   encInt+  , diff p initialMaxStreamsUni    InitialMaxStreamsUni    encInt+  , diff p ackDelayExponent        AckDelayExponent        encInt+  , diff p maxAckDelay             MaxAckDelay             encMilliseconds+  , diff p disableActiveMigration  DisableActiveMigration  (const "")+  , diff p preferredAddress        PreferredAddress        fromJust+  , diff p activeConnectionIdLimit ActiveConnectionIdLimit encInt+  , diff p initialSourceConnectionId+         InitialSourceConnectionId    (fromCID . fromJust)+  , diff p retrySourceConnectionId+         RetrySourceConnectionId      (fromCID . fromJust)+  , diff p greaseQuicBit           GreaseQuicBit           (const "")+  , diff p grease                  Grease                  fromJust+  ]++encSRT :: Maybe StatelessResetToken -> ByteString+encSRT (Just (StatelessResetToken srt)) = Short.fromShort srt+encSRT _ = error "encSRT"++encodeParameterList :: ParameterList -> ByteString+encodeParameterList kvs = unsafeDupablePerformIO $+    withWriteBuffer 4096 $ \wbuf -> do -- for grease+        mapM_ (put wbuf) kvs+  where+    put wbuf (Key k,v) = do+        encodeInt' wbuf $ fromIntegral k+        encodeInt' wbuf $ fromIntegral $ BS.length v+        copyByteString wbuf v++decodeParameterList :: ByteString -> Maybe ParameterList+decodeParameterList bs = unsafeDupablePerformIO $ withReadBuffer bs (`go` id)+  where+    go rbuf build = do+       rest1 <- remainingSize rbuf+       if rest1 == 0 then+          return $ Just (build [])+       else do+          key <- fromIntegral <$> decodeInt' rbuf+          len <- fromIntegral <$> decodeInt' rbuf+          val <- extractByteString rbuf len+          go rbuf (build . ((Key key,val):))++-- | An example parameters obsoleted in the near future.+defaultParameters :: Parameters+defaultParameters = baseParameters {+    maxIdleTimeout                 = microToMilli idleTimeout -- 30000+  , maxUdpPayloadSize              = maximumUdpPayloadSize -- 2048+  , initialMaxData                 = 1048576+  , initialMaxStreamDataBidiLocal  =  262144+  , initialMaxStreamDataBidiRemote =  262144+  , initialMaxStreamDataUni        =  262144+  , initialMaxStreamsBidi          =     100+  , initialMaxStreamsUni           =       3+  , activeConnectionIdLimit        =       3+  , greaseQuicBit                  = True+  }++data AuthCIDs = AuthCIDs {+    initSrcCID  :: Maybe CID+  , origDstCID  :: Maybe CID+  , retrySrcCID :: Maybe CID+  } deriving (Eq, Show)++defaultAuthCIDs :: AuthCIDs+defaultAuthCIDs = AuthCIDs Nothing Nothing Nothing++setCIDsToParameters :: AuthCIDs -> Parameters -> Parameters+setCIDsToParameters AuthCIDs{..} params = params {+    originalDestinationConnectionId = origDstCID+  , initialSourceConnectionId       = initSrcCID+  , retrySourceConnectionId         = retrySrcCID+  }++getCIDsToParameters :: Parameters -> AuthCIDs+getCIDsToParameters Parameters{..} = AuthCIDs {+    origDstCID  = originalDestinationConnectionId+  , initSrcCID  = initialSourceConnectionId+  , retrySrcCID = retrySourceConnectionId+  }
+ Network/QUIC/QLogger.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.QLogger (+    QLogger+  , dirQLogger+  ) where++import System.FilePath+import System.Log.FastLogger++import Network.QUIC.Imports+import Network.QUIC.Qlog+import Network.QUIC.Types++dirQLogger :: Maybe FilePath -> TimeMicrosecond -> CID -> ByteString -> IO (QLogger, IO ())+dirQLogger Nothing _ _ _ = do+    let qLog ~_ = return ()+        clean = return ()+    return (qLog, clean)+dirQLogger (Just dir) tim cid rl = do+    let file = dir </> (show cid <> ".qlog")+    (fastlogger, clean) <- newFastLogger1 $ LogFileNoRotate file 4096+    qlogger <- newQlogger tim rl cid fastlogger+    return (qlogger, clean)
+ Network/QUIC/Qlog.hs view
@@ -0,0 +1,278 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Qlog (+    QLogger+  , newQlogger+  , Qlog(..)+  , KeepQlog(..)+  , QlogMsg(..)+  , qlogReceived+  , qlogDropped+  , qlogRecvInitial+  , qlogSentRetry+  , qlogParamsSet+  , qlogDebug+  , qlogCIDUpdate+  , Debug(..)+  , LR(..)+  , packetType+  , sw+  ) where++import qualified Data.ByteString as BS++import qualified Data.ByteString.Short as Short+import Data.List (intersperse)+import System.Log.FastLogger++import Network.QUIC.Imports+import Network.QUIC.Parameters+import Network.QUIC.Types++class Qlog a where+    qlog :: a -> LogStr++newtype Debug = Debug LogStr+data LR = Local CID | Remote CID++instance Show Debug where+    show (Debug msg) = show msg++instance Qlog Debug where+    qlog (Debug msg) = "{\"message\":\"" <> msg <> "\"}"++instance Qlog LR where+    qlog (Local  cid) = "{\"owner\":\"local\",\"new\":\"" <> sw cid <> "\"}"+    qlog (Remote cid) = "{\"owner\":\"remote\",\"new\":\"" <> sw cid <> "\"}"++instance Qlog RetryPacket where+    qlog RetryPacket{} = "{\"header\":{\"packet_type\":\"retry\",\"packet_number\":\"\"}}"++instance Qlog VersionNegotiationPacket where+    qlog VersionNegotiationPacket{} = "{\"header\":{\"packet_type\":\"version_negotiation\",\"packet_number\":\"\"}}"++instance Qlog Header where+    qlog hdr = "{\"header\":{\"packet_type\":\"" <> packetType hdr <> "\"}}"++instance Qlog CryptPacket where+    qlog (CryptPacket hdr _) = qlog hdr++instance Qlog PlainPacket where+    qlog (PlainPacket hdr Plain{..}) = "{\"header\":{\"packet_type\":\"" <> toLogStr (packetType hdr) <> "\",\"packet_number\":\"" <> sw plainPacketNumber <> "\",\"dcid\":\"" <> sw (headerMyCID hdr) <> "\"},\"frames\":[" <> foldr (<>) "" (intersperse "," (map qlog plainFrames)) <> "]}"++instance Qlog StatelessReset where+    qlog StatelessReset = "{\"header\":{\"packet_type\":\"stateless_reset\",\"packet_number\":\"\"}}"++packetType :: Header -> LogStr+packetType Initial{}   = "initial"+packetType RTT0{}      = "0RTT"+packetType Handshake{} = "handshake"+packetType Short{}     = "1RTT"++instance Qlog Frame where+    qlog frame = "{\"frame_type\":\"" <> frameType frame <> "\"" <> frameExtra frame <> "}"++frameType :: Frame -> LogStr+frameType Padding{}             = "padding"+frameType Ping                  = "ping"+frameType Ack{}                 = "ack"+frameType ResetStream{}         = "reset_stream"+frameType StopSending{}         = "stop_sending"+frameType CryptoF{}             = "crypto"+frameType NewToken{}            = "new_token"+frameType StreamF{}             = "stream"+frameType MaxData{}             = "max_data"+frameType MaxStreamData{}       = "max_stream_data"+frameType MaxStreams{}          = "max_streams"+frameType DataBlocked{}         = "data_blocked"+frameType StreamDataBlocked{}   = "stream_data_blocked"+frameType StreamsBlocked{}      = "streams_blocked"+frameType NewConnectionID{}     = "new_connection_id"+frameType RetireConnectionID{}  = "retire_connection_id"+frameType PathChallenge{}       = "path_challenge"+frameType PathResponse{}        = "path_response"+frameType ConnectionClose{}     = "connection_close"+frameType ConnectionCloseApp{}  = "connection_close"+frameType HandshakeDone{}       = "handshake_done"+frameType UnknownFrame{}        = "unknown"++{-# INLINE frameExtra #-}+frameExtra :: Frame -> LogStr+frameExtra (Padding n) = ",\"payload_length\":" <> sw n+frameExtra  Ping = ""+frameExtra (Ack ai _Delay) = ",\"acked_ranges\":" <> ack ai+frameExtra ResetStream{} = ""+frameExtra (StopSending _StreamId _ApplicationError) = ""+frameExtra (CryptoF off dat) =  ",\"offset\":\"" <> sw off <> "\",\"length\":" <> sw (BS.length dat)+frameExtra (NewToken _Token) = ""+frameExtra (StreamF sid off dat fin) = ",\"stream_id\":\"" <> sw sid <> "\",\"offset\":\"" <> sw off <> "\",\"length\":" <> sw (sum' $ map BS.length dat) <> ",\"fin\":" <> if fin then "true" else "false"+frameExtra (MaxData mx) = ",\"maximum\":\"" <> sw mx <> "\""+frameExtra (MaxStreamData sid mx) = ",\"stream_id\":\"" <> sw sid <> "\",\"maximum\":\"" <> sw mx <> "\""+frameExtra (MaxStreams _Direction ms) = ",\"maximum\":\"" <> sw ms <> "\""+frameExtra DataBlocked{} = ""+frameExtra StreamDataBlocked{} = ""+frameExtra StreamsBlocked{} = ""+frameExtra (NewConnectionID (CIDInfo sn cid _) rpt) = ",\"sequence_number\":\"" <> sw sn <> "\",\"connection_id:\":\"" <> sw cid <> "\",\"retire_prior_to\":\"" <> sw rpt <> "\""+frameExtra (RetireConnectionID sn) = ",\"sequence_number\":\"" <> sw sn <> "\""+frameExtra (PathChallenge _PathData) = ""+frameExtra (PathResponse _PathData) = ""+frameExtra (ConnectionClose err _FrameType reason) = ",\"error_space\":\"transport\",\"error_code\":\"" <> transportError err <> "\",\"raw_error_code\":" <> transportError' err <> ",\"reason\":\"" <> toLogStr (Short.fromShort reason) <> "\""+frameExtra (ConnectionCloseApp err reason) =  ",\"error_space\":\"application\",\"error_code\":" <> applicationProtoclError err <> ",\"reason\":\"" <> toLogStr (Short.fromShort reason) <> "\"" -- fixme+frameExtra HandshakeDone{} = ""+frameExtra (UnknownFrame _Int) = ""++transportError :: TransportError -> LogStr+transportError NoError                 = "no_error"+transportError InternalError           = "internal_error"+transportError ConnectionRefused       = "connection_refused"+transportError FlowControlError        = "flow_control_error"+transportError StreamLimitError        = "stream_limit_error"+transportError StreamStateError        = "stream_state_error"+transportError FinalSizeError          = "final_size_error"+transportError FrameEncodingError      = "frame_encoding_error"+transportError TransportParameterError = "transport_parameter_err"+transportError ConnectionIdLimitError  = "connection_id_limit_error"+transportError ProtocolViolation       = "protocol_violation"+transportError InvalidToken            = "invalid_migration"+transportError CryptoBufferExceeded    = "crypto_buffer_exceeded"+transportError KeyUpdateError          = "key_update_error"+transportError AeadLimitReached        = "aead_limit_reached"+transportError NoViablePath            = "no_viablpath"+transportError (TransportError n)      = sw n++transportError' :: TransportError -> LogStr+transportError' (TransportError n)     = sw n++applicationProtoclError :: ApplicationProtocolError -> LogStr+applicationProtoclError (ApplicationProtocolError n) = sw n++{-# INLINE ack #-}+ack :: AckInfo -> LogStr+ack (AckInfo lpn r rs) = "[" <> ack1 fr fpn rs <> "]"+  where+    fpn = fromIntegral lpn - r+    fr | r == 0    = "[" <> sw lpn <> "]"+       | otherwise = "[" <> sw fpn <> "," <> sw lpn <> "]"++ack1 :: LogStr -> Range -> [(Gap, Range)] -> LogStr+ack1 ret _ []   = ret+ack1 ret fpn ((g,r):grs) = ack1 ret' f grs+  where+    ret' = "[" <> sw f <> "," <> sw l <> "]," <> ret+    l = fpn - g - 2+    f = l - r++----------------------------------------------------------------++instance Qlog (Parameters,String) where+    qlog (Parameters{..},owner) =+               "{\"owner\":\"" <> toLogStr owner+          <> "\",\"initial_max_data\":\"" <> sw initialMaxData+          <> "\",\"initial_max_stream_data_bidi_local\":\"" <> sw initialMaxStreamDataBidiLocal+          <> "\",\"initial_max_stream_data_bidi_remote\":\"" <> sw initialMaxStreamDataBidiRemote+          <> "\",\"initial_max_stream_data_uni\":\"" <> sw initialMaxStreamDataUni+          <> "\"}"++----------------------------------------------------------------++data QlogMsg = QRecvInitial+             | QSentRetry+             | QSent LogStr TimeMicrosecond+             | QReceived LogStr TimeMicrosecond+             | QDropped LogStr TimeMicrosecond+             | QMetricsUpdated LogStr TimeMicrosecond+             | QPacketLost LogStr TimeMicrosecond+             | QCongestionStateUpdated LogStr TimeMicrosecond+             | QLossTimerUpdated LogStr TimeMicrosecond+             | QDebug LogStr TimeMicrosecond+             | QParamsSet LogStr TimeMicrosecond+             | QCIDUpdate LogStr TimeMicrosecond++{-# INLINE toLogStrTime #-}+toLogStrTime :: QlogMsg -> TimeMicrosecond -> LogStr+toLogStrTime QRecvInitial _ =+    "{\"time\":0,\"name\":\"transport:packet_received\",\"data\":{\"header\":{\"packet_type\":\"initial\",\"packet_number\":\"\"}}}\n"+toLogStrTime QSentRetry _ =+    "{\"time\":0,\"name\":\"transport:packet_sent\",\"data\":{\"header\":{\"packet_type\":\"retry\",\"packet_number\":\"\"}}}\n"+toLogStrTime (QReceived msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"transport:packet_received\",\"data\":" <> msg <> "}\n"+toLogStrTime (QSent msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"transport:packet_sent\",\"data\":"     <> msg <> "}\n"+toLogStrTime (QDropped msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"transport:packet_dropped\",\"data\":"  <> msg <> "}\n"+toLogStrTime (QParamsSet msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"transport:parameters_set\",\"data\":"  <> msg <> "}\n"+toLogStrTime (QMetricsUpdated msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"recovery:metrics_updated\",\"data\":"  <> msg <> "}\n"+toLogStrTime (QPacketLost msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"recovery:packet_lost\",\"data\":"      <> msg <> "}\n"+toLogStrTime (QCongestionStateUpdated msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"recovery:congestion_state_updated\",\"data\":" <> msg <> "}\n"+toLogStrTime (QLossTimerUpdated msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"recovery:loss_timer_updated\",\"data\":" <> msg <> "}\n"+toLogStrTime (QDebug msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"debug\",\"data\":" <> msg <> "}\n"+toLogStrTime (QCIDUpdate msg tim) base =+    "{\"time\":" <> swtim tim base <> ",\"name\":\"connectivity:connection_id_updated\",\"data\":" <> msg <> "}\n"++----------------------------------------------------------------++{-# INLINE sw #-}+sw :: Show a => a -> LogStr+sw = toLogStr . show++{-# INLINE swtim #-}+swtim :: TimeMicrosecond -> TimeMicrosecond -> LogStr+swtim tim base = toLogStr (show m ++ "." ++ show u)+  where+    Microseconds x = elapsedTimeMicrosecond tim base+    (m,u) = x `divMod` 1000++----------------------------------------------------------------++type QLogger = QlogMsg -> IO ()++newQlogger :: TimeMicrosecond -> ByteString -> CID -> FastLogger -> IO QLogger+newQlogger base rl ocid fastLogger = do+    let ocid' = toLogStr $ enc16 $ fromCID ocid+    fastLogger $ "{\"qlog_format\":\"NDJSON\",\"qlog_version\":\"draft-02\",\"title\":\"Haskell quic qlog\",\"trace\":{\"vantage_point\":{\"type\":\"" <> toLogStr rl <> "\"},\"common_fields\":{\"ODCID\":\"" <> ocid' <> "\",\"group_id\":\"" <> ocid' <> "\",\"reference_time\":" <> swtim base timeMicrosecond0 <>  "}}}\n"+    let qlogger qmsg = do+            let msg = toLogStrTime qmsg base+            fastLogger msg+    return qlogger++----------------------------------------------------------------++class KeepQlog a where+    keepQlog :: a -> QLogger++qlogReceived :: (KeepQlog q, Qlog a) => q -> a -> TimeMicrosecond -> IO ()+qlogReceived q pkt tim = keepQlog q $ QReceived (qlog pkt) tim++qlogDropped :: (KeepQlog q, Qlog a) => q -> a -> IO ()+qlogDropped q pkt = do+    tim <- getTimeMicrosecond+    keepQlog q $ QDropped (qlog pkt) tim++qlogRecvInitial :: KeepQlog q => q -> IO ()+qlogRecvInitial q = keepQlog q QRecvInitial++qlogSentRetry :: KeepQlog q => q -> IO ()+qlogSentRetry q = keepQlog q QSentRetry++qlogParamsSet :: KeepQlog q => q -> (Parameters,String) -> IO ()+qlogParamsSet q params = do+    tim <- getTimeMicrosecond+    keepQlog q $ QParamsSet (qlog params) tim++qlogDebug :: KeepQlog q => q -> Debug -> IO ()+qlogDebug q msg = do+    tim <- getTimeMicrosecond+    keepQlog q $ QDebug (qlog msg) tim++qlogCIDUpdate :: KeepQlog q => q -> LR -> IO ()+qlogCIDUpdate q lr = do+    tim <- getTimeMicrosecond+    keepQlog q $ QCIDUpdate (qlog lr) tim
+ Network/QUIC/Receiver.hs view
@@ -0,0 +1,367 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Receiver (+    receiver+  ) where++import qualified Data.ByteString as BS+import Foreign.Marshal.Alloc+import Network.TLS (AlertDescription(..))+import qualified UnliftIO.Exception as E++import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Exception+import Network.QUIC.Imports+import Network.QUIC.Logger+import Network.QUIC.Packet+import Network.QUIC.Parameters+import Network.QUIC.Qlog+import Network.QUIC.Recovery+import Network.QUIC.Stream+import Network.QUIC.Types++receiver :: Connection -> Receive -> IO ()+receiver conn recv = handleLogT logAction $+    E.bracket (mallocBytes maximumUdpPayloadSize)+              free+              body+  where+    body buf = do+        loopHandshake buf+        loopEstablished buf+    recvTimeout = do+        -- The spec says that CC is not sent when timeout.+        -- But we intentionally sends CC when timeout.+        ito <- readMinIdleTimeout conn+        mx <- timeout ito recv -- fixme: taking minimum with peer's one+        case mx of+          Nothing -> E.throwIO ConnectionIsTimeout+          Just x  -> return x+    loopHandshake buf = do+        rpkt <- recvTimeout+        processReceivedPacketHandshake conn buf rpkt+        established <- isConnectionEstablished conn+        unless established $ loopHandshake buf+    loopEstablished buf = forever $ do+        rpkt <- recvTimeout+        let CryptPacket hdr _ = rpCryptPacket rpkt+            cid = headerMyCID hdr+        included <- myCIDsInclude conn cid+        case included of+          Just nseq -> do+            shouldUpdate <- shouldUpdateMyCID conn nseq+            when shouldUpdate $ do+                setMyCID conn cid+                cidInfo <- getNewMyCID conn+                when (isServer conn) $ do+                    register <- getRegister conn+                    register (cidInfoCID cidInfo) conn+                sendFrames conn RTT1Level [NewConnectionID cidInfo 0]+            processReceivedPacket conn buf rpkt+            shouldUpdatePeer <- if shouldUpdate then shouldUpdatePeerCID conn+                                                else return False+            when shouldUpdatePeer $ choosePeerCIDForPrivacy conn+          _ -> do+            qlogDropped conn hdr+            connDebugLog conn $ bhow cid <> " is unknown"+    logAction msg = connDebugLog conn ("debug: receiver: " <> msg)++processReceivedPacketHandshake :: Connection -> Buffer -> ReceivedPacket -> IO ()+processReceivedPacketHandshake conn buf rpkt = do+    let CryptPacket hdr _ = rpCryptPacket rpkt+        lvl = rpEncryptionLevel rpkt+    mx <- timeout (Microseconds 10000) $ waitEncryptionLevel conn lvl+    case mx of+      Nothing -> do+          putOffCrypto conn lvl rpkt+          when (isClient conn) $ do+              lvl' <- getEncryptionLevel conn+              speedup (connLDCC conn) lvl' "not decryptable"+      Just ()+        | isClient conn -> do+              when (lvl == InitialLevel) $ do+                  peercid <- getPeerCID conn+                  let newPeerCID = headerPeerCID hdr+                  when (peercid /= headerPeerCID hdr) $+                      resetPeerCID conn newPeerCID+                  setPeerAuthCIDs conn $ \auth ->+                      auth { initSrcCID = Just newPeerCID }+              processReceivedPacket conn buf rpkt+        | otherwise -> do+              mycid <- getMyCID conn+              when (lvl == HandshakeLevel+                    || (lvl == InitialLevel && mycid == headerMyCID hdr)) $ do+                  setAddressValidated conn+              when (lvl == HandshakeLevel) $ do+                  let ldcc = connLDCC conn+                  discarded <- getAndSetPacketNumberSpaceDiscarded ldcc InitialLevel+                  unless discarded $ do+                      dropSecrets conn InitialLevel+                      clearCryptoStream conn InitialLevel+                      onPacketNumberSpaceDiscarded ldcc InitialLevel+              processReceivedPacket conn buf rpkt++processReceivedPacket :: Connection -> Buffer -> ReceivedPacket -> IO ()+processReceivedPacket conn buf rpkt = do+    let CryptPacket hdr crypt = rpCryptPacket rpkt+        lvl = rpEncryptionLevel rpkt+        tim = rpTimeRecevied rpkt+        bufsiz = maximumUdpPayloadSize+    mplain <- decryptCrypt conn buf bufsiz crypt lvl+    case mplain of+      Just plain@Plain{..} -> do+          when (isIllegalReservedBits plainMarks || isNoFrames plainMarks) $+              closeConnection ProtocolViolation "Non 0 RR bits or no frames"+          when (isUnknownFrame plainMarks) $+              closeConnection FrameEncodingError "Unknown frame"+          -- For Ping, record PPN first, then send an ACK.+          onPacketReceived (connLDCC conn) lvl plainPacketNumber+          when (lvl == RTT1Level) $ setPeerPacketNumber conn plainPacketNumber+          unless (isCryptLogged crypt) $+              qlogReceived conn (PlainPacket hdr plain) tim+          let ackEli   = any ackEliciting   plainFrames+              shouldDrop = rpReceivedBytes rpkt < defaultQUICPacketSize+                        && lvl == InitialLevel && ackEli+          if shouldDrop then do+              connDebugLog conn ("debug: drop packet whose size is " <> bhow (rpReceivedBytes rpkt))+              qlogDropped conn hdr+            else do+              (ckp,cpn) <- getCurrentKeyPhase conn+              let Flags flags = plainFlags+                  nkp = flags `testBit` 2+              when (nkp /= ckp && plainPacketNumber > cpn) $ do+                  setCurrentKeyPhase conn nkp plainPacketNumber+                  updateCoder1RTT conn ckp -- ckp is now next+              mapM_ (processFrame conn lvl) plainFrames+              when ackEli $ do+                  case lvl of+                    RTT0Level -> return ()+                    RTT1Level -> delayedAck conn+                    _         -> do+                        sup <- getSpeedingUp (connLDCC conn)+                        when sup $ do+                            qlogDebug conn $ Debug "ping for speedup"+                            sendFrames conn lvl [Ping]+      Nothing -> do+          statelessReset <- isStatelessReset conn hdr crypt+          if statelessReset then do+              qlogReceived conn StatelessReset tim+              connDebugLog conn "debug: connection is reset statelessly"+              E.throwIO ConnectionIsReset+            else do+              qlogDropped conn hdr+              connDebugLog conn $ "debug: cannot decrypt: " <> bhow lvl <> " size = " <> bhow (BS.length $ cryptPacket crypt)+              -- fixme: sending statelss reset++isSendOnly :: Connection -> StreamId -> Bool+isSendOnly conn sid+  | isClient conn = isClientInitiatedUnidirectional sid+  | otherwise     = isServerInitiatedUnidirectional sid++isReceiveOnly :: Connection -> StreamId -> Bool+isReceiveOnly conn sid+  | isClient conn = isServerInitiatedUnidirectional sid+  | otherwise     = isClientInitiatedUnidirectional sid++isInitiated :: Connection -> StreamId -> Bool+isInitiated conn sid+  | isClient conn = isClientInitiated sid+  | otherwise     = isServerInitiated sid++guardStream :: Connection -> StreamId -> Maybe Stream -> IO ()+guardStream conn sid Nothing+  | isInitiated conn sid = do+        curSid <- getMyStreamId conn+        when (sid > curSid) $+            closeConnection StreamStateError "a locally-initiated stream that has not yet been created"+guardStream _ _ _ = return ()++processFrame :: Connection -> EncryptionLevel -> Frame -> IO ()+processFrame _ _ Padding{} = return ()+processFrame conn lvl Ping = do+    -- see ackEli above+    when (lvl /= RTT1Level) $ sendFrames conn lvl []+processFrame conn lvl (Ack ackInfo ackDelay) = do+    when (lvl == RTT0Level) $ closeConnection ProtocolViolation "ACK"+    onAckReceived (connLDCC conn) lvl ackInfo $ milliToMicro ackDelay+processFrame conn lvl (ResetStream sid aerr _finlen) = do+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection ProtocolViolation "RESET_STREAM"+    when (isSendOnly conn sid) $+        closeConnection StreamStateError "Received in a send-only stream"+    mstrm <- findStream conn sid+    case mstrm of+      Nothing   -> return ()+      Just strm -> do+          onResetStreamReceived (connHooks conn) strm aerr+          setTxStreamClosed strm+          setRxStreamClosed strm+          delStream conn strm+processFrame conn lvl (StopSending sid err) = do+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection ProtocolViolation "STOP_SENDING"+    when (isReceiveOnly conn sid) $+        closeConnection StreamStateError "Receive-only stream"+    mstrm <- findStream conn sid+    case mstrm of+      Nothing   -> do+          when (isInitiated conn sid) $+              closeConnection StreamStateError "No such stream for STOP_SENDING"+      Just _strm -> sendFrames conn lvl [ResetStream sid err 0]+processFrame _ _ (CryptoF _ "") = return ()+processFrame conn lvl (CryptoF off cdat) = do+    when (lvl == RTT0Level) $+        closeConnection ProtocolViolation "CRYPTO in 0-RTT"+    let len = BS.length cdat+        rx = RxStreamData cdat off len False+    case lvl of+      InitialLevel   -> do+          dup <- putRxCrypto conn lvl rx+          when dup $ speedup (connLDCC conn) lvl "duplicated"+      RTT0Level -> do+          connDebugLog conn $ "processFrame: invalid packet type " <> bhow lvl+      HandshakeLevel -> do+          dup <- putRxCrypto conn lvl rx+          when dup $ speedup (connLDCC conn) lvl "duplicated"+      RTT1Level+        | isClient conn ->+              void $ putRxCrypto conn lvl rx+        | otherwise ->+              closeConnection (cryptoError UnexpectedMessage) "CRYPTO in 1-RTT"+processFrame conn lvl (NewToken token) = do+    when (isServer conn || lvl /= RTT1Level) $+        closeConnection ProtocolViolation "NEW_TOKEN for server or in 1-RTT"+    when (isClient conn) $ setNewToken conn token+processFrame conn RTT0Level (StreamF sid off (dat:_) fin) = do+    when (isSendOnly conn sid) $+        closeConnection StreamStateError "send-only stream"+    mstrm <- findStream conn sid+    guardStream conn sid mstrm+    strm <- maybe (createStream conn sid) return mstrm+    let len = BS.length dat+        rx = RxStreamData dat off len fin+    ok <- putRxStreamData strm rx+    unless ok $ closeConnection FlowControlError "Flow control error in 0-RTT"+processFrame conn RTT1Level (StreamF sid _ [""] False) = do+    when (isSendOnly conn sid) $+        closeConnection StreamStateError "send-only stream"+    mstrm <- findStream conn sid+    guardStream conn sid mstrm+processFrame conn RTT1Level (StreamF sid off (dat:_) fin) = do+    when (isSendOnly conn sid) $+        closeConnection StreamStateError "send-only stream"+    mstrm <- findStream conn sid+    guardStream conn sid mstrm+    strm <- maybe (createStream conn sid) return mstrm+    let len = BS.length dat+        rx = RxStreamData dat off len fin+    ok <- putRxStreamData strm rx+    unless ok $ closeConnection FlowControlError "Flow control error in 1-RTT"+processFrame conn lvl (MaxData n) = do+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection ProtocolViolation "MAX_DATA in Initial or Handshake"+    setTxMaxData conn n+processFrame conn lvl (MaxStreamData sid n) = do+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection ProtocolViolation "MAX_STREAM_DATA in Initial or Handshake"+    when (isReceiveOnly conn sid) $+        closeConnection StreamStateError "Receive-only stream"+    mstrm <- findStream conn sid+    case mstrm of+      Nothing   -> do+          when (isInitiated conn sid) $+              closeConnection StreamStateError "No such stream for MAX_STREAM_DATA"+      Just strm -> setTxMaxStreamData strm n+processFrame conn lvl (MaxStreams dir n) = do+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection ProtocolViolation "MAX_STREAMS in Initial or Handshake"+    when (n > 2^(60 :: Int)) $+        closeConnection FrameEncodingError "Too large MAX_STREAMS"+    if dir == Bidirectional then+        setMyMaxStreams conn n+      else+        setMyUniMaxStreams conn n+processFrame _conn _lvl DataBlocked{} = return ()+processFrame _conn _lvl (StreamDataBlocked _sid _) = return ()+processFrame _conn lvl (StreamsBlocked _dir n) = do+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection ProtocolViolation "STREAMS_BLOCKED in Initial or Handshake"+    when (n > 2^(60 :: Int)) $+        closeConnection FrameEncodingError "Too large STREAMS_BLOCKED"+processFrame conn lvl (NewConnectionID cidInfo rpt) = do+    when (lvl == InitialLevel || lvl == HandshakeLevel) $+        closeConnection ProtocolViolation "NEW_CONNECTION_ID in Initial or Handshake"+    addPeerCID conn cidInfo+    let (_, cidlen) = unpackCID $ cidInfoCID cidInfo+    when (cidlen < 1 || 20 < cidlen || rpt > cidInfoSeq cidInfo) $+        closeConnection FrameEncodingError "NEW_CONNECTION_ID parameter error"+    when (rpt >= 1) $ do+        seqNums <- setPeerCIDAndRetireCIDs conn rpt+        sendFrames conn RTT1Level $ map RetireConnectionID seqNums+processFrame conn RTT1Level (RetireConnectionID sn) = do+    mcidInfo <- retireMyCID conn sn+    case mcidInfo of+      Nothing -> return ()+      Just (CIDInfo _ cid _) -> do+          when (isServer conn) $ do+              unregister <- getUnregister conn+              unregister cid+processFrame conn RTT1Level (PathChallenge dat) =+    sendFrames conn RTT1Level [PathResponse dat]+processFrame conn RTT1Level (PathResponse dat) =+    -- RTT0Level falls intentionally+    checkResponse conn dat+processFrame conn _lvl (ConnectionClose NoError _ftyp _reason) =+    when (isServer conn) $ E.throwIO ConnectionIsClosed+processFrame _conn _lvl (ConnectionClose err _ftyp reason) = do+    let quicexc = TransportErrorIsReceived err reason+    E.throwIO quicexc+processFrame _conn _lvl (ConnectionCloseApp err reason) = do+    let quicexc = ApplicationProtocolErrorIsReceived err reason+    E.throwIO quicexc+processFrame conn lvl HandshakeDone = do+    when (isServer conn || lvl /= RTT1Level) $+        closeConnection ProtocolViolation "HANDSHAKE_DONE for server"+    fire conn (Microseconds 100000) $ do+        let ldcc = connLDCC conn+        discarded0 <- getAndSetPacketNumberSpaceDiscarded ldcc RTT0Level+        unless discarded0 $ dropSecrets conn RTT0Level+        discarded1 <- getAndSetPacketNumberSpaceDiscarded ldcc HandshakeLevel+        unless discarded1 $ do+            dropSecrets conn HandshakeLevel+            onPacketNumberSpaceDiscarded ldcc HandshakeLevel+        clearCryptoStream conn HandshakeLevel+        clearCryptoStream conn RTT1Level+    setConnectionEstablished conn+    -- to receive NewSessionTicket+    fire conn (Microseconds 1000000) $ killHandshaker conn lvl+processFrame _ _ _ = closeConnection ProtocolViolation "Frame is not allowed"++-- QUIC version 1 uses only short packets for stateless reset.+-- But we should check other packets, too.+isStatelessReset :: Connection -> Header -> Crypt -> IO Bool+isStatelessReset conn hdr Crypt{..} = do+    let cid = headerMyCID hdr+    included <- myCIDsInclude conn cid+    case included of+      Just _ -> return False+      _      -> case decodeStatelessResetToken cryptPacket of+             Nothing    -> return False+             Just token -> isStatelessRestTokenValid conn cid token++-- Return value indicates duplication.+putRxCrypto :: Connection -> EncryptionLevel -> RxStreamData -> IO Bool+putRxCrypto conn lvl rx = do+    mstrm <- getCryptoStream conn lvl+    case mstrm of+      Nothing   -> return False+      Just strm -> do+          let put = putCrypto conn . InpHandshake lvl+              putFin = return ()+          tryReassemble strm rx put putFin++killHandshaker :: Connection -> EncryptionLevel -> IO ()+killHandshaker conn lvl = putCrypto conn $ InpHandshake lvl ""
+ Network/QUIC/Recovery.hs view
@@ -0,0 +1,58 @@+module Network.QUIC.Recovery (+  -- Interface+    checkWindowOpenSTM+  , takePingSTM+  , speedup+  , resender+  -- LossRecovery.hs+  , onPacketSent+  , onPacketReceived+  , onAckReceived+  , onPacketNumberSpaceDiscarded+  -- Metrics+  , setInitialCongestionWindow+  -- Misc+  , getPreviousRTT1PPNs+  , setPreviousRTT1PPNs+  , getSpeedingUp+  , getPacketNumberSpaceDiscarded+  , getAndSetPacketNumberSpaceDiscarded+  , setMaxAckDaley+  -- PeerPacketNumbers+  , getPeerPacketNumbers+  , fromPeerPacketNumbers+  , nullPeerPacketNumbers+  -- Persistent+  , findDuration+  , getPTO+  -- Release+  , releaseByRetry+  , releaseOldest+  -- Timer+  , beforeAntiAmp+  , ldccTimer+  -- Types+  , SentPacket+  , spPlainPacket+  , spTimeSent+  , spSentBytes+  , spEncryptionLevel+  , spPacketNumber+  , spPeerPacketNumbers+  , spAckEliciting+  , mkSentPacket+  , fixSentPacket+  , LDCC+  , newLDCC+  , qlogSent+  ) where++import Network.QUIC.Recovery.Interface+import Network.QUIC.Recovery.LossRecovery+import Network.QUIC.Recovery.Metrics+import Network.QUIC.Recovery.Misc+import Network.QUIC.Recovery.PeerPacketNumbers+import Network.QUIC.Recovery.Persistent+import Network.QUIC.Recovery.Release+import Network.QUIC.Recovery.Timer+import Network.QUIC.Recovery.Types
+ Network/QUIC/Recovery/Constants.hs view
@@ -0,0 +1,45 @@+module Network.QUIC.Recovery.Constants where++import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Recovery.Types+import Network.QUIC.Types++timerGranularity :: Microseconds+timerGranularity = Microseconds 10000++-- | Maximum reordering in packets before packet threshold loss+--   detection considers a packet lost.+kPacketThreshold :: PacketNumber+kPacketThreshold = 3++-- | Maximum reordering in time before time threshold loss detection+--   considers a packet lost.  Specified as an RTT multiplier.++kTimeThreshold :: Microseconds -> Microseconds+kTimeThreshold x = x + (x .>>. 3) -- 9/8++-- | Timer granularity.+kGranularity :: Microseconds+-- kGranularity = Microseconds 5000+kGranularity = timerGranularity * 2++-- | Default limit on the initial bytes in flight.+kInitialWindow :: Int -> Int+--kInitialWindow pktSiz = min 14720 (10 * pktSiz)+kInitialWindow pktSiz = pktSiz .<<. 2 --  .<<. 1 is not good enough++-- | Minimum congestion window in bytes.+kMinimumWindow :: LDCC -> IO Int+kMinimumWindow ldcc = do+    siz <- getMaxPacketSize ldcc+    return (siz .<<. 2) -- .<<. 1 is not good enough++-- | Reduction in congestion window when a new loss event is detected.+kLossReductionFactor :: Int -> Int+kLossReductionFactor = (.>>. 1) -- 0.5++-- | Period of time for persistent congestion to be established,+-- specified as a PTO multiplier.+kPersistentCongestionThreshold :: Microseconds -> Microseconds+kPersistentCongestionThreshold (Microseconds us) = Microseconds (3 * us)
+ Network/QUIC/Recovery/Detect.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Recovery.Detect (+    releaseByPredicate+  , detectAndRemoveLostPackets+  , removePacketNumbers+  ) where++import Data.Sequence (Seq, ViewL(..))+import qualified Data.Sequence as Seq++import Network.QUIC.Imports+import Network.QUIC.Qlog+import Network.QUIC.Recovery.Constants+import Network.QUIC.Recovery.PeerPacketNumbers+import Network.QUIC.Recovery.Types+import Network.QUIC.Types++releaseByPredicate :: LDCC -> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)+releaseByPredicate ldcc@LDCC{..} lvl predicate = do+    packets <- atomicModifyIORef' (sentPackets ! lvl) $ \(SentPackets db) ->+       let (pkts, db') = Seq.partition predicate db+       in (SentPackets db', pkts)+    removePacketNumbers ldcc lvl packets+    return packets++detectAndRemoveLostPackets :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)+detectAndRemoveLostPackets ldcc@LDCC{..} lvl = do+    lae <- timeOfLastAckElicitingPacket <$> readIORef (lossDetection ! lvl)+    when (lae == timeMicrosecond0) $+        qlogDebug ldcc $ Debug "detectAndRemoveLostPackets: timeOfLastAckElicitingPacket: 0"+    atomicModifyIORef'' (lossDetection ! lvl) $ \ld -> ld {+          lossTime = Nothing+        }+    RTT{..} <- readIORef recoveryRTT+    LossDetection{..} <- readIORef (lossDetection ! lvl)+    when (largestAckedPacket == -1) $+        qlogDebug ldcc $ Debug "detectAndRemoveLostPackets: largestAckedPacket: -1"+    -- Sec 6.1.2. Time Threshold+    -- max(kTimeThreshold * max(smoothed_rtt, latest_rtt), kGranularity)+    let lossDelay0 = kTimeThreshold $ max latestRTT smoothedRTT+    let lossDelay = max lossDelay0 kGranularity++    tm <- getPastTimeMicrosecond lossDelay+    let predicate ent = (spPacketNumber ent <= largestAckedPacket - kPacketThreshold)+                     || (spPacketNumber ent <= largestAckedPacket && spTimeSent ent <= tm)+    lostPackets <- releaseByPredicate ldcc lvl predicate++    mx <- findOldest ldcc lvl (\x -> spPacketNumber x <= largestAckedPacket)+    case mx of+      -- No gap packet. PTO turn.+      Nothing -> return ()+      -- There are gap packets which are not declared lost.+      -- Set lossTime to next.+      Just x  -> do+          let next = spTimeSent x `addMicroseconds` lossDelay+          atomicModifyIORef'' (lossDetection ! lvl) $ \ld -> ld {+                lossTime = Just next+              }++    unless (Seq.null lostPackets) $ qlogDebug ldcc $ Debug "loss detected"+    return lostPackets++findOldest :: LDCC -> EncryptionLevel -> (SentPacket -> Bool)+           -> IO (Maybe SentPacket)+findOldest LDCC{..} lvl p = oldest <$> readIORef (sentPackets ! lvl)+  where+    oldest (SentPackets db) = case Seq.viewl $ Seq.filter p db of+      EmptyL -> Nothing+      x :< _ -> Just x++removePacketNumbers :: Foldable t => LDCC -> EncryptionLevel -> t SentPacket -> IO ()+removePacketNumbers ldcc lvl packets = mapM_ reduce packets+  where+    reduce x = reducePeerPacketNumbers ldcc lvl ppns+      where+        ppns = spPeerPacketNumbers x
+ Network/QUIC/Recovery/Interface.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Recovery.Interface (+    checkWindowOpenSTM+  , takePingSTM+  , speedup+  , resender+  ) where++import Control.Concurrent.STM+import qualified Data.Sequence as Seq+import System.Log.FastLogger (LogStr)++import Network.QUIC.Imports+import Network.QUIC.Qlog+import Network.QUIC.Recovery.Misc+import Network.QUIC.Recovery.Release+import Network.QUIC.Recovery.Timer+import Network.QUIC.Recovery.Types+import Network.QUIC.Recovery.Utils+import Network.QUIC.Types++checkWindowOpenSTM :: LDCC -> Int -> STM ()+checkWindowOpenSTM LDCC{..} siz = do+    CC{..} <- readTVar recoveryCC+    check (siz <= congestionWindow - bytesInFlight)++takePingSTM :: LDCC -> STM EncryptionLevel+takePingSTM LDCC{..} = do+    mx <- readTVar ptoPing+    check $ isJust mx+    writeTVar ptoPing Nothing+    return $ fromJust mx++speedup :: LDCC -> EncryptionLevel -> LogStr -> IO ()+speedup ldcc@LDCC{..} lvl desc = do+    setSpeedingUp ldcc+    qlogDebug ldcc $ Debug desc+    packets <- atomicModifyIORef' (sentPackets ! lvl) $+                  \(SentPackets db) -> (emptySentPackets, db)+    -- don't clear PeerPacketNumbers.+    unless (null packets) $ do+        onPacketsLost ldcc packets+        retransmit ldcc packets+        setLossDetectionTimer ldcc lvl++resender :: LDCC -> IO ()+resender ldcc@LDCC{..} = forever $ do+    atomically $ do+        lostPackets <- readTVar lostCandidates+        check (lostPackets /= emptySentPackets)+    delay $ Microseconds 10000 -- fixme+    packets <- atomically $ do+        SentPackets pkts <- readTVar lostCandidates+        writeTVar lostCandidates emptySentPackets+        return pkts+    when (packets /= Seq.empty) $ do+        onPacketsLost ldcc packets+        retransmit ldcc packets
+ Network/QUIC/Recovery/LossRecovery.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Recovery.LossRecovery (+    onPacketSent+  , onPacketReceived+  , onAckReceived+  , onPacketNumberSpaceDiscarded+  ) where++import Control.Concurrent.STM+import Data.Sequence (Seq, (|>), ViewR(..))+import qualified Data.Sequence as Seq++import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Qlog+import Network.QUIC.Recovery.Constants+import Network.QUIC.Recovery.Detect+import Network.QUIC.Recovery.Metrics+import Network.QUIC.Recovery.Misc+import Network.QUIC.Recovery.PeerPacketNumbers+import Network.QUIC.Recovery.Release+import Network.QUIC.Recovery.Timer+import Network.QUIC.Recovery.Types+import Network.QUIC.Recovery.Utils+import Network.QUIC.Types++----------------------------------------------------------------++onPacketSent :: LDCC -> SentPacket -> IO ()+onPacketSent ldcc@LDCC{..} sentPacket = do+    let lvl0 = spEncryptionLevel sentPacket+    let lvl | lvl0 == RTT0Level = RTT1Level+            | otherwise         = lvl0+    discarded <- getPacketNumberSpaceDiscarded ldcc lvl+    unless discarded $ do+        onPacketSentCC ldcc sentPacket+        when (spAckEliciting sentPacket) $+            atomicModifyIORef'' (lossDetection ! lvl) $ \ld -> ld {+                timeOfLastAckElicitingPacket = spTimeSent sentPacket+              }+        atomicModifyIORef'' (sentPackets ! lvl) $+            \(SentPackets db) -> SentPackets (db |> sentPacket)+        setLossDetectionTimer ldcc lvl++onPacketSentCC :: LDCC -> SentPacket -> IO ()+onPacketSentCC ldcc@LDCC{..} sentPacket = metricsUpdated ldcc $+    atomically $ modifyTVar' recoveryCC $ \cc -> cc {+        bytesInFlight = bytesInFlight cc + sentBytes+      , numOfAckEliciting = numOfAckEliciting cc + countAckEli sentPacket+      }+  where+    sentBytes = spSentBytes sentPacket++----------------------------------------------------------------++onPacketReceived :: LDCC -> EncryptionLevel -> PacketNumber -> IO ()+onPacketReceived ldcc lvl pn = do+    discarded <- getPacketNumberSpaceDiscarded ldcc lvl+    unless discarded $ addPeerPacketNumbers ldcc lvl pn++----------------------------------------------------------------++onAckReceived :: LDCC -> EncryptionLevel -> AckInfo -> Microseconds -> IO ()+onAckReceived ldcc@LDCC{..} lvl ackInfo@(AckInfo largestAcked _ _) ackDelay = do+    changed <- atomicModifyIORef' (lossDetection ! lvl) update+    when changed $ do+        let predicate = fromAckInfoToPred ackInfo . spPacketNumber+        releaseLostCandidates ldcc lvl predicate >>= updateCConAck+        releaseByPredicate    ldcc lvl predicate >>= detectLossUpdateCC+  where+    update ld@LossDetection{..} = (ld', changed)+      where+        ld' = ld { largestAckedPacket = max largestAckedPacket largestAcked+                 , previousAckInfo = ackInfo+                 }+        changed = previousAckInfo /= ackInfo+    detectLossUpdateCC newlyAckedPackets = case Seq.viewr newlyAckedPackets of+      EmptyR -> return ()+      _ :> lastPkt -> do+          -- If the largest acknowledged is newly acked and+          -- at least one ack-eliciting was newly acked, update the RTT.+          when (spPacketNumber lastPkt == largestAcked+             && any spAckEliciting newlyAckedPackets) $ do+              rtt <- getElapsedTimeMicrosecond $ spTimeSent lastPkt+              let latestRtt = max rtt kGranularity+              updateRTT ldcc lvl latestRtt ackDelay++          {- fimxe+          -- Process ECN information if present.+          if (ACK frame contains ECN information):+             ProcessECN(ack, lvl)+          -}++          lostPackets <- detectAndRemoveLostPackets ldcc lvl+          unless (null lostPackets) $ do+              mode <- ccMode <$> readTVarIO recoveryCC+              if lvl == RTT1Level && mode /= SlowStart then+                  mergeLostCandidates ldcc lostPackets+                else do+                  -- just in case+                  lostPackets' <- mergeLostCandidatesAndClear ldcc lostPackets+                  onPacketsLost ldcc lostPackets'+                  retransmit ldcc lostPackets'+          -- setLossDetectionTimer in updateCConAck+          updateCConAck newlyAckedPackets++    updateCConAck newlyAckedPackets+      | newlyAckedPackets == Seq.empty = return ()+      | otherwise = do+          onPacketsAcked ldcc newlyAckedPackets++          -- Sec 6.2.1. Computing PTO+          -- "The PTO backoff factor is reset when an acknowledgement is+          --  received, except in the following case. A server might+          --  take longer to respond to packets during the handshake+          --  than otherwise. To protect such a server from repeated+          --  client probes, the PTO backoff is not reset at a client+          --  that is not yet certain that the server has finished+          --  validating the client's address."+          validated <- peerCompletedAddressValidation ldcc+          when validated $ metricsUpdated ldcc $+              atomicModifyIORef'' recoveryRTT $ \rtt -> rtt { ptoCount = 0 }++          setLossDetectionTimer ldcc lvl++releaseLostCandidates :: LDCC -> EncryptionLevel -> (SentPacket -> Bool) -> IO (Seq SentPacket)+releaseLostCandidates ldcc@LDCC{..} lvl predicate = do+    packets <- atomically $ do+        SentPackets db <- readTVar lostCandidates+        let (pkts, db') = Seq.partition predicate db+        writeTVar lostCandidates $ SentPackets db'+        return pkts+    removePacketNumbers ldcc lvl packets+    return packets++onPacketsAcked :: LDCC -> Seq SentPacket -> IO ()+onPacketsAcked ldcc@LDCC{..} ackedPackets = metricsUpdated ldcc $ do+    maxPktSiz <- getMaxPacketSize ldcc+    oldcc <- readTVarIO recoveryCC+    atomically $ modifyTVar' recoveryCC $ modify maxPktSiz+    newcc <- readTVarIO recoveryCC+    when (ccMode oldcc /= ccMode newcc) $+      qlogContestionStateUpdated ldcc $ ccMode newcc+  where+    modify maxPktSiz cc@CC{..} = cc {+           bytesInFlight = bytesInFlight'+         , congestionWindow = congestionWindow'+         , bytesAcked = bytesAcked'+         , ccMode = ccMode'+         , numOfAckEliciting = numOfAckEliciting'+         }+      where+        (bytesInFlight',congestionWindow',bytesAcked',ccMode',numOfAckEliciting') =+              foldl' (.+) (bytesInFlight,congestionWindow,bytesAcked,ccMode,numOfAckEliciting) ackedPackets+        (bytes,cwin,acked,_,cnt) .+ sp@SentPacket{..} = (bytes',cwin',acked',mode',cnt')+          where+            isRecovery = inCongestionRecovery spTimeSent congestionRecoveryStartTime+            bytes' = bytes - spSentBytes+            ackedA = acked + spSentBytes+            cnt' = cnt - countAckEli sp+            (cwin',acked',mode')+              -- Do not increase congestion window in recovery period.+              | isRecovery      = (cwin, acked, Recovery)+              -- fixme: Do not increase congestion_window if application+              -- limited or flow control limited.+              --+              -- Slow start.+              | cwin < ssthresh = (cwin + spSentBytes, acked, SlowStart)+              -- Congestion avoidance.+              -- In this implementation, maxPktSiz == spSentBytes.+              -- spSentBytes is large enough, so we don't care+              -- the roundup issue of `div`.+              | ackedA >= cwin  = (cwin + maxPktSiz, ackedA - cwin, Avoidance)+              | otherwise       = (cwin, ackedA, Avoidance)++----------------------------------------------------------------++onPacketNumberSpaceDiscarded :: LDCC -> EncryptionLevel -> IO ()+onPacketNumberSpaceDiscarded ldcc lvl = do+    let (lvl',label) = case lvl of+          InitialLevel -> (HandshakeLevel,"initial")+          _            -> (RTT1Level, "handshake")+    qlogDebug ldcc $ Debug (label <> " discarded")+    void $ discard ldcc lvl+    setLossDetectionTimer ldcc lvl'
+ Network/QUIC/Recovery/Metrics.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NamedFieldPuns #-}++module Network.QUIC.Recovery.Metrics (+    updateRTT+  , updateCC+  , metricsUpdated+  , setInitialCongestionWindow+  ) where++import Control.Concurrent.STM+import Data.Sequence (Seq)++import Network.QUIC.Imports+import Network.QUIC.Qlog+import Network.QUIC.Recovery.Constants+import Network.QUIC.Recovery.Misc+import Network.QUIC.Recovery.Persistent+import Network.QUIC.Recovery.Types+import Network.QUIC.Types++updateRTT :: LDCC -> EncryptionLevel -> Microseconds -> Microseconds -> IO ()+updateRTT ldcc@LDCC{..} lvl latestRTT0 ackDelay0 = metricsUpdated ldcc $ do+    firstTime <- atomicModifyIORef' recoveryRTT update+    when firstTime $ do+        setPktNumPersistent ldcc+        qlogDebug ldcc $ Debug "RTT first sample"+  where+    -- don't use latestRTT, use latestRTT0 instead+    --+    -- First time:+    -- Overwriting the initial value with the first sample.+    -- Initial value was used to calculate PTO.+    --+    -- smoothed_rtt = rtt_sample+    -- rttvar = rtt_sample / 2+    update rtt@RTT{..} | latestRTT == Microseconds 0 = (rtt {+        latestRTT   = latestRTT0+      , minRTT      = latestRTT0+      , smoothedRTT = latestRTT0+      , rttvar      = latestRTT0 `unsafeShiftR` 1+      }, True)+    -- Others:+    update rtt@RTT{..} = (rtt {+        latestRTT   = latestRTT0+      , minRTT      = minRTT'+      , smoothedRTT = smoothedRTT'+      , rttvar      = rttvar'+      }, False)+      where+        -- minRTT ignores ack delay.+        minRTT' = min minRTT latestRTT0+        -- Limit ack_delay by max_ack_delay+        -- ack_delay = min(Ack Delay in ACK Frame, max_ack_delay)+        ackDelay = min ackDelay0 $ getMaxAckDelay (Just lvl) maxAckDelay1RTT+        -- Adjust for ack delay if plausible.+        -- adjusted_rtt = latest_rtt+        -- if (latest_rtt >= min_rtt + ack_delay):+        --   adjusted_rtt = latest_rtt - ack_delay+        adjustedRTT+          | latestRTT0 >= minRTT + ackDelay = latestRTT0 - ackDelay+          | otherwise                       = latestRTT0+        -- rttvar_sample = abs(smoothed_rtt - adjusted_rtt)+        -- rttvar = 3/4 * rttvar + 1/4 * rttvar_sample+        rttvar' = rttvar - (rttvar .>>. 2)+                + (abs (smoothedRTT - adjustedRTT) .>>. 2)+        -- smoothed_rtt = 7/8 * smoothed_rtt + 1/8 * adjusted_rtt+        smoothedRTT' = smoothedRTT - (smoothedRTT .>>. 3)+                     + (adjustedRTT .>>. 3)++updateCC :: LDCC -> Seq SentPacket -> Bool -> IO ()+updateCC ldcc@LDCC{..} lostPackets isRecovery = do+    persistent <- inPersistentCongestion ldcc lostPackets+    when (persistent || not isRecovery) $ do+        minWindow <- kMinimumWindow ldcc+        now <- getTimeMicrosecond+        metricsUpdated ldcc $ atomically $ modifyTVar' recoveryCC $ \cc@CC{..} ->+            let halfWindow = max minWindow $ kLossReductionFactor congestionWindow+                cwin+                  | persistent = minWindow+                  | otherwise  = halfWindow+                sst            = halfWindow+                mode+                  | cwin < sst = SlowStart -- persistent+                  | otherwise  = Recovery+            in cc {+                congestionRecoveryStartTime = Just now+              , congestionWindow = cwin+              , ssthresh         = sst+              , ccMode           = mode+              , bytesAcked       = 0+              }+        CC{ccMode} <- readTVarIO recoveryCC+        qlogContestionStateUpdated ldcc ccMode++setInitialCongestionWindow :: LDCC -> Int -> IO ()+setInitialCongestionWindow ldcc@LDCC{..} pktSiz = metricsUpdated ldcc $+    atomically $ do modifyTVar' recoveryCC $ \cc -> cc {+        congestionWindow = kInitialWindow pktSiz+      }++----------------------------------------------------------------++metricsUpdated :: LDCC -> IO () -> IO ()+metricsUpdated ldcc@LDCC{..} body = do+    rtt0 <- readIORef recoveryRTT+    cc0 <- readTVarIO recoveryCC+    body+    rtt1 <- readIORef recoveryRTT+    cc1 <- readTVarIO recoveryCC+    let ~diff = catMaybes [+            time "min_rtt"      (minRTT      rtt0) (minRTT      rtt1)+          , time "smoothed_rtt" (smoothedRTT rtt0) (smoothedRTT rtt1)+          , time "latest_rtt"   (latestRTT   rtt0) (latestRTT   rtt1)+          , time "rtt_variance" (rttvar      rtt0) (rttvar      rtt1)+          , numb "pto_count"    (ptoCount    rtt0) (ptoCount    rtt1)+          , numb "bytes_in_flight"   (bytesInFlight cc0) (bytesInFlight cc1)+          , numb "congestion_window" (congestionWindow cc0) (congestionWindow cc1)+          , numb "ssthresh"          (ssthresh cc0) (ssthresh cc1)+          ]+    unless (null diff) $ qlogMetricsUpdated ldcc $ MetricsDiff diff+  where+    time tag (Microseconds v0) (Microseconds v1)+      | v0 == v1  = Nothing+      | otherwise = Just (tag,v1)+    numb tag v0 v1+      | v0 == v1  = Nothing+      | otherwise = Just (tag,v1)
+ Network/QUIC/Recovery/Misc.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++module Network.QUIC.Recovery.Misc (+    getPktNumPersistent+  , setPktNumPersistent+  , setSpeedingUp+  , getSpeedingUp+  , getPacketNumberSpaceDiscarded+  , getAndSetPacketNumberSpaceDiscarded+  , setMaxAckDaley+  ) where++import Data.IORef++import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Recovery.Types+import Network.QUIC.Types++----------------------------------------------------------------+-- Packet number for 1st RTT sample++getPktNumPersistent :: LDCC -> IO PacketNumber+getPktNumPersistent LDCC{..} = readIORef pktNumPersistent++setPktNumPersistent :: LDCC -> IO ()+setPktNumPersistent ldcc@LDCC{..} =+    getPacketNumber ldcc >>= writeIORef pktNumPersistent++----------------------------------------------------------------++setSpeedingUp :: LDCC -> IO ()+setSpeedingUp LDCC{..} = writeIORef speedingUp True++getSpeedingUp :: LDCC -> IO Bool+getSpeedingUp LDCC{..} = readIORef speedingUp++----------------------------------------------------------------++getPacketNumberSpaceDiscarded :: LDCC -> EncryptionLevel -> IO Bool+getPacketNumberSpaceDiscarded LDCC{..} lvl =+    readIORef (spaceDiscarded ! lvl)++getAndSetPacketNumberSpaceDiscarded :: LDCC -> EncryptionLevel -> IO Bool+getAndSetPacketNumberSpaceDiscarded LDCC{..} lvl =+    atomicModifyIORef' (spaceDiscarded ! lvl) (True,)++----------------------------------------------------------------++setMaxAckDaley :: LDCC -> Microseconds -> IO ()+setMaxAckDaley LDCC{..} delay0 =+    atomicModifyIORef'' recoveryRTT $ \rtt -> rtt { maxAckDelay1RTT = delay0 }
+ Network/QUIC/Recovery/PeerPacketNumbers.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Recovery.PeerPacketNumbers (+    getPeerPacketNumbers+  , addPeerPacketNumbers+  , delPeerPacketNumbers+  , clearPeerPacketNumbers+  , reducePeerPacketNumbers+  , setPreviousRTT1PPNs+  , getPreviousRTT1PPNs+  , nullPeerPacketNumbers+  , fromPeerPacketNumbers+  ) where++import qualified Data.IntSet as IntSet++import Network.QUIC.Imports hiding (range)+import Network.QUIC.Recovery.Types+import Network.QUIC.Types++----------------------------------------------------------------+-- Peer's packet numbers++{-# INLINE getPeerPacketNumbers #-}+getPeerPacketNumbers :: LDCC -> EncryptionLevel -> IO PeerPacketNumbers+getPeerPacketNumbers LDCC{..} lvl = readIORef (peerPacketNumbers ! lvl)++{-# INLINE addPeerPacketNumbers #-}+addPeerPacketNumbers :: LDCC -> EncryptionLevel -> PacketNumber -> IO ()+addPeerPacketNumbers LDCC{..} lvl pn =+    atomicModifyIORef'' (peerPacketNumbers ! lvl) add+  where+    add (PeerPacketNumbers pns) = PeerPacketNumbers $ IntSet.insert pn pns++{-# INLINE delPeerPacketNumbers #-}+delPeerPacketNumbers :: LDCC -> EncryptionLevel -> PacketNumber -> IO ()+delPeerPacketNumbers LDCC{..} lvl pn =+    atomicModifyIORef'' (peerPacketNumbers ! lvl) del+  where+    del (PeerPacketNumbers pns) = PeerPacketNumbers $ IntSet.delete pn pns++{-# INLINE clearPeerPacketNumbers #-}+clearPeerPacketNumbers :: LDCC -> EncryptionLevel -> IO ()+clearPeerPacketNumbers LDCC{..} lvl =+    atomicModifyIORef'' (peerPacketNumbers ! lvl) $ \_ -> emptyPeerPacketNumbers++{-# INLINE reducePeerPacketNumbers #-}+reducePeerPacketNumbers :: LDCC -> EncryptionLevel -> PeerPacketNumbers -> IO ()+reducePeerPacketNumbers LDCC{..} lvl (PeerPacketNumbers pns) =+    atomicModifyIORef'' (peerPacketNumbers ! lvl) reduce+  where+    reduce (PeerPacketNumbers pns0) = PeerPacketNumbers (pns0 IntSet.\\ pns)++{-# INLINE setPreviousRTT1PPNs #-}+setPreviousRTT1PPNs :: LDCC -> PeerPacketNumbers -> IO ()+setPreviousRTT1PPNs LDCC{..} ppns = writeIORef previousRTT1PPNs ppns++{-# INLINE getPreviousRTT1PPNs #-}+getPreviousRTT1PPNs :: LDCC -> IO PeerPacketNumbers+getPreviousRTT1PPNs LDCC{..} = readIORef previousRTT1PPNs++----------------------------------------------------------------++{-# INLINE nullPeerPacketNumbers #-}+nullPeerPacketNumbers :: PeerPacketNumbers -> Bool+nullPeerPacketNumbers (PeerPacketNumbers pns) = IntSet.null pns++{-# INLINE fromPeerPacketNumbers #-}+fromPeerPacketNumbers :: PeerPacketNumbers -> [PacketNumber]+fromPeerPacketNumbers (PeerPacketNumbers pns) = IntSet.toDescList pns
+ Network/QUIC/Recovery/Persistent.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Recovery.Persistent (+    getMaxAckDelay+  , calcPTO+  , backOff+  , inPersistentCongestion+  , findDuration -- for testing+  , getPTO+  ) where++import Data.Sequence (Seq, ViewL(..))+import qualified Data.Sequence as Seq+import Data.UnixTime++import Network.QUIC.Imports+import Network.QUIC.Recovery.Constants+import Network.QUIC.Recovery.Misc+import Network.QUIC.Recovery.Types+import Network.QUIC.Types++getMaxAckDelay :: Maybe EncryptionLevel -> Microseconds -> Microseconds+getMaxAckDelay Nothing n = n+getMaxAckDelay (Just lvl) n+  | lvl `elem` [InitialLevel,HandshakeLevel] = 0+  | otherwise                                = n++-- Sec 6.2.1. Computing PTO+-- PTO = smoothed_rtt + max(4*rttvar, kGranularity) + max_ack_delay+calcPTO :: RTT -> Maybe EncryptionLevel -> Microseconds+calcPTO RTT{..} mlvl = smoothedRTT + max (rttvar .<<. 2) kGranularity + dly+  where+    dly = getMaxAckDelay mlvl maxAckDelay1RTT++backOff :: Microseconds -> Int -> Microseconds+backOff n cnt = n * (2 ^ cnt)++-- Sec 7.8. Persistent Congestion+inPersistentCongestion :: LDCC -> Seq SentPacket -> IO Bool+inPersistentCongestion ldcc@LDCC{..} lostPackets = do+    pn <- getPktNumPersistent ldcc+    let mduration = findDuration lostPackets pn+    case mduration of+      Nothing -> return False+      Just duration -> do+          rtt <- readIORef recoveryRTT+          let pto = calcPTO rtt Nothing+              Microseconds congestionPeriod = kPersistentCongestionThreshold pto+              threshold = microSecondsToUnixDiffTime congestionPeriod+          return (duration > threshold)++findDuration :: Seq SentPacket -> PacketNumber -> Maybe UnixDiffTime+findDuration pkts0 pn = leftEdge pkts0 Nothing+  where+    leftEdge pkts mdiff = case Seq.viewl pkts' of+        EmptyL      -> mdiff+        l :< pkts'' -> case rightEdge (spPacketNumber l) pkts'' Nothing of+          (Nothing, pkts''') -> leftEdge pkts''' mdiff+          (Just r,  pkts''') ->+              let diff' = spTimeSent r `diffUnixTime` spTimeSent l+              in case mdiff of+                Nothing          -> leftEdge pkts''' $ Just diff'+                Just diff+                  | diff' > diff -> leftEdge pkts''' $ Just diff'+                  | otherwise    -> leftEdge pkts''' $ Just diff+      where+        (_, pkts') = Seq.breakl (\x -> spAckEliciting x && spPacketNumber x >= pn) pkts+    rightEdge n pkts Nothing = case Seq.viewl pkts of+        EmptyL -> (Nothing, Seq.empty)+        r :< pkts'+          | spPacketNumber r == n + 1 ->+              if spAckEliciting r then+                  rightEdge (n + 1) pkts' $ Just r+                else+                  rightEdge (n + 1) pkts' Nothing+          | otherwise -> (Nothing, pkts)+    rightEdge n pkts mr0 = case Seq.viewl pkts of+        EmptyL -> (mr0, Seq.empty)+        r :< pkts'+          | spPacketNumber r == n + 1 ->+              if spAckEliciting r then+                  rightEdge (n + 1) pkts' $ Just r+                else+                  rightEdge (n + 1) pkts' mr0+          | otherwise -> (mr0, pkts)++getPTO :: LDCC -> IO Microseconds+getPTO LDCC{..} = do+    rtt <- readIORef recoveryRTT+    return $ calcPTO rtt Nothing
+ Network/QUIC/Recovery/Release.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Recovery.Release (+    releaseByRetry+  , releaseOldest+  , discard+  , onPacketsLost+  ) where++import Control.Concurrent.STM+import Data.Sequence (Seq, (><), ViewL(..), ViewR(..))+import qualified Data.Sequence as Seq++import Network.QUIC.Imports+import Network.QUIC.Recovery.Metrics+import Network.QUIC.Recovery.PeerPacketNumbers+import Network.QUIC.Recovery.Types+import Network.QUIC.Recovery.Utils+import Network.QUIC.Types++----------------------------------------------------------------++discard :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)+discard ldcc@LDCC{..} lvl = do+    packets <- releaseByClear ldcc lvl+    decreaseCC ldcc packets+    writeIORef (lossDetection ! lvl) initialLossDetection+    metricsUpdated ldcc $+        atomicModifyIORef'' recoveryRTT $ \rtt -> rtt { ptoCount = 0 }+    return packets++releaseByClear :: LDCC -> EncryptionLevel -> IO (Seq SentPacket)+releaseByClear ldcc@LDCC{..} lvl = do+    clearPeerPacketNumbers ldcc lvl+    atomicModifyIORef' (sentPackets ! lvl) $ \(SentPackets db) ->+        (emptySentPackets, db)++----------------------------------------------------------------++releaseByRetry :: LDCC -> IO (Seq PlainPacket)+releaseByRetry ldcc = do+    packets <- discard ldcc InitialLevel+    return (spPlainPacket <$> packets)++-- Returning the oldest if it is ack-eliciting.+releaseOldest :: LDCC -> EncryptionLevel -> IO (Maybe SentPacket)+releaseOldest ldcc@LDCC{..} lvl = do+    mr <- atomicModifyIORef' (sentPackets ! lvl) oldest+    case mr of+      Nothing   -> return ()+      Just spkt -> do+          delPeerPacketNumbers ldcc lvl $ spPacketNumber spkt+          decreaseCC ldcc [spkt]+    return mr+  where+    oldest (SentPackets db) = case Seq.viewl db2 of+      x :< db2' -> let db' = db1 >< db2'+                   in (SentPackets db', Just x)+      _         ->    (SentPackets db, Nothing)+      where+        (db1, db2) = Seq.breakl spAckEliciting db++----------------------------------------------------------------++onPacketsLost :: LDCC -> Seq SentPacket -> IO ()+onPacketsLost ldcc@LDCC{..} lostPackets = case Seq.viewr lostPackets of+  EmptyR -> return ()+  _ :> lastPkt -> do+    decreaseCC ldcc lostPackets+    isRecovery <- inCongestionRecovery (spTimeSent lastPkt) . congestionRecoveryStartTime <$> readTVarIO recoveryCC+    onCongestionEvent ldcc lostPackets isRecovery+    mapM_ (qlogPacketLost ldcc . LostPacket) lostPackets+  where+    onCongestionEvent = updateCC++----------------------------------------------------------------++decreaseCC :: (Functor m, Foldable m) => LDCC -> m SentPacket -> IO ()+decreaseCC ldcc@LDCC{..} packets = do+    let sentBytes = sum' (spSentBytes <$> packets)+        num = sum' (countAckEli <$> packets)+    metricsUpdated ldcc $+        atomically $ modifyTVar' recoveryCC $ \cc ->+          cc {+            bytesInFlight = bytesInFlight cc - sentBytes++            , numOfAckEliciting = numOfAckEliciting cc - num+          }
+ Network/QUIC/Recovery/Timer.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}++module Network.QUIC.Recovery.Timer (+    getLossTimeAndSpace+  , getPtoTimeAndSpace+  , setLossDetectionTimer+  , beforeAntiAmp+  , ldccTimer+  ) where++import Control.Concurrent.STM+import qualified Data.Sequence as Seq+import GHC.Event hiding (new)++import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Qlog+import Network.QUIC.Recovery.Detect+import Network.QUIC.Recovery.Metrics+import Network.QUIC.Recovery.Misc+import Network.QUIC.Recovery.Persistent+import Network.QUIC.Recovery.Release+import Network.QUIC.Recovery.Types+import Network.QUIC.Recovery.Utils+import Network.QUIC.Recovery.Constants+import Network.QUIC.Types++----------------------------------------------------------------++noInFlightPacket :: LDCC -> EncryptionLevel -> IO Bool+noInFlightPacket LDCC{..} lvl = do+    SentPackets db <- readIORef (sentPackets ! lvl)+    return $ Seq.null db++getLossTimeAndSpace :: LDCC -> IO (Maybe (TimeMicrosecond,EncryptionLevel))+getLossTimeAndSpace LDCC{..} =+    loop [InitialLevel, HandshakeLevel, RTT1Level] Nothing+  where+    loop []     r = return r+    loop (l:ls) r = do+        mt <- lossTime <$> readIORef (lossDetection ! l)+        case mt of+          Nothing -> loop ls r+          Just t  -> case r of+            Nothing -> loop ls $ Just (t,l)+            Just (t0,_)+               | t < t0    -> loop ls $ Just (t,l)+               | otherwise -> loop ls r++----------------------------------------------------------------++getPtoTimeAndSpace :: LDCC -> IO (Maybe (TimeMicrosecond, EncryptionLevel))+getPtoTimeAndSpace ldcc@LDCC{..} = do+    -- Arm PTO from now when there are no inflight packets.+    CC{..} <- readTVarIO recoveryCC+    if bytesInFlight <= 0 then do+        validated <- peerCompletedAddressValidation ldcc+        if validated then do+            qlogDebug ldcc $ Debug "getPtoTimeAndSpace: validated"+            return Nothing+          else do+            rtt <- readIORef recoveryRTT+            lvl <- getEncryptionLevel ldcc+            let pto = backOff (calcPTO rtt $ Just lvl) (ptoCount rtt)+            ptoTime <- getFutureTimeMicrosecond pto+            return $ Just (ptoTime, lvl)+      else do+        completed <- isConnectionEstablished ldcc+        let lvls | completed = [InitialLevel, HandshakeLevel, RTT1Level]+                 | otherwise = [InitialLevel, HandshakeLevel]+        loop lvls+  where+    loop :: [EncryptionLevel] -> IO (Maybe (TimeMicrosecond, EncryptionLevel))+    loop [] = return Nothing+    loop (l:ls) = do+        notInFlight <- noInFlightPacket ldcc l+        if notInFlight then+            loop ls+          else do+            LossDetection{..} <- readIORef (lossDetection ! l)+            if timeOfLastAckElicitingPacket == timeMicrosecond0 then+                loop ls+              else do+                  rtt <- readIORef recoveryRTT+                  let pto0 = backOff (calcPTO rtt $ Just l) (ptoCount rtt)+                      pto = max pto0 kGranularity+                      ptoTime = timeOfLastAckElicitingPacket `addMicroseconds` pto+                  return $ Just (ptoTime, l)++----------------------------------------------------------------++cancelLossDetectionTimer :: LDCC -> IO ()+cancelLossDetectionTimer ldcc@LDCC{..} = do+    atomically $ writeTVar timerInfoQ Empty+    mk <- atomicModifyIORef' timerKey (Nothing,)+    forM_ mk $ \k -> do+        mgr <- getSystemTimerManager+        unregisterTimeout mgr k+        writeIORef timerInfo Nothing+        qlogLossTimerCancelled ldcc++updateLossDetectionTimer :: LDCC -> TimerInfo -> IO ()+updateLossDetectionTimer ldcc@LDCC{..} tmi = do+    mtmi <- readIORef timerInfo+    when (mtmi /= Just tmi) $ do+        if timerLevel tmi == RTT1Level then+            atomically $ writeTVar timerInfoQ $ Next tmi+          else+            updateLossDetectionTimer' ldcc tmi++ldccTimer :: LDCC -> IO ()+ldccTimer ldcc@LDCC{..} = forever $ do+    atomically $ do+        x <- readTVar timerInfoQ+        check (x /= Empty)+    delay timerGranularity+    updateWithNext ldcc++updateWithNext :: LDCC -> IO ()+updateWithNext ldcc@LDCC{..} = do+    x <- readTVarIO timerInfoQ+    case x of+      Empty    -> return ()+      Next tmi -> updateLossDetectionTimer' ldcc tmi++updateLossDetectionTimer' :: LDCC -> TimerInfo -> IO ()+updateLossDetectionTimer' ldcc@LDCC{..} tmi = do+    atomically $ writeTVar timerInfoQ Empty+    let tim = timerTime tmi+    Microseconds us0 <- getTimeoutInMicrosecond tim+    let us | us0 <= 0  = 10000 -- fixme+           | otherwise = us0+    update us+    qlogLossTimerUpdated ldcc (tmi, Microseconds us) -- fixme tmi+  where+    update us = do+        mgr <- getSystemTimerManager+        key <- registerTimeout mgr us (onLossDetectionTimeout ldcc)+        mk <- atomicModifyIORef' timerKey (Just key,)+        forM_ mk $ unregisterTimeout mgr+        writeIORef timerInfo $ Just tmi++----------------------------------------------------------------++setLossDetectionTimer :: LDCC -> EncryptionLevel -> IO ()+setLossDetectionTimer ldcc@LDCC{..} lvl0 = do+    mtl <- getLossTimeAndSpace ldcc+    case mtl of+      Just (earliestLossTime,lvl) -> do+          when (lvl0 == lvl) $ do+              -- Time threshold loss detection.+              let tmi = TimerInfo earliestLossTime lvl LossTime+              updateLossDetectionTimer ldcc tmi+      Nothing -> do+          -- See beforeAntiAmp+          CC{..} <- readTVarIO recoveryCC+          validated <- peerCompletedAddressValidation ldcc+          if numOfAckEliciting <= 0 && validated then+              -- There is nothing to detect lost, so no timer is+              -- set. However, we only do this if the peer has+              -- been validated, to prevent the server from being+              -- blocked by the anti-amplification limit.+              cancelLossDetectionTimer ldcc+            else do+              -- Determine which PN space to arm PTO for.+              mx <- getPtoTimeAndSpace ldcc+              case mx of+                Nothing -> return ()+                Just (ptoTime, lvl) -> do+                    when (lvl0 == lvl) $ do+                        let tmi = TimerInfo ptoTime lvl PTO+                        updateLossDetectionTimer ldcc tmi++beforeAntiAmp :: LDCC -> IO ()+beforeAntiAmp ldcc = cancelLossDetectionTimer ldcc++----------------------------------------------------------------++-- The only time the PTO is armed when there are no bytes in flight is+-- when it's a client and it's unsure if the server has completed+-- address validation.+onLossDetectionTimeout :: LDCC -> IO ()+onLossDetectionTimeout ldcc@LDCC{..} = do+    alive <- getAlive ldcc+    when alive $ do+        mtmi <- readIORef timerInfo+        case mtmi of+          Nothing -> return ()+          Just tmi -> do+            let lvl = timerLevel tmi+            discarded <- getPacketNumberSpaceDiscarded ldcc lvl+            if discarded then+                updateWithNext ldcc+              else+                lossTimeOrPTO lvl tmi+  where+    lossTimeOrPTO lvl tmi = do+        qlogLossTimerExpired ldcc+        case timerType tmi of+          LossTime -> do+              -- Time threshold loss Detection+              lostPackets <- detectAndRemoveLostPackets ldcc lvl+              lostPackets' <- mergeLostCandidatesAndClear ldcc lostPackets+              when (null lostPackets') $ qlogDebug ldcc $ Debug "onLossDetectionTimeout: null"+              onPacketsLost ldcc lostPackets'+              retransmit ldcc lostPackets'+              setLossDetectionTimer ldcc lvl+          PTO -> do+              CC{..} <- readTVarIO recoveryCC+              if bytesInFlight > 0 then do+                  -- PTO. Send new data if available, else retransmit old data.+                  -- If neither is available, send a single PING frame.+                  sendPing ldcc lvl+                else do+                  -- Client sends an anti-deadlock packet: Initial is padded+                  -- to earn more anti-amplification credit,+                  -- a Handshake packet proves address ownership.+                  validated <- peerCompletedAddressValidation ldcc+                  when validated $ qlogDebug ldcc $ Debug "onLossDetectionTimeout: RTT1"+                  lvl' <- getEncryptionLevel ldcc -- fixme+                  sendPing ldcc lvl'++              metricsUpdated ldcc $+                  atomicModifyIORef'' recoveryRTT $+                      \rtt -> rtt { ptoCount = ptoCount rtt + 1 }+              setLossDetectionTimer ldcc lvl
+ Network/QUIC/Recovery/Types.hs view
@@ -0,0 +1,398 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Recovery.Types (+    SentPacket(..)+  , mkSentPacket+  , fixSentPacket+  , LostPacket(..)+  , SentPackets(..)+  , emptySentPackets+  , RTT(..)+  , initialRTT+  , CCMode(..)+  , CC(..)+  , initialCC+  , LossDetection(..)+  , initialLossDetection+  , MetricsDiff(..)+  , TimerType(..)+  , TimerInfo(..)+  , TimerInfoQ(..)+  , TimerCancelled+  , TimerExpired+  , makeSentPackets+  , makeLossDetection+  , LDCC(..)+  , newLDCC+  , qlogSent+  , qlogMetricsUpdated+  , qlogPacketLost+  , qlogContestionStateUpdated+  , qlogLossTimerUpdated+  , qlogLossTimerCancelled+  , qlogLossTimerExpired+  ) where++import Control.Concurrent.STM+import Data.IORef+import Data.List (intersperse)+import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import GHC.Event+import System.Log.FastLogger++import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Qlog+import Network.QUIC.Types++----------------------------------------------------------------++data SentPacket = SentPacket {+    spPlainPacket       :: PlainPacket+  , spTimeSent          :: TimeMicrosecond+  , spSentBytes         :: Int+  , spEncryptionLevel   :: EncryptionLevel+  , spPacketNumber      :: PacketNumber+  , spPeerPacketNumbers :: PeerPacketNumbers+  , spAckEliciting      :: Bool+  } deriving (Eq, Show)++instance Ord SentPacket where+    x <= y = spPacketNumber x <= spPacketNumber y++newtype LostPacket = LostPacket SentPacket++mkSentPacket :: PacketNumber -> EncryptionLevel -> PlainPacket -> PeerPacketNumbers -> Bool -> SentPacket+mkSentPacket mypn lvl ppkt ppns ackeli = SentPacket {+    spPlainPacket       = ppkt+  , spTimeSent          = timeMicrosecond0+  , spSentBytes         = 0+  , spEncryptionLevel   = lvl+  , spPacketNumber      = mypn+  , spPeerPacketNumbers = ppns+  , spAckEliciting      = ackeli+  }++fixSentPacket :: SentPacket -> Int -> Int -> SentPacket+fixSentPacket spkt bytes padLen = spkt {+    spPlainPacket = if padLen /= 0 then addPadding padLen $ spPlainPacket spkt+                                   else spPlainPacket spkt+  , spSentBytes   = bytes+  }++addPadding :: Int -> PlainPacket -> PlainPacket+addPadding n (PlainPacket hdr plain) = PlainPacket hdr plain'+  where+    plain' = plain {+        plainFrames = plainFrames plain ++ [Padding n]+      }++----------------------------------------------------------------++newtype SentPackets = SentPackets (Seq SentPacket) deriving Eq++emptySentPackets :: SentPackets+emptySentPackets = SentPackets Seq.empty++----------------------------------------------------------------++data RTT = RTT {+  -- | The most recent RTT measurement made when receiving an ack for+  --   a previously unacked packet.+    latestRTT   :: Microseconds+  -- | The smoothed RTT of the connection.+  , smoothedRTT :: Microseconds+  -- | The RTT variation.+  , rttvar      :: Microseconds+  -- | The minimum RTT seen in the connection, ignoring ack delay.+  , minRTT      :: Microseconds+  -- | The maximum amount of time by which the receiver intends to+  --   delay acknowledgments for packets in the ApplicationData packet+  --   number space.  The actual ack_delay in a received ACK frame may+  --   be larger due to late timers, reordering, or lost ACK frames.+  , maxAckDelay1RTT :: Microseconds+  -- | The number of times a PTO has been sent without receiving+  --  an ack.+  , ptoCount :: Int+  } deriving Show++-- | The RTT used before an RTT sample is taken.+kInitialRTT :: Microseconds+kInitialRTT = Microseconds 333000++initialRTT :: RTT+initialRTT = RTT {+    latestRTT       = Microseconds 0+  , smoothedRTT     = kInitialRTT+  , rttvar          = kInitialRTT .>>. 1+  , minRTT          = Microseconds 0+  , maxAckDelay1RTT = Microseconds 0+  , ptoCount        = 0+  }++----------------------------------------------------------------++data CCMode = SlowStart+            | Avoidance+            | Recovery+            deriving (Eq)++instance Show CCMode where+    show SlowStart = "slow_start"+    show Avoidance = "avoidance"+    show Recovery  = "recovery"++data CC = CC {+  -- | The sum of the size in bytes of all sent packets that contain+  --   at least one ack-eliciting or PADDING frame, and have not been+  --   acked or declared lost.  The size does not include IP or UDP+  --   overhead, but does include the QUIC header and AEAD overhead.+  --   Packets only containing ACK frames do not count towards+  --   bytes_in_flight to ensure congestion control does not impede+  --   congestion feedback.+    bytesInFlight :: Int+  -- | Maximum number of bytes-in-flight that may be sent.+  , congestionWindow :: Int+  -- | The time when QUIC first detects congestion due to loss or ECN,+  --   causing it to enter congestion recovery.  When a packet sent+  --   after this time is acknowledged, QUIC exits congestion+  --   recovery.+  , congestionRecoveryStartTime :: Maybe TimeMicrosecond+  -- | Slow start threshold in bytes.  When the congestion window is+  --   below ssthresh, the mode is slow start and the window grows by+  --   the number of bytes acknowledged.+  , ssthresh :: Int+  -- | Records number of bytes acked, and used for incrementing+  --   the congestion window during congestion avoidance.+  , bytesAcked :: Int+  , numOfAckEliciting :: Int+  , ccMode :: CCMode+  } deriving Show++initialCC :: CC+initialCC = CC {+    bytesInFlight = 0+  , congestionWindow = 0+  , congestionRecoveryStartTime = Nothing+  , ssthresh = maxBound+  , bytesAcked = 0+  , numOfAckEliciting = 0+  , ccMode = SlowStart+  }++----------------------------------------------------------------++data LossDetection = LossDetection {+    largestAckedPacket           :: PacketNumber+  , previousAckInfo              :: AckInfo+  , timeOfLastAckElicitingPacket :: TimeMicrosecond+  , lossTime                     :: Maybe TimeMicrosecond+  } deriving Show++initialLossDetection :: LossDetection+initialLossDetection = LossDetection (-1) ackInfo0 timeMicrosecond0 Nothing++----------------------------------------------------------------++newtype MetricsDiff = MetricsDiff [(String,Int)]++----------------------------------------------------------------++data TimerType = LossTime+               | PTO+               deriving Eq++instance Show TimerType where+    show LossTime = "loss_time"+    show PTO      = "pto"++data TimerExpired = TimerExpired++data TimerCancelled = TimerCancelled++data TimerInfo = TimerInfo {+    timerTime  :: TimeMicrosecond+  , timerLevel :: EncryptionLevel+  , timerType  :: TimerType+  } deriving (Eq, Show)++data TimerInfoQ = Empty+                | Next TimerInfo+                deriving (Eq)++----------------------------------------------------------------++makeSpaceDiscarded :: IO (Array EncryptionLevel (IORef Bool))+makeSpaceDiscarded = do+    i1 <- newIORef False+    i2 <- newIORef False+    i3 <- newIORef False+    i4 <- newIORef False+    let lst = [(InitialLevel,i1),(RTT0Level,i2),(HandshakeLevel,i3),(RTT1Level,i4)]+        arr = array (InitialLevel,RTT1Level) lst+    return arr++makeSentPackets :: IO (Array EncryptionLevel (IORef SentPackets))+makeSentPackets = do+    i1 <- newIORef emptySentPackets+    i2 <- newIORef emptySentPackets+    i3 <- newIORef emptySentPackets+    let lst = [(InitialLevel,i1),(HandshakeLevel,i2),(RTT1Level,i3)]+        arr = array (InitialLevel,RTT1Level) lst+    return arr++makeLossDetection :: IO (Array EncryptionLevel (IORef LossDetection))+makeLossDetection = do+    i1 <- newIORef initialLossDetection+    i2 <- newIORef initialLossDetection+    i3 <- newIORef initialLossDetection+    let lst = [(InitialLevel,i1),(HandshakeLevel,i2),(RTT1Level,i3)]+        arr = array (InitialLevel,RTT1Level) lst+    return arr++data LDCC = LDCC {+    ldccState         :: ConnState+  , ldccQlogger       :: QLogger+  , putRetrans        :: PlainPacket -> IO ()+  , recoveryRTT       :: IORef RTT+  , recoveryCC        :: TVar CC+  , spaceDiscarded    :: Array EncryptionLevel (IORef Bool)+  , sentPackets       :: Array EncryptionLevel (IORef SentPackets)+  , lossDetection     :: Array EncryptionLevel (IORef LossDetection)+  -- The current timer key+  , timerKey          :: IORef (Maybe TimeoutKey)+  -- The current timer value+  , timerInfo         :: IORef (Maybe TimerInfo)+  , lostCandidates    :: TVar SentPackets+  , ptoPing           :: TVar (Maybe EncryptionLevel)+  , speedingUp        :: IORef Bool+  , pktNumPersistent  :: IORef PacketNumber+  , peerPacketNumbers :: Array EncryptionLevel (IORef PeerPacketNumbers)+  , previousRTT1PPNs  :: IORef PeerPacketNumbers -- for RTT1+  -- Pending timer value+  , timerInfoQ        :: TVar TimerInfoQ+  }++makePPN :: IO (Array EncryptionLevel (IORef PeerPacketNumbers))+makePPN = do+    ref1 <- newIORef emptyPeerPacketNumbers+    ref2 <- newIORef emptyPeerPacketNumbers+    ref3 <- newIORef emptyPeerPacketNumbers+    -- using the ref for RTT0Level and RTT1Level+    let lst = [(InitialLevel,   ref1)+              ,(RTT0Level,      ref3)+              ,(HandshakeLevel, ref2)+              ,(RTT1Level,      ref3)]+        arr = array (InitialLevel,RTT1Level) lst+    return arr++newLDCC :: ConnState -> QLogger -> (PlainPacket -> IO ()) -> IO LDCC+newLDCC cs qLog put = LDCC cs qLog put+    <$> newIORef initialRTT+    <*> newTVarIO initialCC+    <*> makeSpaceDiscarded+    <*> makeSentPackets+    <*> makeLossDetection+    <*> newIORef Nothing+    <*> newIORef Nothing+    <*> newTVarIO emptySentPackets+    <*> newTVarIO Nothing+    <*> newIORef False+    <*> newIORef maxBound+    <*> makePPN+    <*> newIORef emptyPeerPacketNumbers+    <*> newTVarIO Empty++instance KeepQlog LDCC where+    keepQlog = ldccQlogger++instance Connector LDCC where+    getRole            = role . ldccState+    getEncryptionLevel = readTVarIO . encryptionLevel . ldccState+    getMaxPacketSize   = readIORef  . maxPacketSize   . ldccState+    getConnectionState = readTVarIO . connectionState . ldccState+    getPacketNumber    = readIORef  . packetNumber    . ldccState+    getAlive           = readIORef  . connectionAlive . ldccState++----------------------------------------------------------------++instance Qlog SentPacket where+    qlog SentPacket{..} = "{\"raw\":{\"length\":" <> sw spSentBytes <> "},\"header\":{\"packet_type\":\"" <> toLogStr (packetType hdr) <> "\",\"packet_number\":\"" <> sw plainPacketNumber <> "\",\"dcid\":\"" <> sw (headerMyCID hdr) <> "\"},\"frames\":" <> "[" <> foldr (<>) "" (intersperse "," (map qlog plainFrames)) <> "]" <> "}"+      where+        PlainPacket hdr Plain{..} = spPlainPacket++instance Qlog LostPacket where+    qlog (LostPacket SentPacket{..}) =+        "{\"header\":{\"packet_type\":\"" <> toLogStr (packetType hdr) <> "\"" <>+        ",\"packet_number\":" <> sw spPacketNumber <>+        "}}"+      where+        PlainPacket hdr _ = spPlainPacket++instance Qlog MetricsDiff where+    qlog (MetricsDiff []) = "{}"+    qlog (MetricsDiff (x:xs)) = "{" <> tv0 x <> foldr tv "" xs <> "}"+      where+        tv0 (tag,val)    =  "\"" <> toLogStr tag <> "\":" <> sw val+        tv (tag,val) pre = ",\"" <> toLogStr tag <> "\":" <> sw val <> pre++instance Qlog CCMode where+    qlog mode = "{\"new\":\"" <> sw mode <> "\"}"++instance Qlog TimerCancelled where+    qlog TimerCancelled = "{\"event_type\":\"cancelled\"}"++instance Qlog TimerExpired where+    qlog TimerExpired   = "{\"event_type\":\"expired\"}"++instance Qlog (TimerInfo,Microseconds) where+    qlog (TimerInfo{..},us) = "{\"event_type\":\"set\"" <>+                             ",\"timer_type\":\"" <> sw timerType <> "\"" <>+                             ",\"packet_number_space\":\"" <> packetNumberSpace timerLevel <> "\"" <>+                             ",\"delta\":" <> delta us <>+                             "}"++packetNumberSpace :: EncryptionLevel -> LogStr+packetNumberSpace InitialLevel   = "initial"+packetNumberSpace RTT0Level      = "application_data"+packetNumberSpace HandshakeLevel = "handshake"+packetNumberSpace RTT1Level      = "application_data"++delta :: Microseconds -> LogStr+delta (Microseconds n) = sw n++qlogSent :: (KeepQlog q, Qlog pkt) => q -> pkt -> TimeMicrosecond -> IO ()+qlogSent q pkt tim = keepQlog q $ QSent (qlog pkt) tim++qlogMetricsUpdated :: KeepQlog q => q -> MetricsDiff -> IO ()+qlogMetricsUpdated q m = do+    tim <- getTimeMicrosecond+    keepQlog q $ QMetricsUpdated (qlog m) tim++qlogPacketLost :: KeepQlog q => q -> LostPacket -> IO ()+qlogPacketLost q lpkt = do+    tim <- getTimeMicrosecond+    keepQlog q $ QPacketLost (qlog lpkt) tim++qlogContestionStateUpdated :: KeepQlog q => q -> CCMode -> IO ()+qlogContestionStateUpdated q mode = do+    tim <- getTimeMicrosecond+    keepQlog q $ QCongestionStateUpdated (qlog mode) tim++qlogLossTimerUpdated :: KeepQlog q => q -> (TimerInfo,Microseconds) -> IO ()+qlogLossTimerUpdated q tmi = do+    tim <- getTimeMicrosecond+    keepQlog q $ QLossTimerUpdated (qlog tmi) tim++qlogLossTimerCancelled :: KeepQlog q => q -> IO ()+qlogLossTimerCancelled q = do+    tim <- getTimeMicrosecond+    keepQlog q $ QLossTimerUpdated (qlog TimerCancelled) tim++qlogLossTimerExpired :: KeepQlog q => q -> IO ()+qlogLossTimerExpired q = do+    tim <- getTimeMicrosecond+    keepQlog q $ QLossTimerUpdated (qlog TimerExpired) tim
+ Network/QUIC/Recovery/Utils.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Recovery.Utils (+    retransmit+  , sendPing+  , mergeLostCandidates+  , mergeLostCandidatesAndClear+  , peerCompletedAddressValidation+  , countAckEli+  , inCongestionRecovery+  , delay+  ) where++import Control.Concurrent+import Control.Concurrent.STM+import Data.Sequence (Seq, (<|), ViewL(..))+import qualified Data.Sequence as Seq++import Network.QUIC.Connector+import Network.QUIC.Imports+import Network.QUIC.Recovery.Types+import Network.QUIC.Types++----------------------------------------------------------------++retransmit :: LDCC -> Seq SentPacket -> IO ()+retransmit ldcc lostPackets+  | null packetsToBeResent = getEncryptionLevel ldcc >>= sendPing ldcc+  | otherwise              = mapM_ put packetsToBeResent+  where+    packetsToBeResent = Seq.filter spAckEliciting lostPackets+    put = putRetrans ldcc . spPlainPacket++----------------------------------------------------------------++sendPing :: LDCC -> EncryptionLevel -> IO ()+sendPing LDCC{..} lvl = do+    now <- getTimeMicrosecond+    atomicModifyIORef'' (lossDetection ! lvl) $ \ld -> ld {+        timeOfLastAckElicitingPacket = now+      }+    atomically $ writeTVar ptoPing $ Just lvl++----------------------------------------------------------------++mergeLostCandidates :: LDCC -> Seq SentPacket -> IO ()+mergeLostCandidates LDCC{..} lostPackets = atomically $ do+    SentPackets old <- readTVar lostCandidates+    let new = merge old lostPackets+    writeTVar lostCandidates $ SentPackets new++mergeLostCandidatesAndClear :: LDCC -> Seq SentPacket -> IO (Seq SentPacket)+mergeLostCandidatesAndClear LDCC{..} lostPackets = atomically $ do+    SentPackets old <- readTVar lostCandidates+    writeTVar lostCandidates emptySentPackets+    return $ merge old lostPackets++merge :: Seq SentPacket -> Seq SentPacket -> Seq SentPacket+merge s1 s2 = case Seq.viewl s1 of+  EmptyL   -> s2+  x :< s1' -> case Seq.viewl s2 of+    EmptyL  -> s1+    y :< s2'+      | spPacketNumber x < spPacketNumber y -> x <| merge s1' s2+      | otherwise                           -> y <| merge s1 s2'++----------------------------------------------------------------++-- Sec 6.2.1. Computing PTO+-- "That is, a client does not reset the PTO backoff factor on+--  receiving acknowledgements until it receives a HANDSHAKE_DONE+--  frame or an acknowledgement for one of its Handshake or 1-RTT+--  packets."+peerCompletedAddressValidation :: LDCC -> IO Bool+-- For servers: assume clients validate the server's address implicitly.+peerCompletedAddressValidation ldcc+  | isServer ldcc = return True+-- For clients: servers complete address validation when a protected+-- packet is received.+peerCompletedAddressValidation ldcc = isConnectionEstablished ldcc++----------------------------------------------------------------++countAckEli :: SentPacket -> Int+countAckEli sentPacket+  | spAckEliciting sentPacket = 1+  | otherwise                 = 0++----------------------------------------------------------------++inCongestionRecovery :: TimeMicrosecond -> Maybe TimeMicrosecond -> Bool+inCongestionRecovery _ Nothing = False+inCongestionRecovery sentTime (Just crst) = sentTime <= crst++----------------------------------------------------------------++delay :: Microseconds -> IO ()+delay (Microseconds microseconds) = threadDelay microseconds
+ Network/QUIC/Sender.hs view
@@ -0,0 +1,424 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Sender (+    sender+  , mkHeader+  ) where++import Control.Concurrent+import Control.Concurrent.STM+import qualified Data.ByteString as BS+import Foreign.Marshal.Alloc+import Foreign.Ptr (plusPtr)+import qualified UnliftIO.Exception as E++import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Exception+import Network.QUIC.Imports+import Network.QUIC.Packet+import Network.QUIC.Qlog+import Network.QUIC.Recovery+import Network.QUIC.Stream+import Network.QUIC.Types++----------------------------------------------------------------++cryptoFrame :: Connection -> CryptoData -> EncryptionLevel -> IO Frame+cryptoFrame conn crypto lvl = do+    let len = BS.length crypto+    mstrm <- getCryptoStream conn lvl+    case mstrm of+      Nothing   -> E.throwIO MustNotReached+      Just strm -> do+          off <- getTxStreamOffset strm len+          return $ CryptoF off crypto++----------------------------------------------------------------++sendPacket :: Connection -> SendBuf -> Buffer -> [SentPacket] -> IO ()+sendPacket _ _ _ [] = return ()+sendPacket conn send buf0 spkts0 = getMaxPacketSize conn >>= go+  where+    ldcc = connLDCC conn+    go maxSiz = do+        mx <- atomically ((Just    <$> takePingSTM ldcc)+                 `orElse` (Nothing <$  checkWindowOpenSTM ldcc maxSiz))+        case mx of+          Just lvl | lvl `elem` [InitialLevel,HandshakeLevel] -> do+            sendPingPacket conn send buf0 lvl+            go maxSiz+          _ -> do+            when (isJust mx) $ qlogDebug conn $ Debug "probe new"+            let bufsiz = maximumUdpPayloadSize+            (sentPackets, leftsiz) <- buildPackets buf0 bufsiz maxSiz spkts0 id+            let bytes = bufsiz - leftsiz+            when (isServer conn) $ waitAntiAmplificationFree conn bytes+            now <- getTimeMicrosecond+            send buf0 bytes+            addTxBytes conn bytes+            forM_ sentPackets $ \sentPacket0 -> do+                let sentPacket = sentPacket0 { spTimeSent = now }+                qlogSent conn sentPacket now+                onPacketSent ldcc sentPacket+    buildPackets _ _ _ [] _ = error "sendPacket: buildPackets"+    buildPackets buf bufsiz siz [spkt] build0 = do+        let pkt = spPlainPacket spkt+        (bytes,padlen) <- encodePlainPacket conn buf bufsiz pkt $ Just siz+        if bytes < 0 then+            return (build0 [], bufsiz)+          else do+            let sentPacket = fixSentPacket spkt bytes padlen+            return (build0 [sentPacket], bufsiz - bytes)+    buildPackets buf bufsiz siz (spkt:spkts) build0 = do+        let pkt = spPlainPacket spkt+        (bytes,padlen) <- encodePlainPacket conn buf bufsiz pkt Nothing+        if bytes < 0 then+            buildPackets buf bufsiz siz spkts build0+          else do+            let sentPacket = fixSentPacket spkt bytes padlen+            let build0' = build0 . (sentPacket :)+                buf' = buf `plusPtr` bytes+                bufsiz' = bufsiz - bytes+                siz' = siz - spSentBytes sentPacket+            buildPackets buf' bufsiz' siz' spkts build0'++----------------------------------------------------------------++sendPingPacket :: Connection -> SendBuf -> Buffer -> EncryptionLevel -> IO ()+sendPingPacket conn send buf lvl = do+    maxSiz <- getMaxPacketSize conn+    ok <- if isClient conn then return True+          else checkAntiAmplificationFree conn maxSiz+    when ok $ do+        let ldcc = connLDCC conn+        mp <- releaseOldest ldcc lvl+        frames <- case mp of+          Nothing -> do+              qlogDebug conn $ Debug "probe ping"+              return [Ping]+          Just spkt -> do+              qlogDebug conn $ Debug "probe old"+              let PlainPacket _ plain0 = spPlainPacket spkt+              adjustForRetransmit conn $ plainFrames plain0+        xs <- construct conn lvl frames+        if null xs then+            qlogDebug conn $ Debug "ping NULL"+          else do+            let spkt = last xs+                ping = spPlainPacket spkt+                bufsiz = maximumUdpPayloadSize+            (bytes,padlen) <- encodePlainPacket conn buf bufsiz ping (Just maxSiz)+            when (bytes >= 0) $ do+                now <- getTimeMicrosecond+                send buf bytes+                addTxBytes conn bytes+                let sentPacket0 = fixSentPacket spkt bytes padlen+                    sentPacket = sentPacket0 { spTimeSent = now }+                qlogSent conn sentPacket now+                onPacketSent ldcc sentPacket++----------------------------------------------------------------++construct :: Connection+          -> EncryptionLevel+          -> [Frame]+          -> IO [SentPacket]+construct conn lvl frames = do+    discarded <- getPacketNumberSpaceDiscarded ldcc lvl+    if discarded then+        return []+      else do+        established <- isConnectionEstablished conn+        if established || (isServer conn && lvl == HandshakeLevel) then do+            constructTargetPacket+          else do+            ppkt0 <- constructLowerAckPacket+            ppkt1 <- constructTargetPacket+            return (ppkt0 ++ ppkt1)+  where+    ldcc = connLDCC conn+    constructLowerAckPacket = do+        let lvl' = case lvl of+              HandshakeLevel -> InitialLevel+              RTT1Level      -> HandshakeLevel+              _              -> RTT1Level+        if lvl' == RTT1Level then+            return []+          else do+            ppns <- getPeerPacketNumbers ldcc lvl'+            if nullPeerPacketNumbers ppns then+                return []+              else+                mkPlainPacket conn lvl' [] ppns+    constructTargetPacket+      | null frames = do -- ACK only packet+            resetDealyedAck conn+            ppns <- getPeerPacketNumbers ldcc lvl+            if nullPeerPacketNumbers ppns then+                return []+              else+                if lvl == RTT1Level then do+                    prevppns <- getPreviousRTT1PPNs ldcc+                    if ppns /= prevppns then do+                        setPreviousRTT1PPNs ldcc ppns+                        mkPlainPacket conn lvl [] ppns+                     else+                       return []+                  else+                    mkPlainPacket conn lvl [] ppns+      | otherwise = do+            resetDealyedAck conn+            ppns <- getPeerPacketNumbers ldcc lvl+            mkPlainPacket conn lvl frames ppns++mkPlainPacket :: Connection -> EncryptionLevel -> [Frame] -> PeerPacketNumbers -> IO [SentPacket]+mkPlainPacket conn lvl frames0 ppns = do+    let ackEli | null frames0 = False+               | otherwise    = True+        frames | nullPeerPacketNumbers ppns = frames0+               | otherwise                  = mkAck ppns : frames0+    header <- mkHeader conn lvl+    mypn <- nextPacketNumber conn+    let convert = onPlainCreated $ connHooks conn+        plain = convert lvl $ Plain (Flags 0) mypn frames 0+        ppkt = PlainPacket header plain+    return [mkSentPacket mypn lvl ppkt ppns ackEli]+  where+    mkAck ps = Ack (toAckInfo $ fromPeerPacketNumbers ps) 0++mkHeader :: Connection -> EncryptionLevel -> IO Header+mkHeader conn lvl = do+    ver <- getVersion conn+    mycid <- getMyCID conn+    peercid <- getPeerCID conn+    token <- if lvl == InitialLevel then getToken conn else return ""+    return $ case lvl of+      InitialLevel   -> Initial   ver peercid mycid token+      RTT0Level      -> RTT0      ver peercid mycid+      HandshakeLevel -> Handshake ver peercid mycid+      RTT1Level      -> Short         peercid++----------------------------------------------------------------++data Switch = SwPing EncryptionLevel+            | SwOut  Output+            | SwStrm TxStreamData++sender :: Connection -> SendBuf -> IO ()+sender conn send = handleLogT logAction $+    E.bracket (mallocBytes (maximumUdpPayloadSize * 2))+              free+              body+  where+    body buf = forever $ do+        x <- atomically ((SwPing <$> takePingSTM (connLDCC conn))+                `orElse` (SwOut  <$> takeOutputSTM conn)+                `orElse` (SwStrm <$> takeSendStreamQSTM conn))+        case x of+          SwPing lvl -> sendPingPacket   conn send buf lvl+          SwOut  out -> sendOutput       conn send buf out+          SwStrm tx  -> sendTxStreamData conn send buf tx+    logAction msg = connDebugLog conn ("debug: sender: " <> msg)++----------------------------------------------------------------++discardClientInitialPacketNumberSpace :: Connection -> IO ()+discardClientInitialPacketNumberSpace conn+  | isClient conn = do+        let ldcc = connLDCC conn+        discarded <- getAndSetPacketNumberSpaceDiscarded ldcc InitialLevel+        unless discarded $ do+            dropSecrets conn InitialLevel+            clearCryptoStream conn InitialLevel+            onPacketNumberSpaceDiscarded ldcc InitialLevel+  | otherwise = return ()++sendOutput :: Connection -> SendBuf -> Buffer -> Output -> IO ()+sendOutput conn send buf (OutControl lvl frames action) = do+    construct conn lvl frames >>= sendPacket conn send buf+    when (lvl == HandshakeLevel) $ discardClientInitialPacketNumberSpace conn+    action++sendOutput conn send buf (OutHandshake lcs0) = do+    let convert = onTLSHandshakeCreated $ connHooks conn+        (lcs,wait) = convert lcs0+    -- only for h3spec+    when wait $ wait0RTTReady conn+    sendCryptoFragments conn send buf lcs+    when (any (\(l,_) -> l == HandshakeLevel) lcs) $+        discardClientInitialPacketNumberSpace conn+sendOutput conn send buf (OutRetrans (PlainPacket hdr0 plain0)) = do+    frames <- adjustForRetransmit conn $ plainFrames plain0+    let lvl = levelFromHeader hdr0+    construct conn lvl frames >>= sendPacket conn send buf++levelFromHeader :: Header -> EncryptionLevel+levelFromHeader hdr+    | lvl == RTT0Level = RTT1Level+    | otherwise        = lvl+  where+    lvl = packetEncryptionLevel hdr++adjustForRetransmit :: Connection -> [Frame] -> IO [Frame]+adjustForRetransmit _    [] = return []+adjustForRetransmit conn (Padding{}:xs) = adjustForRetransmit conn xs+adjustForRetransmit conn (Ack{}:xs)     = adjustForRetransmit conn xs+adjustForRetransmit conn (MaxStreamData sid _:xs) = do+    mstrm <- findStream conn sid+    case mstrm of+      Nothing   -> adjustForRetransmit conn xs+      Just strm -> do+          newMax <- getRxMaxStreamData strm+          let r = MaxStreamData sid newMax+          rs <- adjustForRetransmit conn xs+          return (r : rs)+adjustForRetransmit conn (MaxData{}:xs) = do+    newMax <- getRxMaxData conn+    let r = MaxData newMax+    rs <- adjustForRetransmit conn xs+    return (r : rs)+adjustForRetransmit conn (x:xs) = do+    rs <- adjustForRetransmit conn xs+    return (x : rs)++limitationC :: Int+limitationC = 1024++thresholdC :: Int+thresholdC = 200++sendCryptoFragments :: Connection -> SendBuf -> Buffer -> [(EncryptionLevel, CryptoData)] -> IO ()+sendCryptoFragments _ _ _ [] = return ()+sendCryptoFragments conn send buf lcs = do+    loop limitationC id lcs+  where+    loop :: Int -> ([SentPacket] -> [SentPacket]) -> [(EncryptionLevel, CryptoData)] -> IO ()+    loop _ build0 [] = do+        let spkts0 = build0 []+        unless (null spkts0) $ sendPacket conn send buf spkts0+    loop len0 build0 ((lvl, bs) : xs) | BS.length bs > len0 = do+        let (target, rest) = BS.splitAt len0 bs+        frame1 <- cryptoFrame conn target lvl+        spkts1 <- construct conn lvl [frame1]+        sendPacket conn send buf $ build0 spkts1+        loop limitationC id ((lvl, rest) : xs)+    loop _ build0 [(lvl, bs)] = do+        frame1 <- cryptoFrame conn bs lvl+        spkts1 <- construct conn lvl [frame1]+        sendPacket conn send buf $ build0 spkts1+    loop len0 build0 ((lvl, bs) : xs) | len0 - BS.length bs < thresholdC = do+        frame1 <- cryptoFrame conn bs lvl+        spkts1 <- construct conn lvl [frame1]+        sendPacket conn send buf $ build0 spkts1+        loop limitationC id xs+    loop len0 build0 ((lvl, bs) : xs) = do+        frame1 <- cryptoFrame conn bs lvl+        spkts1 <- construct conn lvl [frame1]+        let len1 = len0 - BS.length bs+            build1 = build0 . (spkts1 ++)+        loop len1 build1 xs++----------------------------------------------------------------++threshold :: Int+threshold  =  832++limitation :: Int+limitation = 1040++packFin :: Connection -> Stream -> Bool -> IO Bool+packFin _    _ True  = return True+packFin conn s False = do+    mx <- tryPeekSendStreamQ conn+    case mx of+      Just (TxStreamData s1 [] 0 True)+          | streamId s == streamId s1 -> do+                _ <- takeSendStreamQ conn+                return True+      _ -> return False++sendTxStreamData :: Connection -> SendBuf -> Buffer -> TxStreamData -> IO ()+sendTxStreamData conn send buf (TxStreamData s dats len fin0) = do+    fin <- packFin conn s fin0+    if len < limitation then do+        sendStreamSmall conn send buf s dats fin len+      else+        sendStreamLarge conn send buf s dats fin++sendStreamSmall :: Connection -> SendBuf -> Buffer -> Stream -> [StreamData] -> Bool -> Int -> IO ()+sendStreamSmall conn send buf s0 dats0 fin0 len0 = do+    off0 <- getTxStreamOffset s0 len0+    let sid0 = streamId s0+        frame0 = StreamF sid0 off0 dats0 fin0+    frames <- loop s0 frame0 len0 id+    ready <- isConnection1RTTReady conn+    let lvl | ready     = RTT1Level+            | otherwise = RTT0Level+    construct conn lvl frames >>= sendPacket conn send buf+  where+    tryPeek = do+        mx <- tryPeekSendStreamQ conn+        case mx of+          Nothing -> do+              yield+              tryPeekSendStreamQ conn+          Just _ -> return mx+    loop :: Stream -> Frame -> Int -> ([Frame] -> [Frame]) -> IO [Frame]+    loop s frame total build = do+        mx <- tryPeek+        case mx of+          Nothing -> return $ build [frame]+          Just (TxStreamData s1 dats1 len1 fin1) -> do+              let total1 = len1 + total+              if total1 < limitation then do+                  _ <- takeSendStreamQ conn -- cf tryPeek+                  fin1' <- packFin conn s fin1 -- must be after takeSendStreamQ+                  off1 <- getTxStreamOffset s1 len1+                  let sid  = streamId s+                      sid1 = streamId s1+                  if sid == sid1 then do+                      let StreamF _ off dats _ = frame+                          frame1 = StreamF sid off (dats ++ dats1) fin1'+                      loop s1 frame1 total1 build+                    else do+                      let frame1 = StreamF sid1 off1 dats1 fin1'+                          build1 = build . (frame :)+                      loop s1 frame1 total1 build1+                else+                  return $ build [frame]++sendStreamLarge :: Connection -> SendBuf -> Buffer -> Stream -> [ByteString] -> Bool -> IO ()+sendStreamLarge conn send buf s dats0 fin0 = loop dats0+  where+    sid = streamId s+    loop [] = return ()+    loop dats = do+        let (dats1,dats2) = splitChunks dats+            len = totalLen dats1+        off <- getTxStreamOffset s len+        let fin = fin0 && null dats2+            frame = StreamF sid off dats1 fin+        ready <- isConnection1RTTReady conn+        let lvl | ready     = RTT1Level+                | otherwise = RTT0Level+        construct conn lvl [frame] >>= sendPacket conn send buf+        loop dats2++-- Typical case: [3, 1024, 1024, 1024, 200]+splitChunks :: [ByteString] -> ([ByteString],[ByteString])+splitChunks bs0 = loop bs0 0 id+  where+    loop [] _  build    = let curr = build [] in (curr, [])+    loop bbs@(b:bs) siz0 build+      | siz <= threshold  = let build' = build . (b :) in loop bs siz build'+      | siz <= limitation = let curr = build [b] in (curr, bs)+      | len >  limitation = let (u,b') = BS.splitAt (limitation - siz0) b+                                curr = build [u]+                                bs' = b':bs+                            in (curr,bs')+      | otherwise         = let curr = build [] in (curr, bbs)+      where+        len = BS.length b+        siz = siz0 + len
+ Network/QUIC/Server.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE PatternSynonyms #-}++-- | This main module provides APIs for QUIC servers.+module Network.QUIC.Server (+  -- * Running a QUIC server+    run+  , stop+  -- * Configuration+  , ServerConfig+  , defaultServerConfig+  , scAddresses+  , scALPN+  , scRequireRetry+  , scUse0RTT+  , scCiphers+  , scGroups+--   , scParameters+  , scCredentials+  , scSessionManager+  -- * Certificate+  , clientCertificateChain+  ) where++import Data.X509 (CertificateChain)++import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Server.Run++----------------------------------------------------------------++-- | Getting a certificate chain of a client.+clientCertificateChain :: Connection -> IO (Maybe CertificateChain)+clientCertificateChain conn+  | isClient conn = return Nothing+  | otherwise     = getCertificateChain conn
+ Network/QUIC/Server/Reader.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Server.Reader (+    Dispatch+  , newDispatch+  , clearDispatch+  , runDispatcher+  , tokenMgr+  -- * Accepting+  , accept+  , Accept(..)+  -- * Receiving and reading+  , RecvQ+  , recvServer+  , readerServer+  ) where++import Control.Concurrent+import Control.Concurrent.STM+import qualified Crypto.Token as CT+import qualified Data.ByteString as BS+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import Data.OrdPSQ (OrdPSQ)+import qualified Data.OrdPSQ as PSQ+import Foreign.Marshal.Alloc+import qualified GHC.IO.Exception as E+import Network.ByteOrder+import Network.Socket hiding (accept, Debug)+import qualified Network.Socket.ByteString as NSB+import qualified System.IO.Error as E+import System.Log.FastLogger+import qualified UnliftIO.Exception as E++import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Connector+import Network.QUIC.Exception+import Network.QUIC.Imports+import Network.QUIC.Logger+import Network.QUIC.Packet+import Network.QUIC.Parameters+import Network.QUIC.Qlog+import Network.QUIC.Socket+import Network.QUIC.Types++----------------------------------------------------------------++data Dispatch = Dispatch {+    tokenMgr :: CT.TokenManager+  , dstTable :: IORef ConnectionDict+  , srcTable :: IORef RecvQDict+  , acceptQ  :: AcceptQ+  }++newDispatch :: IO Dispatch+newDispatch = Dispatch <$> CT.spawnTokenManager CT.defaultConfig+                       <*> newIORef emptyConnectionDict+                       <*> newIORef emptyRecvQDict+                       <*> newAcceptQ++clearDispatch :: Dispatch -> IO ()+clearDispatch d = CT.killTokenManager $ tokenMgr d++----------------------------------------------------------------++newtype ConnectionDict = ConnectionDict (Map CID Connection)++emptyConnectionDict :: ConnectionDict+emptyConnectionDict = ConnectionDict M.empty++lookupConnectionDict :: IORef ConnectionDict -> CID -> IO (Maybe Connection)+lookupConnectionDict ref cid = do+    ConnectionDict tbl <- readIORef ref+    return $ M.lookup cid tbl++registerConnectionDict :: IORef ConnectionDict -> CID -> Connection -> IO ()+registerConnectionDict ref cid conn = atomicModifyIORef'' ref $+    \(ConnectionDict tbl) -> ConnectionDict $ M.insert cid conn tbl++unregisterConnectionDict :: IORef ConnectionDict -> CID -> IO ()+unregisterConnectionDict ref cid = atomicModifyIORef'' ref $+    \(ConnectionDict tbl) -> ConnectionDict $ M.delete cid tbl++----------------------------------------------------------------++-- Original destination CID -> RecvQ+data RecvQDict = RecvQDict Int (OrdPSQ CID Int RecvQ)++recvQDictSize :: Int+recvQDictSize = 100++emptyRecvQDict :: RecvQDict+emptyRecvQDict = RecvQDict 0 PSQ.empty++lookupRecvQDict :: IORef RecvQDict -> CID -> IO (Maybe RecvQ)+lookupRecvQDict ref dcid = do+    RecvQDict _ qt <- readIORef ref+    return $ case PSQ.lookup dcid qt of+      Nothing     -> Nothing+      Just (_,q)  -> Just q++insertRecvQDict :: IORef RecvQDict -> CID -> RecvQ -> IO ()+insertRecvQDict ref dcid q = atomicModifyIORef'' ref ins+  where+    ins (RecvQDict p qt0) = let qt1 | PSQ.size qt0 <= recvQDictSize = qt0+                                    | otherwise = PSQ.deleteMin qt0+                                qt2 = PSQ.insert dcid p q qt1+                                p' = p + 1 -- fixme: overflow+                            in RecvQDict p' qt2++----------------------------------------------------------------++data Accept = Accept {+    accVersion      :: Version+  , accMyAuthCIDs   :: AuthCIDs+  , accPeerAuthCIDs :: AuthCIDs+  , accMySockAddr   :: SockAddr+  , accPeerSockAddr :: SockAddr+  , accRecvQ        :: RecvQ+  , accPacketSize   :: Int+  , accRegister     :: CID -> Connection -> IO ()+  , accUnregister   :: CID -> IO ()+  , accAddressValidated :: Bool+  , accTime         :: TimeMicrosecond+  }++newtype AcceptQ = AcceptQ (TQueue Accept)++newAcceptQ :: IO AcceptQ+newAcceptQ = AcceptQ <$> newTQueueIO++readAcceptQ :: AcceptQ -> IO Accept+readAcceptQ (AcceptQ q) = atomically $ readTQueue q++writeAcceptQ :: AcceptQ -> Accept -> IO ()+writeAcceptQ (AcceptQ q) x = atomically $ writeTQueue q x++accept :: Dispatch -> IO Accept+accept = readAcceptQ . acceptQ++----------------------------------------------------------------++runDispatcher :: Dispatch -> ServerConfig -> (Socket, SockAddr) -> IO ThreadId+runDispatcher d conf ssa@(s,_) =+    forkFinally (dispatcher d conf ssa) $ \_ -> close s++dispatcher :: Dispatch -> ServerConfig -> (Socket, SockAddr) -> IO ()+dispatcher d conf (s,mysa) = handleLogUnit logAction $+    E.bracket (mallocBytes maximumUdpPayloadSize)+              free+              body+  where+    body buf = do+    --    let (opt,_cmsgid) = case mysa of+    --          SockAddrInet{}  -> (RecvIPv4PktInfo, CmsgIdIPv4PktInfo)+    --          SockAddrInet6{} -> (RecvIPv6PktInfo, CmsgIdIPv6PktInfo)+    --          _               -> error "dispatcher"+    --    setSocketOption s opt 1+        forever $ do+    --        (peersa, bs0, _cmsgs, _) <- recv+            (bs0, peersa) <- recv+            let bytes = BS.length bs0 -- both Initial and 0RTT+            now <- getTimeMicrosecond+            -- macOS overrides the local address of the socket+            -- if in_pktinfo is used.+            (pkt, bs0RTT) <- decodePacket bs0+    --        let send bs = void $ NSB.sendMsg s peersa [bs] cmsgs' 0+            let send bs = void $ NSB.sendTo s bs peersa+            dispatch d conf logAction pkt mysa peersa send buf bs0RTT bytes now+    doDebug = isJust $ scDebugLog conf+    logAction msg | doDebug   = stdoutLogger ("dispatch(er): " <> msg)+                  | otherwise = return ()+    recv = do+--        ex <- E.try $ NSB.recvMsg s maximumUdpPayloadSize 64 0+        ex <- E.tryAny $ NSB.recvFrom s maximumUdpPayloadSize+        case ex of+           Right x -> return x+           Left se -> case E.fromException se of+              Just e | E.ioeGetErrorType e == E.InvalidArgument -> E.throwIO se+              _ -> do+                  logAction $ "recv again: " <> bhow se+                  recv++----------------------------------------------------------------++-- If client initial is fragmented into multiple packets,+-- there is no way to put the all packets into a single queue.+-- Rather, each fragment packet is put into its own queue.+-- For the first fragment, handshake would successif others are+-- retransmitted.+-- For the other fragments, handshake will fail since its socket+-- cannot be connected.+dispatch :: Dispatch -> ServerConfig -> DebugLogger -> PacketI -> SockAddr -> SockAddr -> (ByteString -> IO ()) -> Buffer -> ByteString -> Int -> TimeMicrosecond -> IO ()+dispatch Dispatch{..} ServerConfig{..} logAction+         (PacketIC cpkt@(CryptPacket (Initial ver dCID sCID token) _) lvl)+         mysa peersa send _ bs0RTT bytes tim+  | bytes < defaultQUICPacketSize = do+        logAction $ "too small " <> bhow bytes <> ", " <> bhow peersa+  | ver `notElem` scVersions= do+        let vers | ver == GreasingVersion = GreasingVersion2 : scVersions+                 | otherwise = GreasingVersion : scVersions+        bss <- encodeVersionNegotiationPacket $ VersionNegotiationPacket sCID dCID vers+        send bss+  | token == "" = do+        mq <- lookupConnectionDict dstTable dCID+        case mq of+          Nothing+            | scRequireRetry -> sendRetry+            | otherwise      -> pushToAcceptFirst False+          _                  -> return ()+  | otherwise = do+        mct <- decryptToken tokenMgr token+        case mct of+          Just ct+            | isRetryToken ct -> do+                  ok <- isRetryTokenValid ct+                  if ok then pushToAcceptRetried ct else sendRetry+            | otherwise -> do+                  mq <- lookupConnectionDict dstTable dCID+                  case mq of+                    Nothing -> pushToAcceptFirst True+                    _       -> return ()+          _ -> sendRetry+  where+    pushToAcceptQ myAuthCIDs peerAuthCIDs key addrValid = do+        mq <- lookupRecvQDict srcTable key+        case mq of+          Just q -> writeRecvQ q $ mkReceivedPacket cpkt tim bytes lvl+          Nothing -> do+              q <- newRecvQ+              insertRecvQDict srcTable key q+              writeRecvQ q $ mkReceivedPacket cpkt tim bytes lvl+              let reg = registerConnectionDict dstTable+                  unreg = unregisterConnectionDict dstTable+                  ent = Accept {+                      accVersion      = ver+                    , accMyAuthCIDs   = myAuthCIDs+                    , accPeerAuthCIDs = peerAuthCIDs+                    , accMySockAddr   = mysa+                    , accPeerSockAddr = peersa+                    , accRecvQ        = q+                    , accPacketSize   = bytes+                    , accRegister     = reg+                    , accUnregister   = unreg+                    , accAddressValidated = addrValid+                    , accTime         = tim+                    }+              -- fixme: check acceptQ length+              writeAcceptQ acceptQ ent+              when (bs0RTT /= "") $ do+                  (PacketIC cpktRTT0 lvl', _) <- decodePacket bs0RTT+                  writeRecvQ q $ mkReceivedPacket cpktRTT0 tim bytes lvl'+    -- Initial: DCID=S1, SCID=C1 ->+    --                                     <- Initial: DCID=C1, SCID=S2+    --                               ...+    -- 1-RTT: DCID=S2 ->+    --                                                <- 1-RTT: DCID=C1+    --+    -- initial_source_connection_id       = S2   (newdCID)+    -- original_destination_connection_id = S1   (dCID)+    -- retry_source_connection_id         = Nothing+    pushToAcceptFirst addrValid = do+        newdCID <- newCID+        let myAuthCIDs = defaultAuthCIDs {+                initSrcCID  = Just newdCID+              , origDstCID  = Just dCID+              }+            peerAuthCIDs = defaultAuthCIDs {+                initSrcCID = Just sCID+              }+        pushToAcceptQ myAuthCIDs peerAuthCIDs dCID addrValid+    -- Initial: DCID=S1, SCID=C1 ->+    --                                       <- Retry: DCID=C1, SCID=S2+    -- Initial: DCID=S2, SCID=C1 ->+    --                                     <- Initial: DCID=C1, SCID=S3+    --                               ...+    -- 1-RTT: DCID=S3 ->+    --                                                <- 1-RTT: DCID=C1+    --+    -- initial_source_connection_id       = S3   (dCID)  S2 in our server+    -- original_destination_connection_id = S1   (o)+    -- retry_source_connection_id         = S2   (dCID)+    pushToAcceptRetried (CryptoToken _ _ (Just (_,_,o))) = do+        let myAuthCIDs = defaultAuthCIDs {+                initSrcCID  = Just dCID+              , origDstCID  = Just o+              , retrySrcCID = Just dCID+              }+            peerAuthCIDs = defaultAuthCIDs {+                initSrcCID = Just sCID+              }+        pushToAcceptQ myAuthCIDs peerAuthCIDs o True+    pushToAcceptRetried _ = return ()+    isRetryTokenValid (CryptoToken tver etim (Just (l,r,_))) = do+        diff <- getElapsedTimeMicrosecond etim+        return $ tver == ver+              && diff <= Microseconds 30000000 -- fixme+              && dCID == l+              && sCID == r+    isRetryTokenValid _ = return False+    sendRetry = do+        newdCID <- newCID+        retryToken <- generateRetryToken ver newdCID sCID dCID+        mnewtoken <- timeout (Microseconds 100000) $ encryptToken tokenMgr retryToken+        case mnewtoken of+          Nothing       -> logAction "retry token stacked"+          Just newtoken -> do+              bss <- encodeRetryPacket $ RetryPacket ver sCID newdCID newtoken (Left dCID)+              send bss+dispatch Dispatch{..} _ _+         (PacketIC cpkt@(CryptPacket (RTT0 _ o _) _) lvl) _ _peersa _ _ _ bytes tim = do+    mq <- lookupRecvQDict srcTable o+    case mq of+      Just q  -> writeRecvQ q $ mkReceivedPacket cpkt tim bytes lvl+      Nothing -> return ()+dispatch Dispatch{..} _ logAction+         (PacketIC (CryptPacket hdr@(Short dCID) crypt) lvl) mysa peersa _ buf _ bytes tim  = do+    -- fixme: packets for closed connections also match here.+    mx <- lookupConnectionDict dstTable dCID+    case mx of+      Nothing -> do+          logAction $ "CID no match: " <> bhow dCID <> ", " <> bhow peersa+      Just conn -> do+          let bufsiz = maximumUdpPayloadSize+          mplain <- decryptCrypt conn buf bufsiz crypt RTT1Level+          case mplain of+            Nothing -> connDebugLog conn "debug: dispatch: cannot decrypt"+            Just plain -> do+                alive <- getAlive conn+                when alive $ do+                    qlogReceived conn (PlainPacket hdr plain) tim+                    let cpkt' = CryptPacket hdr $ setCryptLogged crypt+                    writeMigrationQ conn $ mkReceivedPacket cpkt' tim bytes lvl+                    migrating <- isPathValidating conn+                    unless migrating $ do+                        setMigrationStarted conn+                        -- fixme: should not block in this loop+                        mcidinfo <- timeout (Microseconds 100000) $ waitPeerCID conn+                        let msg = "Migration: " <> bhow peersa <> " (" <> bhow dCID <> ")"+                        qlogDebug conn $ Debug $ toLogStr msg+                        connDebugLog conn $ "debug: dispatch: " <> msg+                        void $ forkIO $ migrator conn mysa peersa dCID mcidinfo++dispatch _ _ _ _ipkt _ _peersa _ _ _ _ _ = return ()++----------------------------------------------------------------++-- | readerServer dies when the socket is closed.+readerServer :: Socket -> Connection -> IO ()+readerServer s conn = handleLogUnit logAction loop+  where+    loop = do+        ito <- readMinIdleTimeout conn+        mbs <- timeout ito $ NSB.recv s maximumUdpPayloadSize+        case mbs of+          Nothing -> close s+          Just bs -> do+              now <- getTimeMicrosecond+              let bytes = BS.length bs+              addRxBytes conn bytes+              pkts <- decodeCryptPackets bs+              mapM_ (\(p,l) -> writeRecvQ (connRecvQ conn) (mkReceivedPacket p now bytes l)) pkts+              loop+    logAction msg = connDebugLog conn ("debug: readerServer: " <> msg)++recvServer :: RecvQ -> IO ReceivedPacket+recvServer = readRecvQ++----------------------------------------------------------------++migrator :: Connection -> SockAddr -> SockAddr -> CID -> Maybe CIDInfo -> IO ()+migrator conn mysa peersa1 dcid mcidinfo = handleLogUnit logAction $+    E.bracketOnError setup close $ \s1 ->+        E.bracket (addSocket conn s1) close $ \_ -> do+            void $ forkIO $ readerServer s1 conn+            -- fixme: if cannot set+            setMyCID conn dcid+            validatePath conn mcidinfo+            void $ timeout (Microseconds 2000000) $ forever (readMigrationQ conn >>= writeRecvQ (connRecvQ conn))+  where+    setup = udpServerConnectedSocket mysa peersa1+    logAction msg = connDebugLog conn ("debug: migrator: " <> msg)
+ Network/QUIC/Server/Run.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Network.QUIC.Server.Run (+    run+  , stop+  ) where++import qualified Network.Socket as NS+import System.Log.FastLogger+import UnliftIO.Async+import UnliftIO.Concurrent+import qualified UnliftIO.Exception as E++import Network.QUIC.Closer+import Network.QUIC.Common+import Network.QUIC.Config+import Network.QUIC.Connection+import Network.QUIC.Crypto+import Network.QUIC.Exception+import Network.QUIC.Handshake+import Network.QUIC.Imports+import Network.QUIC.Logger+import Network.QUIC.Packet+import Network.QUIC.Parameters+import Network.QUIC.QLogger+import Network.QUIC.Qlog+import Network.QUIC.Receiver+import Network.QUIC.Recovery+import Network.QUIC.Sender+import Network.QUIC.Server.Reader+import Network.QUIC.Socket+import Network.QUIC.Types++----------------------------------------------------------------++-- | Running a QUIC server.+--   The action is executed with a new connection+--   in a new lightweight thread.+run :: ServerConfig -> (Connection -> IO ()) -> IO ()+run conf server = handleLogUnit debugLog $ do+    baseThreadId <- myThreadId+    E.bracket setup teardown $ \(dispatch,_) -> forever $ do+        acc <- accept dispatch+        void $ forkIO (runServer conf server dispatch baseThreadId acc)+  where+    doDebug = isJust $ scDebugLog conf+    debugLog msg | doDebug   = stdoutLogger ("run: " <> msg)+                 | otherwise = return ()+    setup = do+        dispatch <- newDispatch+        -- fixme: the case where sockets cannot be created.+        ssas <- mapM  udpServerListenSocket $ scAddresses conf+        tids <- mapM (runDispatcher dispatch conf) ssas+        ttid <- forkIO timeouter -- fixme+        return (dispatch, ttid:tids)+    teardown (dispatch, tids) = do+        clearDispatch dispatch+        mapM_ killThread tids++-- Typically, ConnectionIsClosed breaks acceptStream.+-- And the exception should be ignored.+runServer :: ServerConfig -> (Connection -> IO ()) -> Dispatch -> ThreadId -> Accept -> IO ()+runServer conf server0 dispatch baseThreadId acc =+    E.bracket open clse $ \(ConnRes conn send recv myAuthCIDs reader) ->+        handleLogUnit (debugLog conn) $ do+            forkIO reader >>= addReader conn+            handshaker <- handshakeServer conf conn myAuthCIDs+            let server = do+                    wait1RTTReady conn+                    afterHandshakeServer conn+                    server0 conn+                ldcc = connLDCC conn+                supporters = foldr1 concurrently_ [handshaker+                                                  ,sender   conn send+                                                  ,receiver conn recv+                                                  ,resender  ldcc+                                                  ,ldccTimer ldcc+                                                  ]+                runThreads = do+                    er <- race supporters server+                    case er of+                      Left () -> E.throwIO MustNotReached+                      Right r -> return r+            E.trySyncOrAsync runThreads >>= closure conn ldcc+  where+    open = createServerConnection conf dispatch acc baseThreadId+    clse connRes = do+        let conn = connResConnection connRes+        setDead conn+        freeResources conn+        killReaders conn+        socks <- getSockets conn+        mapM_ NS.close socks+    debugLog conn msg = do+        connDebugLog conn ("runServer: " <> msg)+        qlogDebug conn $ Debug $ toLogStr msg++createServerConnection :: ServerConfig -> Dispatch -> Accept -> ThreadId+                       -> IO ConnRes+createServerConnection conf@ServerConfig{..} dispatch Accept{..} baseThreadId = do+    s0 <- udpServerConnectedSocket accMySockAddr accPeerSockAddr+    sref <- newIORef [s0]+    let send buf siz = void $ do+            s:_ <- readIORef sref+            NS.sendBuf s buf siz+        recv = recvServer accRecvQ+    let Just myCID = initSrcCID accMyAuthCIDs+        Just ocid  = origDstCID accMyAuthCIDs+    (qLog, qclean)     <- dirQLogger scQLog accTime ocid "server"+    (debugLog, dclean) <- dirDebugLogger scDebugLog ocid+    debugLog $ "Original CID: " <> bhow ocid+    conn <- serverConnection conf accVersion accMyAuthCIDs accPeerAuthCIDs debugLog qLog scHooks sref accRecvQ+    addResource conn qclean+    addResource conn dclean+    let cid = fromMaybe ocid $ retrySrcCID accMyAuthCIDs+    initializeCoder conn InitialLevel $ initialSecrets accVersion cid+    setupCryptoStreams conn -- fixme: cleanup+    let pktSiz = (defaultPacketSize accMySockAddr `max` accPacketSize) `min` maximumPacketSize accMySockAddr+    setMaxPacketSize conn pktSiz+    setInitialCongestionWindow (connLDCC conn) pktSiz+    debugLog $ "Packet size: " <> bhow pktSiz <> " (" <> bhow accPacketSize <> ")"+    addRxBytes conn accPacketSize+    when accAddressValidated $ setAddressValidated conn+    --+    let retried = isJust $ retrySrcCID accMyAuthCIDs+    when retried $ do+        qlogRecvInitial conn+        qlogSentRetry conn+    --+    let mgr = tokenMgr dispatch+    setTokenManager conn mgr+    --+    setBaseThreadId conn baseThreadId+    --+    setRegister conn accRegister accUnregister+    accRegister myCID conn+    addResource conn $ do+        myCIDs <- getMyCIDs conn+        mapM_ accUnregister myCIDs+    --+    let reader = readerServer s0 conn -- dies when s0 is closed.+    return $ ConnRes conn send recv accMyAuthCIDs reader++afterHandshakeServer :: Connection -> IO ()+afterHandshakeServer conn = handleLogT logAction $ do+    --+    cidInfo <- getNewMyCID conn+    register <- getRegister conn+    register (cidInfoCID cidInfo) conn+    --+    cryptoToken <- generateToken =<< getVersion conn+    mgr <- getTokenManager conn+    token <- encryptToken mgr cryptoToken+    let ncid = NewConnectionID cidInfo 0+    sendFrames conn RTT1Level [NewToken token,ncid,HandshakeDone]+  where+    logAction msg = connDebugLog conn $ "afterHandshakeServer: " <> msg++-- | Stopping the base thread of the server.+stop :: Connection -> IO ()+stop conn = getBaseThreadId conn >>= killThread
+ Network/QUIC/Socket.hs view
@@ -0,0 +1,82 @@+module Network.QUIC.Socket where++import Control.Concurrent+import qualified UnliftIO.Exception as E+import Data.IP hiding (addr)+import qualified GHC.IO.Exception as E+import Network.Socket+import qualified System.IO.Error as E++sockAddrFamily :: SockAddr -> Family+sockAddrFamily SockAddrInet{}  = AF_INET+sockAddrFamily SockAddrInet6{} = AF_INET6+sockAddrFamily _               = error "sockAddrFamily"++anySockAddr :: SockAddr -> SockAddr+anySockAddr (SockAddrInet p _)      = SockAddrInet  p 0+anySockAddr (SockAddrInet6 p f _ s) = SockAddrInet6 p f (0,0,0,0) s+anySockAddr _                       = error "anySockAddr"++udpServerListenSocket :: (IP, PortNumber) -> IO (Socket, SockAddr)+udpServerListenSocket ip = E.bracketOnError open close $ \s -> do+    setSocketOption s ReuseAddr 1+    withFdSocket s setCloseOnExecIfNeeded+    -- setSocketOption s IPv6Only 1 -- fixme+    bind s sa+    return (s,sa)+  where+    sa     = toSockAddr ip+    family = sockAddrFamily sa+    open   = socket family Datagram defaultProtocol++udpServerConnectedSocket :: SockAddr -> SockAddr -> IO Socket+udpServerConnectedSocket mysa peersa = E.bracketOnError open close $ \s -> do+    setSocketOption s ReuseAddr 1+    withFdSocket s setCloseOnExecIfNeeded+    -- bind and connect is not atomic+    -- So, bind may results in EADDRINUSE+    bind s anysa      -- (UDP, *:13443, *:*)+       `E.catch` postphone (bind s anysa)+    connect s peersa  -- (UDP, 127.0.0.1:13443, pa:pp)+    return s+  where+    postphone action e+      | E.ioeGetErrorType e == E.ResourceBusy = threadDelay 10000 >> action+      | otherwise                             = E.throwIO e+    anysa  = anySockAddr mysa+    family = sockAddrFamily mysa+    open   = socket family Datagram defaultProtocol++udpClientSocket :: HostName -> ServiceName -> IO (Socket,SockAddr)+udpClientSocket host port = do+    addr <- head <$> getAddrInfo (Just hints) (Just host) (Just port)+    E.bracketOnError (openSocket addr) close $ \s -> do+        let sa = addrAddress addr+        return (s,sa)+ where+    hints = defaultHints { addrSocketType = Datagram }++udpClientConnectedSocket :: HostName -> ServiceName -> IO (Socket,SockAddr)+udpClientConnectedSocket host port = do+    addr <- head <$> getAddrInfo (Just hints) (Just host) (Just port)+    E.bracketOnError (openSocket addr) close $ \s -> do+        let sa = addrAddress addr+        connect s sa+        return (s,sa)+ where+    hints = defaultHints { addrSocketType = Datagram }++udpNATRebindingSocket :: SockAddr -> IO Socket+udpNATRebindingSocket peersa = E.bracketOnError open close $ \s ->+    return s+  where+    family = sockAddrFamily peersa+    open = socket family Datagram defaultProtocol++udpNATRebindingConnectedSocket :: SockAddr -> IO Socket+udpNATRebindingConnectedSocket peersa = E.bracketOnError open close $ \s -> do+    connect s peersa+    return s+  where+    family = sockAddrFamily peersa+    open = socket family Datagram defaultProtocol
+ Network/QUIC/Stream.hs view
@@ -0,0 +1,49 @@+module Network.QUIC.Stream (+  -- * Types+    Stream+  , streamId+  , streamConnection+  , newStream+  , TxStreamData(..)+  , Flow(..)+  , defaultFlow+  , StreamState(..)+  , RecvStreamQ(..)+  , RxStreamData(..)+  , Length+  -- * Misc+  , getTxStreamOffset+  , isTxStreamClosed+  , setTxStreamClosed+  , getRxStreamOffset+  , isRxStreamClosed+  , setRxStreamClosed+  , readStreamFlowTx+  , addTxStreamData+  , setTxMaxStreamData+  , readStreamFlowRx+  , addRxStreamData+  , setRxMaxStreamData+  , addRxMaxStreamData+  , getRxMaxStreamData+  , getRxStreamWindow+  , flowWindow+  -- * Reass+  , takeRecvStreamQwithSize+  , putRxStreamData+  , tryReassemble+  -- * Table+  , StreamTable+  , emptyStreamTable+  , lookupStream+  , insertStream+  , deleteStream+  , insertCryptoStreams+  , deleteCryptoStream+  , lookupCryptoStream+  ) where++import Network.QUIC.Stream.Misc+import Network.QUIC.Stream.Reass+import Network.QUIC.Stream.Table+import Network.QUIC.Stream.Types
+ Network/QUIC/Stream/Frag.hs view
@@ -0,0 +1,33 @@+module Network.QUIC.Stream.Frag where++import Data.Sequence (Seq, viewl, viewr, ViewL(..), ViewR(..), (<|), dropWhileL)++class Frag a where+    currOff :: a -> Int+    nextOff :: a -> Int+    shrink  :: Int -> a -> a++instance Frag a => Frag (Seq a) where+    currOff s = case viewl s of+      EmptyL -> error "Seq is empty (1)"+      x :< _ -> currOff x+    nextOff s = case viewr s of+      EmptyR -> error "Seq is empty (2)"+      _ :> x -> nextOff x+    shrink = shrinkSeq++shrinkSeq :: Frag a => Int -> Seq a -> Seq a+shrinkSeq n s0 = case viewl s of+  EmptyL -> error "shrinkSeq"+  x :< xs+    | nextOff x == n -> xs+    | otherwise      -> shrink n x <| xs+  where+    s = dropWhileL (\y -> not (currOff y <= n && n <= nextOff y)) s0++data F = F Int Int deriving Show++instance Frag F where+    currOff (F s _)   = s+    nextOff (F _ e)   = e+    shrink  n (F s e) = if s <= n && n <= e then F n e else error "shrink"
+ Network/QUIC/Stream/Misc.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Stream.Misc (+    getTxStreamOffset+  , isTxStreamClosed+  , setTxStreamClosed+  , getRxStreamOffset+  , isRxStreamClosed+  , setRxStreamClosed+  --+  , readStreamFlowTx+  , addTxStreamData+  , setTxMaxStreamData+  , readStreamFlowRx+  , addRxStreamData+  , setRxMaxStreamData+  , addRxMaxStreamData+  , getRxMaxStreamData+  , getRxStreamWindow+  ) where++import Control.Concurrent.STM++import Network.QUIC.Imports+import Network.QUIC.Stream.Types++----------------------------------------------------------------++getTxStreamOffset :: Stream -> Int -> IO Offset+getTxStreamOffset Stream{..} len = atomicModifyIORef' streamStateTx get+  where+    get (StreamState off fin) = (StreamState (off + len) fin, off)++isTxStreamClosed :: Stream -> IO Bool+isTxStreamClosed Stream{..} = do+    StreamState _ fin <- readIORef streamStateTx+    return fin++setTxStreamClosed :: Stream -> IO ()+setTxStreamClosed Stream{..} = atomicModifyIORef'' streamStateTx set+  where+    set (StreamState off _) = StreamState off True++----------------------------------------------------------------++getRxStreamOffset :: Stream -> Int -> IO Offset+getRxStreamOffset Stream{..} len = atomicModifyIORef' streamStateRx get+  where+    get (StreamState off fin) = (StreamState (off + len) fin, off)++isRxStreamClosed :: Stream -> IO Bool+isRxStreamClosed Stream{..} = do+    StreamState _ fin <- readIORef streamStateRx+    return fin++setRxStreamClosed :: Stream -> IO ()+setRxStreamClosed Stream{..} = atomicModifyIORef'' streamStateRx set+  where+    set (StreamState off _) = StreamState off True++----------------------------------------------------------------++readStreamFlowTx :: Stream -> STM Flow+readStreamFlowTx Stream{..} = readTVar streamFlowTx++----------------------------------------------------------------++addTxStreamData :: Stream -> Int -> STM ()+addTxStreamData Stream{..} n = modifyTVar' streamFlowTx add+  where+    add flow = flow { flowData = flowData flow + n }++setTxMaxStreamData :: Stream -> Int -> IO ()+setTxMaxStreamData Stream{..} n = atomically $ modifyTVar' streamFlowTx set+  where+    set flow+     | flowMaxData flow < n = flow { flowMaxData = n }+     | otherwise            = flow++----------------------------------------------------------------++addRxStreamData :: Stream -> Int -> IO ()+addRxStreamData Stream{..} n = atomicModifyIORef'' streamFlowRx add+  where+    add flow = flow { flowData = flowData flow + n }++setRxMaxStreamData :: Stream -> Int -> IO ()+setRxMaxStreamData Stream{..} n = atomicModifyIORef'' streamFlowRx+    $ \flow -> flow { flowMaxData = n }++addRxMaxStreamData :: Stream -> Int -> IO Int+addRxMaxStreamData Stream{..} n = atomicModifyIORef' streamFlowRx add+  where+    add flow = (flow { flowMaxData = m }, m)+      where+        m = flowMaxData flow + n++getRxMaxStreamData :: Stream -> IO Int+getRxMaxStreamData Stream{..} = flowMaxData <$> readIORef streamFlowRx++getRxStreamWindow :: Stream -> IO Int+getRxStreamWindow Stream{..} = flowWindow <$> readIORef streamFlowRx++readStreamFlowRx :: Stream -> IO Flow+readStreamFlowRx Stream{..} = readIORef streamFlowRx
+ Network/QUIC/Stream/Queue.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Stream.Queue where++import Data.ByteString (ByteString)+import Control.Concurrent.STM++import Network.QUIC.Stream.Types++putRecvStreamQ :: Stream -> ByteString -> IO ()+putRecvStreamQ Stream{..} = atomically . writeTQueue (recvStreamQ streamRecvQ)++takeRecvStreamQ :: Stream -> IO ByteString+takeRecvStreamQ Stream{..} = atomically $ readTQueue $ recvStreamQ streamRecvQ++tryTakeRecvStreamQ :: Stream -> IO (Maybe ByteString)+tryTakeRecvStreamQ Stream{..} = atomically $ tryReadTQueue $ recvStreamQ streamRecvQ
+ Network/QUIC/Stream/Reass.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Stream.Reass (+    takeRecvStreamQwithSize+  , putRxStreamData+  , tryReassemble+  ) where++import Data.Sequence (Seq)+import qualified Data.Sequence as Seq+import qualified Data.ByteString as BS++import Network.QUIC.Imports+-- import Network.QUIC.Logger+import Network.QUIC.Stream.Frag+import Network.QUIC.Stream.Misc+import Network.QUIC.Stream.Queue+import qualified Network.QUIC.Stream.Skew as Skew+import Network.QUIC.Stream.Types+import Network.QUIC.Types++----------------------------------------------------------------++getEndOfStream :: Stream -> IO Bool+getEndOfStream Stream{..} = readIORef $ endOfStream streamRecvQ++setEndOfStream :: Stream -> IO ()+setEndOfStream Stream{..} = writeIORef (endOfStream streamRecvQ) True++readPendingData :: Stream -> IO (Maybe ByteString)+readPendingData Stream{..} = readIORef $ pendingData streamRecvQ++writePendingData :: Stream -> ByteString -> IO ()+writePendingData Stream{..} bs = writeIORef (pendingData streamRecvQ) $ Just bs++clearPendingData :: Stream -> IO ()+clearPendingData Stream{..} = writeIORef (pendingData streamRecvQ) Nothing++----------------------------------------------------------------++takeRecvStreamQwithSize :: Stream -> Int -> IO ByteString+takeRecvStreamQwithSize strm siz0 = do+    eos <- getEndOfStream strm+    if eos then+        return ""+      else do+        mb <- readPendingData strm+        case mb of+          Nothing -> do+              b0 <- takeRecvStreamQ strm+              if b0 == "" then do+                  setEndOfStream strm+                  return ""+                else do+                  let len = BS.length b0+                  case len `compare` siz0 of+                      LT -> tryRead (siz0 - len) (b0 :)+                      EQ -> return b0+                      GT -> do+                          let (b1,b2) = BS.splitAt siz0 b0+                          writePendingData strm b2+                          return b1+          Just b0 -> do+              clearPendingData strm+              let len = BS.length b0+              tryRead (siz0 - len) (b0 :)+  where+    tryRead siz build = do+        mb <- tryTakeRecvStreamQ strm+        case mb of+          Nothing -> return $ BS.concat $ build []+          Just b  -> do+              if b == "" then do+                  setEndOfStream strm+                  return $ BS.concat $ build []+                else do+                  let len = BS.length b+                  case len `compare` siz of+                    LT -> tryRead (siz - len) (build . (b :))+                    EQ -> return $ BS.concat $ build [b]+                    GT -> do+                        let (b1,b2) = BS.splitAt siz b+                        writePendingData strm b2+                        return $ BS.concat $ build [b1]++----------------------------------------------------------------+----------------------------------------------------------------++putRxStreamData :: Stream -> RxStreamData -> IO Bool+putRxStreamData s rx@(RxStreamData dat off _ _) = do+    lim <- getRxMaxStreamData s+    if BS.length dat + off > lim then+        return False+      else do+        _ <- tryReassemble s rx put putFin+        return True+  where+    put "" = return ()+    put d  = putRecvStreamQ s d+    putFin = putRecvStreamQ s ""++-- fin of StreamState off fin means see-fin-already.+-- return value indicates duplication+tryReassemble :: Stream -> RxStreamData -> (StreamData -> IO ()) -> IO () -> IO Bool+tryReassemble Stream{}   (RxStreamData "" _  _ False) _ _ = return True+tryReassemble Stream{..} x@(RxStreamData "" off _ True) _ putFin = do+    si0@(StreamState off0 fin0) <- readIORef streamStateRx+    let si1 = si0 { streamFin = True }+    if fin0 then do+        -- stdoutLogger "Illegal Fin" -- fixme+        return True+      else case off `compare` off0 of+        LT -> return True+        EQ -> do+            writeIORef streamStateRx si1+            putFin+            return False+        GT -> do+            writeIORef streamStateRx si1+            atomicModifyIORef'' streamReass (Skew.insert x)+            return False+tryReassemble Stream{..} x@(RxStreamData dat off len False) put putFin = do+    si0@(StreamState off0 _) <- readIORef streamStateRx+    case off `compare` off0 of+      LT -> return True+      EQ -> do+          put dat+          loop si0 (off0 + len)+          return False+      GT -> do+          atomicModifyIORef'' streamReass (Skew.insert x)+          return False+  where+    loop si0 xff = do+        mrxs <- atomicModifyIORef' streamReass (Skew.deleteMinIf xff)+        case mrxs of+           Nothing   -> writeIORef streamStateRx si0 { streamOffset = xff }+           Just rxs -> do+               mapM_ (put . rxstrmData) rxs+               let xff1 = nextOff rxs+               if hasFin rxs then do+                   putFin+                 else do+                   loop si0 xff1++tryReassemble Stream{..} x@(RxStreamData dat off len True) put putFin = do+    si0@(StreamState off0 fin0) <- readIORef streamStateRx+    let si1 = si0 { streamFin = True }+    if fin0 then do+        -- stdoutLogger "Illegal Fin" -- fixme+        return True+      else case off `compare` off0 of+        LT -> return True+        EQ -> do+            let off1 = off0 + len+            writeIORef streamStateRx si1 { streamOffset = off1 }+            put dat+            putFin+            return False+        GT -> do+            writeIORef streamStateRx si1+            atomicModifyIORef'' streamReass (Skew.insert x)+            return False++hasFin :: Seq RxStreamData -> Bool+hasFin s = case Seq.viewr s of+  Seq.EmptyR -> False+  _ Seq.:> x -> rxstrmFin x
+ Network/QUIC/Stream/Skew.hs view
@@ -0,0 +1,89 @@+module Network.QUIC.Stream.Skew (+    Skew(..)+  , empty+  , insert+  , deleteMin+  , deleteMinIf+--  , deleteMin'+--  , showSkew+  ) where++import Data.Maybe+import Data.Sequence (Seq, (><))+import qualified Data.Sequence as Seq+import Prelude hiding (minimum)++import Network.QUIC.Stream.Frag++----------------------------------------------------------------++data Skew a = Leaf | Node (Skew a) (Seq a) (Skew a) deriving Show++empty :: Skew a+empty = Leaf++----------------------------------------------------------------++-- | Insertion. Worst-case: O(N), amortized: O(log N).+insert :: Frag a => a -> Skew a -> Skew a+insert x t = merge (Node Leaf (Seq.singleton x) Leaf) t++----------------------------------------------------------------++-- | Finding the minimum element. Worst-case: O(1).+minimum :: Skew a -> Maybe (Seq a)+minimum Leaf         = Nothing+minimum (Node _ f _) = Just f++----------------------------------------------------------------++-- | Deleting the minimum element. Worst-case: O(N), amortized: O(log N).+deleteMin' :: Frag a => Skew a -> Skew a+deleteMin' Leaf         = Leaf+deleteMin' (Node l _ r) = merge l r++deleteMin :: Frag a => Skew a -> (Skew a, Maybe (Seq a))+deleteMin h = (deleteMin' h, minimum h)++deleteMinIf :: Frag a => Int -> Skew a -> (Skew a, Maybe (Seq a))+deleteMinIf off h = case minimum h of+  jf@(Just f)+    | currOff f == off                   -> (deleteMin' h, jf)+    | currOff f < off && off < nextOff f -> (deleteMin' h, shrink off <$> jf)+    | nextOff f <= off                   -> (deleteMin' h, Nothing)+  _                                      -> (h, Nothing)++----------------------------------------------------------------++-- | Merging two heaps. Worst-case: O(N), amortized: O(log N).+merge :: Frag a => Skew a -> Skew a -> Skew a+merge t1 Leaf = t1+merge Leaf t2 = t2+merge t1@(Node l1 f1 r1) t2@(Node l2 f2 r2)+  | e1 < s2   = Node r1 f1 (merge l1 t2)+  | e2 < s1   = Node r2 f2 (merge l2 t1)+  | otherwise = let f12 | e1 == s2             = f1 >< f2+                        | s1 == e2             = f2 >< f1+                        | s1 <= s2 && e2 <= e1 = f1+                        | s2 <= s1 && e1 <= e2 = f2+                        | s1 <= s2             = f1 >< shrink e1 f2+                        | otherwise            = f2 >< shrink e2 f1+                in Node (merge l1 l2) f12 (merge r1 r2)+  where+    s1 = currOff f1+    e1 = nextOff f1+    s2 = currOff f2+    e2 = nextOff f2++{-+showSkew :: Show a => Skew a -> String+showSkew = showSkew' ""++showSkew' :: Show a => String -> Skew a -> String+showSkew' _    Leaf = "\n"+showSkew' pref (Node l x r) = show x ++ "\n"+                           ++ pref ++ "+ " ++ showSkew' pref' l+                           ++ pref ++ "+ " ++ showSkew' pref' r+  where+    pref' = "  " ++ pref+-}
+ Network/QUIC/Stream/Table.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Stream.Table (+    StreamTable+  , emptyStreamTable+  , lookupStream+  , insertStream+  , deleteStream+  , insertCryptoStreams+  , deleteCryptoStream+  , lookupCryptoStream+  ) where++import Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as Map++import {-# Source #-} Network.QUIC.Connection.Types+import Network.QUIC.Stream.Types+import Network.QUIC.Types++----------------------------------------------------------------++newtype StreamTable = StreamTable (IntMap Stream)++emptyStreamTable :: StreamTable+emptyStreamTable = StreamTable Map.empty++----------------------------------------------------------------++lookupStream :: StreamId -> StreamTable -> Maybe Stream+lookupStream sid (StreamTable tbl) = Map.lookup sid tbl++insertStream :: StreamId -> Stream -> StreamTable -> StreamTable+insertStream sid strm (StreamTable tbl) = StreamTable $ Map.insert sid strm tbl++deleteStream :: StreamId -> StreamTable -> StreamTable+deleteStream sid (StreamTable tbl) = StreamTable $ Map.delete sid tbl++----------------------------------------------------------------++initialCryptoStreamId,handshakeCryptoStreamId,rtt1CryptoStreamId :: StreamId+initialCryptoStreamId   = -1+handshakeCryptoStreamId = -2+rtt1CryptoStreamId      = -3++toCryptoStreamId :: EncryptionLevel -> StreamId+toCryptoStreamId InitialLevel   = initialCryptoStreamId+-- This is to generate an error packet of CRYPTO in 0-RTT+toCryptoStreamId RTT0Level      = rtt1CryptoStreamId+toCryptoStreamId HandshakeLevel = handshakeCryptoStreamId+toCryptoStreamId RTT1Level      = rtt1CryptoStreamId++----------------------------------------------------------------++insertCryptoStreams :: Connection -> StreamTable -> IO StreamTable+insertCryptoStreams conn stbl = do+    strm1 <- newStream conn initialCryptoStreamId+    strm2 <- newStream conn handshakeCryptoStreamId+    strm3 <- newStream conn rtt1CryptoStreamId+    return $ insertStream initialCryptoStreamId   strm1+           $ insertStream handshakeCryptoStreamId strm2+           $ insertStream rtt1CryptoStreamId      strm3 stbl++deleteCryptoStream :: EncryptionLevel -> StreamTable -> StreamTable+deleteCryptoStream InitialLevel   = deleteStream initialCryptoStreamId+deleteCryptoStream RTT0Level      = deleteStream rtt1CryptoStreamId+deleteCryptoStream HandshakeLevel = deleteStream handshakeCryptoStreamId+deleteCryptoStream RTT1Level      = deleteStream rtt1CryptoStreamId++----------------------------------------------------------------++lookupCryptoStream :: EncryptionLevel -> StreamTable -> Maybe Stream+lookupCryptoStream lvl stbl = lookupStream sid stbl+  where+    sid = toCryptoStreamId lvl
+ Network/QUIC/Stream/Types.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Stream.Types (+    Stream(..)+  , newStream+  , TxStreamData(..)+  , Flow(..)+  , defaultFlow+  , flowWindow+  , StreamState(..)+  , RecvStreamQ(..)+  , RxStreamData(..)+  , Length+  ) where++import Control.Concurrent.STM+import qualified Data.ByteString as BS++import {-# Source #-} Network.QUIC.Connection.Types+import Network.QUIC.Imports+import Network.QUIC.Stream.Frag+import Network.QUIC.Stream.Skew+import qualified Network.QUIC.Stream.Skew as Skew+import Network.QUIC.Types++----------------------------------------------------------------++-- | An abstract data type for streams.+data Stream = Stream {+    streamId         :: StreamId -- ^ Getting stream identifier.+  , streamConnection :: Connection+  -- "counter" is equivalent to "offset".+  -- It is duplicated but used for API level flow control.+  , streamFlowTx     :: TVar  Flow        -- counter, maxDax+  , streamFlowRx     :: IORef Flow        -- counter, maxDax+  , streamStateTx    :: IORef StreamState -- offset, fin+  , streamStateRx    :: IORef StreamState -- offset, fin+  , streamRecvQ      :: RecvStreamQ       -- input bytestring+  , streamReass      :: IORef (Skew RxStreamData) -- input stream fragments to streamQ+  }++instance Show Stream where+    show s = show $ streamId s++newStream :: Connection -> StreamId -> IO Stream+newStream conn sid = Stream sid conn <$> newTVarIO defaultFlow+                                     <*> newIORef  defaultFlow+                                     <*> newIORef  emptyStreamState+                                     <*> newIORef  emptyStreamState+                                     <*> newRecvStreamQ+                                     <*> newIORef Skew.empty++----------------------------------------------------------------++type Length = Int++data TxStreamData = TxStreamData Stream [StreamData] Length Fin++data RxStreamData = RxStreamData {+    rxstrmData :: StreamData+  , rxstrmOff  :: Offset+  , rxstrmLen  :: Length+  , rxstrmFin  :: Fin+  } deriving (Eq, Show)++instance Frag RxStreamData where+    currOff r = rxstrmOff r+    nextOff r = rxstrmOff r + rxstrmLen r+    shrink off'  (RxStreamData bs off len fin) =+        let n = off' - off+            bs'  = BS.drop n bs+            len' = len - n+        in RxStreamData bs' off' len' fin++----------------------------------------------------------------++data Flow = Flow {+    flowData :: Int+  , flowMaxData :: Int+  } deriving (Eq, Show)++defaultFlow :: Flow+defaultFlow = Flow 0 0++flowWindow :: Flow -> Int+flowWindow Flow{..} = flowMaxData - flowData++----------------------------------------------------------------++data StreamState = StreamState {+    streamOffset :: Offset+  , streamFin :: Fin+  } deriving (Eq, Show)++emptyStreamState :: StreamState+emptyStreamState = StreamState 0 False++----------------------------------------------------------------++data RecvStreamQ = RecvStreamQ {+    recvStreamQ :: TQueue ByteString+  , pendingData :: IORef (Maybe ByteString)+  , endOfStream :: IORef Bool+  }++newRecvStreamQ :: IO RecvStreamQ+newRecvStreamQ = RecvStreamQ <$> newTQueueIO <*> newIORef Nothing <*> newIORef False
+ Network/QUIC/TLS.hs view
@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.TLS (+    clientHandshaker+  , serverHandshaker+  ) where++import Data.Default.Class+import Network.TLS hiding (Version)+import Network.TLS.QUIC++import Network.QUIC.Config+import Network.QUIC.Parameters+import Network.QUIC.Types++sessionManager :: SessionEstablish -> SessionManager+sessionManager establish = SessionManager {+    sessionEstablish      = establish+  , sessionResume         = \_ -> return Nothing+  , sessionResumeOnlyOnce = \_ -> return Nothing+  , sessionInvalidate     = \_ -> return ()+  }++clientHandshaker :: QUICCallbacks+                 -> ClientConfig+                 -> Version+                 -> AuthCIDs+                 -> SessionEstablish+                 -> Bool+                 -> IO ()+clientHandshaker callbacks ClientConfig{..} ver myAuthCIDs establish use0RTT =+    tlsQUICClient cparams callbacks+  where+    cparams = (defaultParamsClient ccServerName "") {+        clientShared            = cshared+      , clientHooks             = hook+      , clientSupported         = supported+      , clientDebug             = debug+      , clientWantSessionResume = resumptionSession ccResumption+      , clientEarlyData         = if use0RTT then Just "" else Nothing+      }+    convTP = onTransportParametersCreated ccHooks+    convExt = onTLSExtensionCreated ccHooks+    qparams = convTP $ setCIDsToParameters myAuthCIDs ccParameters+    eQparams = encodeParameters qparams+    tpId | ver == Version1 = extensionID_QuicTransportParameters+         | otherwise       = 0xffa5+    cshared = def {+        sharedValidationCache = if ccValidate then+                                  def+                                else+                                  ValidationCache (\_ _ _ -> return ValidationCachePass) (\_ _ _ -> return ())+      , sharedHelloExtensions = convExt [ExtensionRaw tpId eQparams]+      , sharedSessionManager = sessionManager establish+      }+    hook = def {+        onSuggestALPN = ccALPN ver+      }+    supported = defaultSupported {+        supportedCiphers  = ccCiphers+      , supportedGroups   = ccGroups+      }+    debug = def {+        debugKeyLogger = ccKeyLog+      }++serverHandshaker :: QUICCallbacks+                 -> ServerConfig+                 -> Version+                 -> AuthCIDs+                 -> IO ()+serverHandshaker callbacks ServerConfig{..} ver myAuthCIDs =+    tlsQUICServer sparams callbacks+  where+    sparams = def {+        serverShared    = sshared+      , serverHooks     = hook+      , serverSupported = supported+      , serverDebug     = debug+      , serverEarlyDataSize = if scUse0RTT then quicMaxEarlyDataSize else 0+      }+    convTP = onTransportParametersCreated scHooks+    convExt = onTLSExtensionCreated scHooks+    qparams = convTP $ setCIDsToParameters myAuthCIDs scParameters+    eQparams = encodeParameters qparams+    tpId | ver == Version1 = extensionID_QuicTransportParameters+         | otherwise       = 0xffa5+    sshared = def {+            sharedCredentials     = scCredentials+          , sharedHelloExtensions = convExt [ExtensionRaw tpId eQparams]+          , sharedSessionManager  = scSessionManager+          }+    hook = def {+        onALPNClientSuggest = case scALPN of+          Nothing -> Nothing+          Just io -> Just $ io ver+      }+    supported = def {+        supportedVersions = [TLS13]+      , supportedCiphers  = scCiphers+      , supportedGroups   = scGroups+      }+    debug = def {+        debugKeyLogger = scKeyLog+      }
+ Network/QUIC/Types.hs view
@@ -0,0 +1,35 @@+module Network.QUIC.Types (+    Bytes+  , SendBuf+  , Receive+  , Close+  , Direction(..)+  , module Network.QUIC.Types.Ack+  , module Network.QUIC.Types.CID+  , module Network.QUIC.Types.Constants+  , module Network.QUIC.Types.Error+  , module Network.QUIC.Types.Exception+  , module Network.QUIC.Types.Frame+  , module Network.QUIC.Types.Integer+  , module Network.QUIC.Types.Packet+  , module Network.QUIC.Types.Queue+  , module Network.QUIC.Types.Resumption+  , module Network.QUIC.Types.Time+  ) where++import Network.QUIC.Imports+import Network.QUIC.Types.Ack+import Network.QUIC.Types.CID+import Network.QUIC.Types.Constants+import Network.QUIC.Types.Error+import Network.QUIC.Types.Exception+import Network.QUIC.Types.Frame+import Network.QUIC.Types.Integer+import Network.QUIC.Types.Packet+import Network.QUIC.Types.Queue+import Network.QUIC.Types.Resumption+import Network.QUIC.Types.Time++type SendBuf = Buffer -> Int -> IO ()+type Receive = IO ReceivedPacket+type Close = IO ()
+ Network/QUIC/Types/Ack.hs view
@@ -0,0 +1,102 @@+module Network.QUIC.Types.Ack where++import Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet++type PacketNumber = Int++type Range = Int+type Gap   = Int++data AckInfo = AckInfo PacketNumber Range [(Gap,Range)]+             deriving (Eq, Show)++ackInfo0 :: AckInfo+ackInfo0 = AckInfo (-1) 0 []++-- |+-- >>> toAckInfo [9]+-- AckInfo 9 0 []+-- >>> toAckInfo [9,8,7]+-- AckInfo 9 2 []+-- >>> toAckInfo [8,7,3,2]+-- AckInfo 8 1 [(2,1)]+-- >>> toAckInfo [9,8,7,5,4]+-- AckInfo 9 2 [(0,1)]+toAckInfo :: [PacketNumber] -> AckInfo+toAckInfo []  = error "toAckInfo"+toAckInfo [l] = AckInfo l 0 []+toAckInfo (l:ls)  = ack l ls 0+  where+    ack _ []     fr = AckInfo l fr []+    ack p (x:xs) fr+      | p - 1 == x  = ack x xs (fr+1)+      | otherwise   = AckInfo l fr $ ranges x xs (fromIntegral (p - x) - 2) 0+    ranges _ [] g r = [(g, r)]+    ranges p (x:xs) g r+      | p - 1 == x  = ranges x xs g (r+1)+      | otherwise   = (g, r) : ranges x xs (fromIntegral (p - x) - 2) 0++-- |+-- >>> fromAckInfo $ AckInfo 9 0 []+-- [9]+-- >>> fromAckInfo $ AckInfo 9 2 []+-- [7,8,9]+-- >>> fromAckInfo $ AckInfo 8 1 [(2,1)]+-- [2,3,7,8]+-- >>> fromAckInfo $ AckInfo 9 2 [(0,1)]+-- [4,5,7,8,9]+fromAckInfo :: AckInfo -> [PacketNumber]+fromAckInfo (AckInfo lpn fr grs) = loop grs [stt .. lpn]+  where+    stt = lpn - fromIntegral fr+    loop _          []        = error "loop"+    loop []         acc       = acc+    loop ((g,r):xs) acc@(s:_) = loop xs ([z - fromIntegral r .. z] ++ acc)+      where+        z = s - fromIntegral g - 2++-- |+-- >>> fromAckInfoWithMin (AckInfo 9 0 []) 1+-- [9]+-- >>> fromAckInfoWithMin (AckInfo 9 2 []) 8+-- [8,9]+-- >>> fromAckInfoWithMin (AckInfo 8 1 [(2,1)]) 3+-- [3,7,8]+-- >>> fromAckInfoWithMin (AckInfo 9 2 [(0,1)]) 8+-- [8,9]+fromAckInfoWithMin :: AckInfo -> PacketNumber -> [PacketNumber]+fromAckInfoWithMin (AckInfo lpn fr grs) lim+  | stt < lim = [lim .. lpn]+  | otherwise = loop grs [stt .. lpn]+  where+    stt = lpn - fromIntegral fr+    loop _          []        = error "loop"+    loop []         acc       = acc+    loop ((g,r):xs) acc@(s:_)+      | z < lim  = acc+      |otherwise = loop xs ([r' .. z] ++ acc)+      where+        z = s - fromIntegral g - 2+        r' = max lim (z - fromIntegral r)++fromAckInfoToPred :: AckInfo -> (PacketNumber -> Bool)+fromAckInfoToPred (AckInfo lpn fr grs) =+    \x -> any (f x) $ loop grs [(stt,lpn)]+  where+    f x (l,u) = l <= x && x <= u+    stt = lpn - fromIntegral fr+    loop _          []        = error "loop"+    loop []         acc       = acc+    loop ((g,r):xs) acc@((s,_):_) = loop xs $ (z - fromIntegral r, z) : acc+      where+        z = s - fromIntegral g - 2++----------------------------------------------------------------++newtype PeerPacketNumbers = PeerPacketNumbers IntSet+                          deriving (Eq, Show)++emptyPeerPacketNumbers :: PeerPacketNumbers+emptyPeerPacketNumbers = PeerPacketNumbers IntSet.empty+
+ Network/QUIC/Types/CID.hs view
@@ -0,0 +1,63 @@+module Network.QUIC.Types.CID (+    CID(..)+  , myCIDLength+  , newCID+  , fromCID+  , toCID+  , makeCID+  , unpackCID+  , StatelessResetToken(..)+  , newStatelessResetToken+  , PathData(..)+  , newPathData+  , CIDInfo(..)+  ) where++import qualified Data.ByteString.Short as Short++import Network.QUIC.Imports++myCIDLength :: Int+myCIDLength = 8++-- | A type for conneciton ID.+newtype CID = CID Bytes deriving (Eq, Ord)++instance Show CID where+    show (CID cid) = shortToString (enc16s cid)++newCID :: IO CID+newCID = CID <$> getRandomBytes myCIDLength++toCID :: ByteString -> CID+toCID = CID . Short.toShort++-- | Converting a connection ID.+fromCID :: CID -> ByteString+fromCID (CID sbs) = Short.fromShort sbs++makeCID :: ShortByteString -> CID+makeCID = CID++unpackCID :: CID -> (ShortByteString, Word8)+unpackCID (CID sbs) = (sbs, len)+  where+    len = fromIntegral $ Short.length sbs++-- 16 bytes+newtype StatelessResetToken = StatelessResetToken Bytes deriving (Eq,Ord,Show)++newStatelessResetToken :: IO StatelessResetToken+newStatelessResetToken = StatelessResetToken <$> getRandomBytes 16++-- 8 bytes+newtype PathData = PathData Bytes deriving (Eq,Show)++newPathData :: IO PathData+newPathData = PathData <$> getRandomBytes 8++data CIDInfo = CIDInfo {+    cidInfoSeq :: Int+  , cidInfoCID :: CID+  , cidInfoSRT :: StatelessResetToken+  } deriving (Eq, Ord, Show)
+ Network/QUIC/Types/Constants.hs view
@@ -0,0 +1,32 @@+module Network.QUIC.Types.Constants where++import Network.QUIC.Types.Time++maximumUdpPayloadSize :: Int+maximumUdpPayloadSize = 2048 -- no global locking when allocating ByteString++----------------------------------------------------------------++-- minimum PMTU = 1024 + 256 = 1280+-- IPv4 payload = 1280 - 20 - 8 = 1252+-- IPv6 payload = 1280 - 40 - 8 = 1232++defaultQUICPacketSize :: Int+defaultQUICPacketSize = 1200++defaultQUICPacketSizeForIPv4 :: Int+defaultQUICPacketSizeForIPv4 = 1252++defaultQUICPacketSizeForIPv6 :: Int+defaultQUICPacketSizeForIPv6 = 1232++----------------------------------------------------------------++-- Not from spec. retry token is 128 sometime.+maximumQUICHeaderSize :: Int+maximumQUICHeaderSize = 256++----------------------------------------------------------------++idleTimeout :: Microseconds+idleTimeout = Microseconds 30000000
+ Network/QUIC/Types/Error.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE PatternSynonyms #-}++module Network.QUIC.Types.Error where++import qualified Network.TLS as TLS+import Network.TLS.QUIC++-- | Transport errors of QUIC.+newtype TransportError = TransportError Int deriving (Eq, Show)++pattern NoError                 :: TransportError+pattern NoError                  = TransportError  0x0++pattern InternalError           :: TransportError+pattern InternalError            = TransportError  0x1++pattern ConnectionRefused       :: TransportError+pattern ConnectionRefused        = TransportError  0x2++pattern FlowControlError        :: TransportError+pattern FlowControlError         = TransportError  0x3++pattern StreamLimitError        :: TransportError+pattern StreamLimitError         = TransportError  0x4++pattern StreamStateError        :: TransportError+pattern StreamStateError         = TransportError  0x5++pattern FinalSizeError          :: TransportError+pattern FinalSizeError           = TransportError  0x6++pattern FrameEncodingError      :: TransportError+pattern FrameEncodingError       = TransportError  0x7++pattern TransportParameterError :: TransportError+pattern TransportParameterError  = TransportError  0x8++pattern ConnectionIdLimitError  :: TransportError+pattern ConnectionIdLimitError   = TransportError  0x9++pattern ProtocolViolation       :: TransportError+pattern ProtocolViolation        = TransportError  0xa++pattern InvalidToken            :: TransportError+pattern InvalidToken             = TransportError  0xb++pattern ApplicationError        :: TransportError+pattern ApplicationError         = TransportError  0xc++pattern CryptoBufferExceeded    :: TransportError+pattern CryptoBufferExceeded     = TransportError  0xd++pattern KeyUpdateError          :: TransportError+pattern KeyUpdateError           = TransportError  0xe++pattern AeadLimitReached        :: TransportError+pattern AeadLimitReached         = TransportError  0xf++pattern NoViablePath            :: TransportError+pattern NoViablePath             = TransportError 0x10++-- | Converting a TLS alert to a corresponding transport error.+cryptoError :: TLS.AlertDescription -> TransportError+cryptoError ad = TransportError ec+  where+    ec = 0x100 + fromIntegral (fromAlertDescription ad)++-- | Application protocol errors of QUIC.+newtype ApplicationProtocolError = ApplicationProtocolError Int deriving (Eq, Show)
+ Network/QUIC/Types/Exception.hs view
@@ -0,0 +1,48 @@+module Network.QUIC.Types.Exception where++import qualified Network.TLS as TLS+import qualified UnliftIO.Exception as E++import Network.QUIC.Imports+import Network.QUIC.Types.Error+import Network.QUIC.Types.Frame+import Network.QUIC.Types.Packet++-- | User level exceptions for QUIC.+data QUICException =+    ConnectionIsClosed -- NoError+  | TransportErrorIsReceived TransportError ReasonPhrase+  | TransportErrorIsSent     TransportError ReasonPhrase+  | ApplicationProtocolErrorIsReceived ApplicationProtocolError ReasonPhrase+  | ApplicationProtocolErrorIsSent     ApplicationProtocolError ReasonPhrase+  | ConnectionIsTimeout+  | ConnectionIsReset+  | StreamIsClosed+  | HandshakeFailed TLS.AlertDescription -- failed in my side+  | VersionIsUnknown Word32+  | NoVersionIsSpecified+  | VersionNegotiationFailed+  | BadThingHappen E.SomeException+  deriving (Show)++instance E.Exception QUICException++data InternalControl = MustNotReached+                     | ExitConnection+                     | WrongTransportParameter+                     | BreakForever+                     deriving (Eq, Show)++instance E.Exception InternalControl++newtype NextVersion = NextVersion (Maybe Version) deriving (Show)++instance E.Exception NextVersion++data Abort = Abort ApplicationProtocolError ReasonPhrase+           | VerNego (Maybe Version)+           deriving (Show)++instance E.Exception Abort where+  fromException = E.asyncExceptionFromException+  toException = E.asyncExceptionToException
+ Network/QUIC/Types/Frame.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Types.Frame where++import Network.QUIC.Imports+import Network.QUIC.Types.Ack+import Network.QUIC.Types.CID+import Network.QUIC.Types.Error+import Network.QUIC.Types.Time++----------------------------------------------------------------++type FrameType = Int++data Direction = Unidirectional | Bidirectional deriving (Eq, Show)++type ReasonPhrase = ShortByteString+type SeqNum = Int++data Frame = Padding Int+           | Ping+           | Ack AckInfo Delay+           | ResetStream StreamId ApplicationProtocolError Int+           | StopSending StreamId ApplicationProtocolError+           | CryptoF Offset CryptoData+           | NewToken Token+           | StreamF StreamId Offset [StreamData] Fin+           | MaxData Int+           | MaxStreamData StreamId Int+           | MaxStreams Direction Int+           | DataBlocked Int+           | StreamDataBlocked StreamId Int+           | StreamsBlocked Direction Int+           | NewConnectionID CIDInfo SeqNum -- retire prior to+           | RetireConnectionID SeqNum+           | PathChallenge PathData+           | PathResponse PathData+           | ConnectionClose     TransportError FrameType ReasonPhrase+           | ConnectionCloseApp  ApplicationProtocolError ReasonPhrase+           | HandshakeDone+           | UnknownFrame Int+           deriving (Eq,Show)++-- | Stream identifier.+--   This should be 62-bit interger.+--   On 32-bit machines, the total number of stream identifiers is limited.+type StreamId = Int++-- | Checking if a stream is client-initiated bidirectional.+isClientInitiatedBidirectional :: StreamId -> Bool+isClientInitiatedBidirectional  sid = (0b11 .&. sid) == 0++-- | Checking if a stream is server-initiated bidirectional.+isServerInitiatedBidirectional :: StreamId -> Bool+isServerInitiatedBidirectional  sid = (0b11 .&. sid) == 1++-- | Checking if a stream is client-initiated unidirectional.+isClientInitiatedUnidirectional :: StreamId -> Bool+isClientInitiatedUnidirectional sid = (0b11 .&. sid) == 2++-- | Checking if a stream is server-initiated unidirectional.+isServerInitiatedUnidirectional :: StreamId -> Bool+isServerInitiatedUnidirectional sid = (0b11 .&. sid) == 3++isClientInitiated :: StreamId -> Bool+isClientInitiated sid = (0b1 .&. sid) == 0++isServerInitiated :: StreamId -> Bool+isServerInitiated sid = (0b1 .&. sid) == 1++type Delay = Milliseconds++type Fin = Bool++type CryptoData = ByteString+type StreamData = ByteString++type Token = ByteString -- to be decrypted+emptyToken :: Token+emptyToken = ""++ackEliciting :: Frame -> Bool+ackEliciting Padding{}            = False+ackEliciting Ack{}                = False+ackEliciting ConnectionClose{}    = False+ackEliciting ConnectionCloseApp{} = False+ackEliciting _                    = True++pathValidating :: Frame -> Bool+pathValidating PathChallenge{} = True+pathValidating PathResponse{}  = True+pathValidating _               = False++inFlight :: Frame -> Bool+inFlight Ack{}                = False+inFlight ConnectionClose{}    = False+inFlight ConnectionCloseApp{} = False+inFlight _                    = True
+ Network/QUIC/Types/Integer.hs view
@@ -0,0 +1,140 @@+{-# LANGUAGE BinaryLiterals #-}++module Network.QUIC.Types.Integer (+    encodeInt+  , encodeInt8+  , encodeInt'+  , encodeInt'2+  , encodeInt'4+  , decodeInt+  , decodeInt'+  ) where++import Data.ByteString.Internal (unsafeCreate)+import Foreign.Ptr+import Foreign.Storable+import System.IO.Unsafe (unsafeDupablePerformIO)++import Network.QUIC.Imports++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Network.QUIC.Utils++----------------------------------------------------------------++-- |+-- >>> enc16 $ encodeInt 151288809941952652+-- "c2197c5eff14e88c"+-- >>> enc16 $ encodeInt 494878333+-- "9d7f3e7d"+-- >>> enc16 $ encodeInt 15293+-- "7bbd"+-- >>> enc16 $ encodeInt 37+-- "25"+encodeInt :: Int64  -> ByteString+encodeInt i = unsafeCreate n $ go tag n i'+  where+    (tag,n,i') = tagLen i+{-# NOINLINE encodeInt #-}++encodeInt8 :: Int64  -> ByteString+encodeInt8 i = unsafeCreate n $ go tag n i+  where+    n = 8+    tag = 0b11000000+{-# NOINLINE encodeInt8 #-}++encodeInt' :: WriteBuffer -> Int64 -> IO ()+encodeInt' wbuf i = go' tag n i' wbuf+  where+    (tag,n,i') = tagLen i++encodeInt'2 :: WriteBuffer -> Int64 -> IO ()+encodeInt'2 wbuf i = go' tag n i' wbuf+  where+    tag = 0b01000000+    n = 2+    i' = i .<<. 48++encodeInt'4 :: WriteBuffer -> Int64 -> IO ()+encodeInt'4 wbuf i = go' tag n i' wbuf+  where+    tag = 0b10000000+    n = 4+    i' = i .<<. 32++tagLen :: Int64 -> (Word8, Int, Int64)+tagLen i | i <=         63 = (0b00000000, 1, i .<<. 56)+         | i <=      16383 = (0b01000000, 2, i .<<. 48)+         | i <= 1073741823 = (0b10000000, 4, i .<<. 32)+         | otherwise       = (0b11000000, 8, i)+{-# INLINE tagLen #-}++msb8 :: Int64 -> Word8+msb8 i = fromIntegral (i .>>. 56)+{-# INLINE msb8 #-}++go :: Word8 -> Int -> Int64 -> Ptr Word8 -> IO ()+go tag n0 i0 p0 = do+    poke p0 (tag .|. msb8 i0)+    let n' = n0 - 1+        i' = i0 .<<. 8+        p' = p0 `plusPtr` 1+    loop n' i' p'+  where+    loop 0 _ _ = return ()+    loop n i p = do+        poke p $ msb8 i+        let n' = n - 1+            i' = i .<<. 8+            p' = p `plusPtr` 1+        loop n' i' p'+{-# INLINE go #-}++go' :: Word8 -> Int -> Int64 -> WriteBuffer -> IO ()+go' tag n0 i0 wbuf = do+    write8 wbuf (tag .|. msb8 i0)+    let n' = n0 - 1+        i' = i0 .<<. 8+    loop n' i'+  where+    loop 0 _ = return ()+    loop n i = do+        write8 wbuf $ msb8 i+        let n' = n - 1+            i' = i .<<. 8+        loop n' i'+{-# INLINE go' #-}++----------------------------------------------------------------++-- |+-- >>> decodeInt (dec16 "c2197c5eff14e88c")+-- 151288809941952652+-- >>> decodeInt (dec16 "9d7f3e7d")+-- 494878333+-- >>> decodeInt (dec16 "7bbd")+-- 15293+-- >>> decodeInt (dec16 "25")+-- 37+decodeInt :: ByteString -> Int64+decodeInt bs = unsafeDupablePerformIO $ withReadBuffer bs decodeInt'+{-# NOINLINE decodeInt #-}++decodeInt' :: ReadBuffer -> IO Int64+decodeInt' rbuf = do+    b0 <- read8 rbuf+    let flag = b0 .>>. 6+        b1 = fromIntegral (b0 .&. 0b00111111)+    case flag of+      0 -> return b1+      1 -> loop b1 1+      2 -> loop b1 3+      _ -> loop b1 7+  where+    loop :: Int64 -> Int -> IO Int64+    loop r 0 = return r+    loop r n = do+        b <- fromIntegral <$> read8 rbuf+        loop (r*256 + b) (n - 1)
+ Network/QUIC/Types/Packet.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}++module Network.QUIC.Types.Packet where++import Data.Ix++import Network.QUIC.Imports+import Network.QUIC.Types.Ack+import Network.QUIC.Types.CID+import Network.QUIC.Types.Frame+import Network.QUIC.Types.Time++----------------------------------------------------------------++-- | QUIC version.+newtype Version = Version Word32 deriving (Eq, Ord, Show)++pattern Negotiation      :: Version+pattern Negotiation       = Version 0+pattern Version1         :: Version+pattern Version1          = Version 1+pattern Draft29          :: Version+pattern Draft29           = Version 0xff00001d+pattern GreasingVersion  :: Version+pattern GreasingVersion   = Version 0x0a0a0a0a+pattern GreasingVersion2 :: Version+pattern GreasingVersion2  = Version 0x1a2a3a4a++----------------------------------------------------------------++data PacketI = PacketIV VersionNegotiationPacket+             | PacketIR RetryPacket+             | PacketIC CryptPacket EncryptionLevel+             | PacketIB BrokenPacket+             deriving (Eq, Show)++-- Not used internally. Only for 'encodePacket'.+data PacketO = PacketOV VersionNegotiationPacket+             | PacketOR RetryPacket+             | PacketOP PlainPacket+             deriving (Eq, Show)++data VersionNegotiationPacket = VersionNegotiationPacket CID CID [Version]+                              deriving (Eq, Show)++data RetryPacket = RetryPacket Version CID CID Token (Either CID (ByteString,ByteString))+                 deriving (Eq, Show)++data BrokenPacket = BrokenPacket deriving (Eq, Show)++data Header = Initial   Version  CID CID Token+            | RTT0      Version  CID CID+            | Handshake Version  CID CID+            | Short              CID+            deriving (Eq, Show)++headerMyCID :: Header -> CID+headerMyCID (Initial   _ cid _ _) = cid+headerMyCID (RTT0      _ cid _)   = cid+headerMyCID (Handshake _ cid _)   = cid+headerMyCID (Short       cid)     = cid++headerPeerCID :: Header -> CID+headerPeerCID (Initial   _ _ cid _) = cid+headerPeerCID (RTT0      _ _ cid)   = cid+headerPeerCID (Handshake _ _ cid)   = cid+headerPeerCID  Short{}              = CID ""++data PlainPacket = PlainPacket Header Plain deriving (Eq, Show)+data CryptPacket = CryptPacket Header Crypt deriving (Eq, Show)++data Plain = Plain {+    plainFlags        :: Flags Raw+  , plainPacketNumber :: PacketNumber+  , plainFrames       :: [Frame]+  , plainMarks        :: Int+  } deriving (Eq, Show)++defaultPlainMarks :: Int+defaultPlainMarks = 0++setIllegalReservedBits :: Int -> Int+setIllegalReservedBits = (`setBit` 0)++setUnknownFrame :: Int -> Int+setUnknownFrame = (`setBit` 1)++setNoFrames :: Int -> Int+setNoFrames = (`setBit` 2)++setNoPaddings :: Int -> Int+setNoPaddings = (`setBit` 8)++set4bytesPN :: Int -> Int+set4bytesPN = (`setBit` 9)++isIllegalReservedBits :: Int -> Bool+isIllegalReservedBits = (`testBit` 0)++isUnknownFrame :: Int -> Bool+isUnknownFrame = (`testBit` 1)++isNoFrames :: Int -> Bool+isNoFrames = (`testBit` 2)++isNoPaddings :: Int -> Bool+isNoPaddings = (`testBit` 8)++is4bytesPN :: Int -> Bool+is4bytesPN = (`testBit` 9)++data Crypt = Crypt {+    cryptPktNumOffset :: Int+  , cryptPacket       :: ByteString+  , cryptMarks        :: Int+  } deriving (Eq, Show)++isCryptLogged :: Crypt -> Bool+isCryptLogged  crypt = cryptMarks crypt `testBit` 0++isCryptDelayed :: Crypt -> Bool+isCryptDelayed crypt = cryptMarks crypt `testBit` 1++setCryptLogged :: Crypt -> Crypt+setCryptLogged  crypt = crypt { cryptMarks = cryptMarks crypt `setBit` 0 }++setCryptDelayed :: Crypt -> Crypt+setCryptDelayed crypt = crypt { cryptMarks = cryptMarks crypt `setBit` 1 }++data StatelessReset = StatelessReset deriving (Eq, Show)++data ReceivedPacket = ReceivedPacket {+    rpCryptPacket     :: CryptPacket+  , rpTimeRecevied    :: TimeMicrosecond+  , rpReceivedBytes   :: Int+  , rpEncryptionLevel :: EncryptionLevel+  } deriving (Eq, Show)++mkReceivedPacket :: CryptPacket -> TimeMicrosecond -> Int -> EncryptionLevel -> ReceivedPacket+mkReceivedPacket cpkt tim bytes lvl = ReceivedPacket {+    rpCryptPacket     = cpkt+  , rpTimeRecevied    = tim+  , rpReceivedBytes   = bytes+  , rpEncryptionLevel = lvl+  }++----------------------------------------------------------------++data LongHeaderPacketType = InitialPacketType+                          | RTT0PacketType+                          | HandshakePacketType+                          | RetryPacketType+                          deriving (Eq, Show)++data EncryptionLevel = InitialLevel+                     | RTT0Level+                     | HandshakeLevel+                     | RTT1Level+                     deriving (Eq, Ord, Ix, Show)++packetEncryptionLevel :: Header -> EncryptionLevel+packetEncryptionLevel Initial{}   = InitialLevel+packetEncryptionLevel RTT0{}      = RTT0Level+packetEncryptionLevel Handshake{} = HandshakeLevel+packetEncryptionLevel Short{}     = RTT1Level++----------------------------------------------------------------++newtype Flags a = Flags Word8 deriving (Eq, Show)++data Protected+data Raw++----------------------------------------------------------------++type EncodedPacketNumber = Word32
+ Network/QUIC/Types/Queue.hs view
@@ -0,0 +1,19 @@+module Network.QUIC.Types.Queue where++import Control.Concurrent.STM++import Network.QUIC.Types.Packet++newtype RecvQ = RecvQ (TQueue ReceivedPacket)++newRecvQ :: IO RecvQ+newRecvQ = RecvQ <$> newTQueueIO++readRecvQ :: RecvQ -> IO ReceivedPacket+readRecvQ (RecvQ q) = atomically $ readTQueue q++writeRecvQ :: RecvQ -> ReceivedPacket -> IO ()+writeRecvQ (RecvQ q) x = atomically $ writeTQueue q x++prependRecvQ :: RecvQ -> ReceivedPacket -> STM ()+prependRecvQ (RecvQ q) = unGetTQueue q
+ Network/QUIC/Types/Resumption.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE RecordWildCards #-}++module Network.QUIC.Types.Resumption where++import Network.TLS+import Network.TLS.QUIC++import Network.QUIC.Imports+import Network.QUIC.Types.Frame++type SessionEstablish = SessionID -> SessionData -> IO ()++-- | Information about resumption+data ResumptionInfo = ResumptionInfo {+    resumptionSession :: Maybe (SessionID, SessionData)+  , resumptionToken   :: Token+  , resumptionRetry   :: Bool+  } deriving (Eq, Show)++defaultResumptionInfo :: ResumptionInfo+defaultResumptionInfo = ResumptionInfo {+    resumptionSession = Nothing+  , resumptionToken   = emptyToken+  , resumptionRetry   = False+  }++-- | Is 0RTT possible?+is0RTTPossible :: ResumptionInfo -> Bool+is0RTTPossible ResumptionInfo{..} =+    rtt0OK && (not resumptionRetry || resumptionToken /= emptyToken)+  where+    rtt0OK = case resumptionSession of+      Nothing      -> False+      Just (_, sd) -> sessionMaxEarlyDataSize sd == quicMaxEarlyDataSize++-- | Is resumption possible?+isResumptionPossible :: ResumptionInfo -> Bool+isResumptionPossible ResumptionInfo{..} = isJust resumptionSession++get0RTTCipher :: ResumptionInfo -> Maybe CipherID+get0RTTCipher ri = case resumptionSession ri of+  Nothing      -> Nothing+  Just (_, sd) -> Just $ sessionCipher sd+
+ Network/QUIC/Types/Time.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Network.QUIC.Types.Time (+    Milliseconds(..)+  , Microseconds(..)+  , milliToMicro+  , microToMilli+  , TimeMicrosecond+  , timeMicrosecond0+  , getTimeMicrosecond+  , getElapsedTimeMicrosecond+  , elapsedTimeMicrosecond+  , getTimeoutInMicrosecond+  , getPastTimeMicrosecond+  , getFutureTimeMicrosecond+  , addMicroseconds+  ) where++import Data.UnixTime+import Foreign.C.Types (CTime(..))++import Network.QUIC.Imports++----------------------------------------------------------------++newtype Milliseconds = Milliseconds Int64 deriving (Eq, Ord, Num, Bits)+newtype Microseconds = Microseconds Int deriving (Eq, Ord, Num, Bits)++instance Show Milliseconds where+  show (Milliseconds n) = show n++instance Show Microseconds where+  show (Microseconds n) = show n++{-# INLINE milliToMicro #-}+milliToMicro :: Milliseconds -> Microseconds+milliToMicro (Milliseconds n) = Microseconds (fromIntegral n * 1000)++microToMilli :: Microseconds -> Milliseconds+microToMilli (Microseconds n) = Milliseconds (fromIntegral n `div` 1000)++----------------------------------------------------------------++type TimeMicrosecond = UnixTime++timeMicrosecond0 :: UnixTime+timeMicrosecond0 = UnixTime 0 0++----------------------------------------------------------------++getTimeMicrosecond :: IO TimeMicrosecond+getTimeMicrosecond = getUnixTime++----------------------------------------------------------------++getElapsedTimeMicrosecond :: TimeMicrosecond -> IO Microseconds+getElapsedTimeMicrosecond base = do+    c <- getTimeMicrosecond+    return $ elapsedTimeMicrosecond c base++elapsedTimeMicrosecond :: UnixTime -> UnixTime -> Microseconds+elapsedTimeMicrosecond c base = Microseconds elapsed+  where+    UnixDiffTime (CTime s) u = c `diffUnixTime` base+    elapsed = fromIntegral (s * 1000000 + fromIntegral u)++getTimeoutInMicrosecond :: TimeMicrosecond -> IO Microseconds+getTimeoutInMicrosecond tmout = do+    c <- getTimeMicrosecond+    let UnixDiffTime (CTime s) u = tmout `diffUnixTime` c+        timeout = fromIntegral s * 1000000 + fromIntegral u+    return $ Microseconds timeout++----------------------------------------------------------------++getPastTimeMicrosecond :: Microseconds -> IO TimeMicrosecond+getPastTimeMicrosecond (Microseconds us) = do+    let diff = microSecondsToUnixDiffTime $ negate us+    c <- getTimeMicrosecond+    let past = c `addUnixDiffTime` diff+    return past++getFutureTimeMicrosecond :: Microseconds -> IO TimeMicrosecond+getFutureTimeMicrosecond (Microseconds us) = do+    let diff = microSecondsToUnixDiffTime us+    c <- getTimeMicrosecond+    let future = c `addUnixDiffTime` diff+    return future++addMicroseconds :: TimeMicrosecond -> Microseconds -> TimeMicrosecond+addMicroseconds t (Microseconds n) = t `addUnixDiffTime` microSecondsToUnixDiffTime n
+ Network/QUIC/Utils.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.QUIC.Utils where++import Control.Monad (replicateM)+import qualified Data.ByteString as BS+import Data.ByteString.Base16+import qualified Data.ByteString.Char8 as C8+import Data.ByteString.Internal (ByteString(..))+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as Short+import Data.Char (chr)+import Data.List (foldl')+import Data.Word+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (Ptr, plusPtr)+import System.Random (randomIO)+import UnliftIO.Exception++-- GHC 8.0 does not provide fromRight.+fromRight :: b -> Either a b -> b+fromRight _ (Right b) = b+fromRight b _         = b++dec16 :: ByteString -> ByteString+dec16 = fromRight "" . decode++enc16 :: ByteString -> ByteString+enc16 = encode++dec16s :: ShortByteString -> ShortByteString+dec16s = Short.toShort . fromRight "" . decode . Short.fromShort++enc16s :: ShortByteString -> ShortByteString+enc16s = Short.toShort . encode . Short.fromShort++shortToString :: ShortByteString -> String+shortToString = map (chr . fromIntegral) . Short.unpack++getRandomOneByte :: IO Word8+getRandomOneByte = randomIO++getRandomBytes :: Int -> IO ShortByteString+getRandomBytes n = Short.pack <$> replicateM n getRandomOneByte++{-# INLINE totalLen #-}+totalLen :: [ByteString] -> Int+totalLen = foldl' (\n bs -> n + BS.length bs) 0++sum' :: (Functor f, Foldable f) => f Int -> Int+sum' = foldl' (+) 0++withByteString :: ByteString -> (Ptr Word8 -> IO a) -> IO a+withByteString (PS fptr off _) f = withForeignPtr fptr $ \ptr ->+  f (ptr `plusPtr` off)++shortpack :: String -> ShortByteString+shortpack = Short.toShort . C8.pack++ignore :: SomeException -> IO ()+ignore _ = return ()
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/fusion.c view
@@ -0,0 +1,1100 @@+/*+ * This source file is licensed under the Apache License 2.0 *and* the MIT+ * License. Please agree to *both* of the licensing terms!+ *+ *+ * `transformH` function is a derivative work of OpenSSL. The original work+ * is covered by the following license:+ *+ * Copyright 2013-2020 The OpenSSL Project Authors. All Rights Reserved.+ *+ * Licensed under the Apache License 2.0 (the "License").  You may not use+ * this file except in compliance with the License.  You can obtain a copy+ * in the file LICENSE in the source distribution or at+ * https://www.openssl.org/source/license.html+ *+ *+ * All other work, including modifications to the `transformH` function is+ * covered by the following MIT license:+ *+ * Copyright (c) 2020 Fastly, Kazuho Oku+ *+ * Permission is hereby granted, free of charge, to any person obtaining a copy+ * of this software and associated documentation files (the "Software"), to+ * deal in the Software without restriction, including without limitation the+ * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+ * sell copies of the Software, and to permit persons to whom the Software is+ * furnished to do so, subject to the following conditions:+ *+ * The above copyright notice and this permission notice shall be included in+ * all copies or substantial portions of the Software.+ *+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+ * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+ * IN THE SOFTWARE.+ */+#include <stdint.h>++#include <stdlib.h>+#include <string.h>+#include <immintrin.h>+#include <tmmintrin.h>+#include <nmmintrin.h>+#include <wmmintrin.h>+#include "picotls.h"+#include "picotls/fusion.h"++struct ptls_fusion_aesgcm_context {+    ptls_fusion_aesecb_context_t ecb;+    size_t capacity;+    size_t ghash_cnt;+    struct ptls_fusion_aesgcm_ghash_precompute {+        __m128i H;+        __m128i r;+    } ghash[0];+};++struct ctr_context {+    ptls_cipher_context_t super;+    ptls_fusion_aesecb_context_t fusion;+    __m128i bits;+    uint8_t is_ready;+};++struct aesgcm_context {+    ptls_aead_context_t super;+    ptls_fusion_aesgcm_context_t *aesgcm;+    /**+     * retains the static IV in the upper 96 bits (in little endian)+     */+    __m128i static_iv;+};++static const uint64_t poly_[2] __attribute__((aligned(16))) = {1, 0xc200000000000000};+#define poly (*(__m128i *)poly_)+static const uint8_t bswap8_[16] __attribute__((aligned(16))) = {15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0};+#define bswap8 (*(__m128i *)bswap8_)+static const uint8_t one8_[16] __attribute__((aligned(16))) = {1};+#define one8 (*(__m128i *)one8_)++/* This function is covered by the Apache License and the MIT License. The origin is crypto/modes/asm/ghash-x86_64.pl of openssl+ * at commit 33388b4. */+static __m128i transformH(__m128i H)+{+    //  # <<1 twist+    //  pshufd          \$0b11111111,$Hkey,$T2  # broadcast uppermost dword+    __m128i t2 = _mm_shuffle_epi32(H, 0xff);+    // movdqa          $Hkey,$T1+    __m128i t1 = H;+    // psllq           \$1,$Hkey+    H = _mm_slli_epi64(H, 1);+    // pxor            $T3,$T3                 #+    __m128i t3 = _mm_setzero_si128();+    // psrlq           \$63,$T1+    t1 = _mm_srli_epi64(t1, 63);+    // pcmpgtd         $T2,$T3                 # broadcast carry bit+    t3 = _mm_cmplt_epi32(t2, t3);+    //     pslldq          \$8,$T1+    t1 = _mm_slli_si128(t1, 8);+    // por             $T1,$Hkey               # H<<=1+    H = _mm_or_si128(t1, H);++    // # magic reduction+    // pand            .L0x1c2_polynomial(%rip),$T3+    t3 = _mm_and_si128(t3, poly);+    // pxor            $T3,$Hkey               # if(carry) H^=0x1c2_polynomial+    H = _mm_xor_si128(t3, H);++    return H;+}+// end of Apache License code++static __m128i gfmul(__m128i x, __m128i y)+{+    __m128i lo = _mm_clmulepi64_si128(x, y, 0x00);+    __m128i hi = _mm_clmulepi64_si128(x, y, 0x11);++    __m128i a = _mm_shuffle_epi32(x, 78);+    __m128i b = _mm_shuffle_epi32(y, 78);+    a = _mm_xor_si128(a, x);+    b = _mm_xor_si128(b, y);++    a = _mm_clmulepi64_si128(a, b, 0x00);+    a = _mm_xor_si128(a, lo);+    a = _mm_xor_si128(a, hi);++    b = _mm_slli_si128(a, 8);+    a = _mm_srli_si128(a, 8);++    lo = _mm_xor_si128(lo, b);+    hi = _mm_xor_si128(hi, a);++    // from https://crypto.stanford.edu/RealWorldCrypto/slides/gueron.pdf+    __m128i t = _mm_clmulepi64_si128(lo, poly, 0x10);+    lo = _mm_shuffle_epi32(lo, 78);+    lo = _mm_xor_si128(lo, t);+    t = _mm_clmulepi64_si128(lo, poly, 0x10);+    lo = _mm_shuffle_epi32(lo, 78);+    lo = _mm_xor_si128(lo, t);++    return _mm_xor_si128(hi, lo);+}++struct ptls_fusion_gfmul_state {+    __m128i hi, lo, mid;+};++static inline void gfmul_onestep(struct ptls_fusion_gfmul_state *gstate, __m128i X,+                                 struct ptls_fusion_aesgcm_ghash_precompute *precompute)+{+    X = _mm_shuffle_epi8(X, bswap8);+    __m128i t = _mm_clmulepi64_si128(precompute->H, X, 0x00);+    gstate->lo = _mm_xor_si128(gstate->lo, t);+    t = _mm_clmulepi64_si128(precompute->H, X, 0x11);+    gstate->hi = _mm_xor_si128(gstate->hi, t);+    t = _mm_shuffle_epi32(X, 78);+    t = _mm_xor_si128(t, X);+    t = _mm_clmulepi64_si128(precompute->r, t, 0x00);+    gstate->mid = _mm_xor_si128(gstate->mid, t);+}++static inline __m128i gfmul_final(struct ptls_fusion_gfmul_state *gstate, __m128i ek0)+{+    /* finish multiplication */+    gstate->mid = _mm_xor_si128(gstate->mid, gstate->hi);+    gstate->mid = _mm_xor_si128(gstate->mid, gstate->lo);+    gstate->lo = _mm_xor_si128(gstate->lo, _mm_slli_si128(gstate->mid, 8));+    gstate->hi = _mm_xor_si128(gstate->hi, _mm_srli_si128(gstate->mid, 8));++    /* fast reduction, using https://crypto.stanford.edu/RealWorldCrypto/slides/gueron.pdf */+    __m128i r = _mm_clmulepi64_si128(gstate->lo, poly, 0x10);+    gstate->lo = _mm_shuffle_epi32(gstate->lo, 78);+    gstate->lo = _mm_xor_si128(gstate->lo, r);+    r = _mm_clmulepi64_si128(gstate->lo, poly, 0x10);+    gstate->lo = _mm_shuffle_epi32(gstate->lo, 78);+    gstate->lo = _mm_xor_si128(gstate->lo, r);+    __m128i tag = _mm_xor_si128(gstate->hi, gstate->lo);+    tag = _mm_shuffle_epi8(tag, bswap8);+    tag = _mm_xor_si128(tag, ek0);++    return tag;+}++static inline __m128i aesecb_encrypt(ptls_fusion_aesecb_context_t *ctx, __m128i v)+{+    size_t i;++    v = _mm_xor_si128(v, ctx->keys[0]);+    for (i = 1; i < ctx->rounds; ++i)+        v = _mm_aesenc_si128(v, ctx->keys[i]);+    v = _mm_aesenclast_si128(v, ctx->keys[i]);++    return v;+}++static const uint8_t loadn_mask[31] = {0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,+                                       0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff};+static const uint8_t loadn_shuffle[31] = {0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07,+                                          0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, // first 16 bytes map to byte offsets+                                          0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80,+                                          0x80, 0x80, 0x80, 0x80, 0x80, 0x80, 0x80}; // latter 15 bytes map to zero++static inline __m128i loadn(const void *p, size_t l)+{+    __m128i v, mask = _mm_loadu_si128((__m128i *)(loadn_mask + 16 - l));+    uintptr_t mod4k = (uintptr_t)p % 4096;++    if (PTLS_LIKELY(mod4k <= 4080) || mod4k + l > 4096) {+        v = _mm_loadu_si128(p);+    } else {+        uintptr_t shift = (uintptr_t)p & 15;+        __m128i pattern = _mm_loadu_si128((const __m128i *)(loadn_shuffle + shift));+        v = _mm_shuffle_epi8(_mm_load_si128((const __m128i *)((uintptr_t)p - shift)), pattern);+    }+    v = _mm_and_si128(v, mask);+    return v;+}++static inline void storen(void *_p, size_t l, __m128i v)+{+    uint8_t buf[16], *p = _p;++    *(__m128i *)buf = v;++    for (size_t i = 0; i != l; ++i)+        p[i] = buf[i];+}++void ptls_fusion_aesgcm_encrypt(ptls_fusion_aesgcm_context_t *ctx, void *output, const void *input, size_t inlen, __m128i ctr,+                                const void *_aad, size_t aadlen, ptls_aead_supplementary_encryption_t *supp)+{+/* init the bits (we can always run in full), but use the last slot for calculating ek0, if possible */+#define AESECB6_INIT()                                                                                                             \+    do {                                                                                                                           \+        ctr = _mm_add_epi64(ctr, one8);                                                                                            \+        bits0 = _mm_shuffle_epi8(ctr, bswap8);                                                                                     \+        ctr = _mm_add_epi64(ctr, one8);                                                                                            \+        bits1 = _mm_shuffle_epi8(ctr, bswap8);                                                                                     \+        ctr = _mm_add_epi64(ctr, one8);                                                                                            \+        bits2 = _mm_shuffle_epi8(ctr, bswap8);                                                                                     \+        ctr = _mm_add_epi64(ctr, one8);                                                                                            \+        bits3 = _mm_shuffle_epi8(ctr, bswap8);                                                                                     \+        ctr = _mm_add_epi64(ctr, one8);                                                                                            \+        bits4 = _mm_shuffle_epi8(ctr, bswap8);                                                                                     \+        if (PTLS_LIKELY(srclen > 16 * 5)) {                                                                                        \+            ctr = _mm_add_epi64(ctr, one8);                                                                                        \+            bits5 = _mm_shuffle_epi8(ctr, bswap8);                                                                                 \+        } else {                                                                                                                   \+            if ((state & STATE_EK0_BEEN_FED) == 0) {                                                                               \+                bits5 = ek0;                                                                                                       \+                state |= STATE_EK0_BEEN_FED;                                                                                       \+            }                                                                                                                      \+            if ((state & STATE_SUPP_USED) != 0 && srclen <= 16 * 4 && (const __m128i *)supp->input + 1 <= dst_ghash) {             \+                bits4 = _mm_loadu_si128(supp->input);                                                                              \+                bits4keys = ((struct ctr_context *)supp->ctx)->fusion.keys;                                                        \+                state |= STATE_SUPP_IN_PROCESS;                                                                                    \+            }                                                                                                                      \+        }                                                                                                                          \+        __m128i k = ctx->ecb.keys[0];                                                                                              \+        bits0 = _mm_xor_si128(bits0, k);                                                                                           \+        bits1 = _mm_xor_si128(bits1, k);                                                                                           \+        bits2 = _mm_xor_si128(bits2, k);                                                                                           \+        bits3 = _mm_xor_si128(bits3, k);                                                                                           \+        bits4 = _mm_xor_si128(bits4, bits4keys[0]);                                                                                \+        bits5 = _mm_xor_si128(bits5, k);                                                                                           \+    } while (0)++/* aes block update */+#define AESECB6_UPDATE(i)                                                                                                          \+    do {                                                                                                                           \+        __m128i k = ctx->ecb.keys[i];                                                                                              \+        bits0 = _mm_aesenc_si128(bits0, k);                                                                                        \+        bits1 = _mm_aesenc_si128(bits1, k);                                                                                        \+        bits2 = _mm_aesenc_si128(bits2, k);                                                                                        \+        bits3 = _mm_aesenc_si128(bits3, k);                                                                                        \+        bits4 = _mm_aesenc_si128(bits4, bits4keys[i]);                                                                             \+        bits5 = _mm_aesenc_si128(bits5, k);                                                                                        \+    } while (0)++/* aesenclast */+#define AESECB6_FINAL(i)                                                                                                           \+    do {                                                                                                                           \+        __m128i k = ctx->ecb.keys[i];                                                                                              \+        bits0 = _mm_aesenclast_si128(bits0, k);                                                                                    \+        bits1 = _mm_aesenclast_si128(bits1, k);                                                                                    \+        bits2 = _mm_aesenclast_si128(bits2, k);                                                                                    \+        bits3 = _mm_aesenclast_si128(bits3, k);                                                                                    \+        bits4 = _mm_aesenclast_si128(bits4, bits4keys[i]);                                                                         \+        bits5 = _mm_aesenclast_si128(bits5, k);                                                                                    \+    } while (0)++    __m128i ek0, bits0, bits1, bits2, bits3, bits4, bits5 = _mm_setzero_si128();+    const __m128i *bits4keys = ctx->ecb.keys; /* is changed to supp->ctx.keys when calcurating suppout */+    struct ptls_fusion_gfmul_state gstate = {0};+    __m128i gdatabuf[6];+    __m128i ac = _mm_shuffle_epi8(_mm_set_epi32(0, (int)aadlen * 8, 0, (int)inlen * 8), bswap8);++    // src and dst are updated after the chunk is processed+    const __m128i *src = input;+    __m128i *dst = output;+    size_t srclen = inlen;+    // aad and src_ghash are updated before the chunk is processed (i.e., when the pointers are fed indo the processor)+    const __m128i *aad = _aad, *dst_ghash = dst;+    size_t dst_ghashlen = srclen;++    struct ptls_fusion_aesgcm_ghash_precompute *ghash_precompute = ctx->ghash + (aadlen + 15) / 16 + (srclen + 15) / 16 + 1;++#define STATE_EK0_BEEN_FED 0x3+#define STATE_EK0_INCOMPLETE 0x2+#define STATE_EK0_READY() ((state & STATE_EK0_BEEN_FED) == 0x1)+#define STATE_SUPP_USED 0x4+#define STATE_SUPP_IN_PROCESS 0x8+    int32_t state = supp != NULL ? STATE_SUPP_USED : 0;++    /* build counter */+    ctr = _mm_insert_epi32(ctr, 1, 0);+    ek0 = _mm_shuffle_epi8(ctr, bswap8);++    /* start preparing AES */+    AESECB6_INIT();+    AESECB6_UPDATE(1);++    /* build first ghash data (only AAD can be fed at this point, as this would be calculated alongside the first AES block) */+    const __m128i *gdata = gdatabuf; // points to the elements fed into GHASH+    size_t gdata_cnt = 0;+    if (PTLS_LIKELY(aadlen != 0)) {+        while (gdata_cnt < 6) {+            if (PTLS_LIKELY(aadlen < 16)) {+                if (aadlen != 0) {+                    gdatabuf[gdata_cnt++] = loadn(aad, aadlen);+                    aadlen = 0;+                }+                goto MainLoop;+            }+            gdatabuf[gdata_cnt++] = _mm_loadu_si128(aad++);+            aadlen -= 16;+        }+    }++    /* the main loop */+MainLoop:+    while (1) {+        /* run AES and multiplication in parallel */+        size_t i;+        for (i = 2; i < gdata_cnt + 2; ++i) {+            AESECB6_UPDATE(i);+            gfmul_onestep(&gstate, _mm_loadu_si128(gdata++), --ghash_precompute);+        }+        for (; i < ctx->ecb.rounds; ++i)+            AESECB6_UPDATE(i);+        AESECB6_FINAL(i);++        /* apply the bit stream to src and write to dest */+        if (PTLS_LIKELY(srclen >= 6 * 16)) {+#define APPLY(i) _mm_storeu_si128(dst + i, _mm_xor_si128(_mm_loadu_si128(src + i), bits##i))+            APPLY(0);+            APPLY(1);+            APPLY(2);+            APPLY(3);+            APPLY(4);+            APPLY(5);+#undef APPLY+            dst += 6;+            src += 6;+            srclen -= 6 * 16;+        } else {+            if ((state & STATE_EK0_BEEN_FED) == STATE_EK0_BEEN_FED) {+                ek0 = bits5;+                state &= ~STATE_EK0_INCOMPLETE;+            }+            if ((state & STATE_SUPP_IN_PROCESS) != 0) {+                _mm_storeu_si128((__m128i *)supp->output, bits4);+                state &= ~(STATE_SUPP_USED | STATE_SUPP_IN_PROCESS);+            }+            if (srclen != 0) {+#define APPLY(i)                                                                                                                   \+    do {                                                                                                                           \+        if (PTLS_LIKELY(srclen >= 16)) {                                                                                           \+            _mm_storeu_si128(dst++, _mm_xor_si128(_mm_loadu_si128(src++), bits##i));                                               \+            srclen -= 16;                                                                                                          \+        } else if (PTLS_LIKELY(srclen != 0)) {                                                                                     \+            bits0 = bits##i;                                                                                                       \+            goto ApplyRemainder;                                                                                                   \+        } else {                                                                                                                   \+            goto ApplyEnd;                                                                                                         \+        }                                                                                                                          \+    } while (0)+                APPLY(0);+                APPLY(1);+                APPLY(2);+                APPLY(3);+                APPLY(4);+                APPLY(5);+#undef APPLY+                goto ApplyEnd;+            ApplyRemainder:+                storen(dst, srclen, _mm_xor_si128(loadn(src, srclen), bits0));+                dst = (__m128i *)((uint8_t *)dst + srclen);+                srclen = 0;+            ApplyEnd:;+            }+        }++        /* next block AES starts here */+        AESECB6_INIT();++        AESECB6_UPDATE(1);++        /* setup gdata */+        if (PTLS_UNLIKELY(aadlen != 0)) {+            gdata_cnt = 0;+            while (gdata_cnt < 6) {+                if (aadlen < 16) {+                    if (aadlen != 0) {+                        gdatabuf[gdata_cnt++] = loadn(aad, aadlen);+                        aadlen = 0;+                    }+                    goto GdataFillDST;+                }+                gdatabuf[gdata_cnt++] = _mm_loadu_si128(aad++);+                aadlen -= 16;+            }+            gdata = gdatabuf;+        } else if (PTLS_LIKELY(dst_ghashlen >= 6 * 16)) {+            gdata = dst_ghash;+            gdata_cnt = 6;+            dst_ghash += 6;+            dst_ghashlen -= 96;+        } else {+            gdata_cnt = 0;+        GdataFillDST:+            while (gdata_cnt < 6) {+                if (dst_ghashlen < 16) {+                    if (dst_ghashlen != 0) {+                        gdatabuf[gdata_cnt++] = loadn(dst_ghash, dst_ghashlen);+                        dst_ghashlen = 0;+                    }+                    if (gdata_cnt < 6)+                        goto Finish;+                    break;+                }+                gdatabuf[gdata_cnt++] = _mm_loadu_si128(dst_ghash++);+                dst_ghashlen -= 16;+            }+            gdata = gdatabuf;+        }+    }++Finish:+    gdatabuf[gdata_cnt++] = ac;++    /* We have complete set of data to be fed into GHASH. Let's finish the remaining calculation.+     * Note that by now, all AES operations for payload encryption and ek0 are complete. This is is because it is necessary for GCM+     * to process at least the same amount of data (i.e. payload-blocks + AC), and because AES is at least one 96-byte block ahead.+     */+    assert(STATE_EK0_READY());+    for (size_t i = 0; i < gdata_cnt; ++i)+        gfmul_onestep(&gstate, gdatabuf[i], --ghash_precompute);++    _mm_storeu_si128(dst, gfmul_final(&gstate, ek0));++    /* Finish the calculation of supplemental vector. Done at the very last, because the sample might cover the GCM tag. */+    if ((state & STATE_SUPP_USED) != 0) {+        size_t i;+        if ((state & STATE_SUPP_IN_PROCESS) == 0) {+            bits4keys = ((struct ctr_context *)supp->ctx)->fusion.keys;+            bits4 = _mm_xor_si128(_mm_loadu_si128(supp->input), bits4keys[0]);+            i = 1;+        } else {+            i = 2;+        }+        do {+            bits4 = _mm_aesenc_si128(bits4, bits4keys[i++]);+        } while (i != ctx->ecb.rounds);+        bits4 = _mm_aesenclast_si128(bits4, bits4keys[i]);+        _mm_storeu_si128((__m128i *)supp->output, bits4);+    }++#undef AESECB6_INIT+#undef AESECB6_UPDATE+#undef AESECB6_FINAL+#undef STATE_EK0_BEEN_FOUND+#undef STATE_EK0_READY+#undef STATE_SUPP_IN_PROCESS+}++int ptls_fusion_aesgcm_decrypt(ptls_fusion_aesgcm_context_t *ctx, void *output, const void *input, size_t inlen, __m128i ctr,+                               const void *_aad, size_t aadlen, const void *tag)+{+    __m128i ek0 = _mm_setzero_si128(), bits0, bits1 = _mm_setzero_si128(), bits2 = _mm_setzero_si128(), bits3 = _mm_setzero_si128(),+            bits4 = _mm_setzero_si128(), bits5 = _mm_setzero_si128();+    struct ptls_fusion_gfmul_state gstate = {0};+    __m128i gdatabuf[6];+    __m128i ac = _mm_shuffle_epi8(_mm_set_epi32(0, (int)aadlen * 8, 0, (int)inlen * 8), bswap8);+    struct ptls_fusion_aesgcm_ghash_precompute *ghash_precompute = ctx->ghash + (aadlen + 15) / 16 + (inlen + 15) / 16 + 1;++    const __m128i *gdata; // points to the elements fed into GHASH+    size_t gdata_cnt;++    const __m128i *src_ghash = input, *src_aes = input, *aad = _aad;+    __m128i *dst = output;+    size_t nondata_aes_cnt = 0, src_ghashlen = inlen, src_aeslen = inlen;++    /* schedule ek0 and suppkey */+    ctr = _mm_add_epi64(ctr, one8);+    bits0 = _mm_xor_si128(_mm_shuffle_epi8(ctr, bswap8), ctx->ecb.keys[0]);+    ++nondata_aes_cnt;++#define STATE_IS_FIRST_RUN 0x1+#define STATE_GHASH_HAS_MORE 0x2+    int state = STATE_IS_FIRST_RUN | STATE_GHASH_HAS_MORE;++    /* the main loop */+    while (1) {++        /* setup gdata */+        if (PTLS_UNLIKELY(aadlen != 0)) {+            gdata = gdatabuf;+            gdata_cnt = 0;+            while (gdata_cnt < 6) {+                if (aadlen < 16) {+                    if (aadlen != 0) {+                        gdatabuf[gdata_cnt++] = loadn(aad, aadlen);+                        aadlen = 0;+                        ++nondata_aes_cnt;+                    }+                    goto GdataFillSrc;+                }+                gdatabuf[gdata_cnt++] = _mm_loadu_si128(aad++);+                aadlen -= 16;+                ++nondata_aes_cnt;+            }+        } else if (PTLS_LIKELY(src_ghashlen >= 6 * 16)) {+            gdata = src_ghash;+            gdata_cnt = 6;+            src_ghash += 6;+            src_ghashlen -= 6 * 16;+        } else {+            gdata = gdatabuf;+            gdata_cnt = 0;+        GdataFillSrc:+            while (gdata_cnt < 6) {+                if (src_ghashlen < 16) {+                    if (src_ghashlen != 0) {+                        gdatabuf[gdata_cnt++] = loadn(src_ghash, src_ghashlen);+                        src_ghash = (__m128i *)((uint8_t *)src_ghash + src_ghashlen);+                        src_ghashlen = 0;+                    }+                    if (gdata_cnt < 6 && (state & STATE_GHASH_HAS_MORE) != 0) {+                        gdatabuf[gdata_cnt++] = ac;+                        state &= ~STATE_GHASH_HAS_MORE;+                    }+                    break;+                }+                gdatabuf[gdata_cnt++] = _mm_loadu_si128(src_ghash++);+                src_ghashlen -= 16;+            }+        }++        /* setup aes bits */+        if (PTLS_LIKELY(nondata_aes_cnt == 0))+            goto InitAllBits;+        switch (nondata_aes_cnt) {+#define INIT_BITS(n, keys)                                                                                                         \+    case n:                                                                                                                        \+        ctr = _mm_add_epi64(ctr, one8);                                                                                            \+        bits##n = _mm_xor_si128(_mm_shuffle_epi8(ctr, bswap8), keys[0]);+        InitAllBits:+            INIT_BITS(0, ctx->ecb.keys);+            INIT_BITS(1, ctx->ecb.keys);+            INIT_BITS(2, ctx->ecb.keys);+            INIT_BITS(3, ctx->ecb.keys);+            INIT_BITS(4, ctx->ecb.keys);+            INIT_BITS(5, ctx->ecb.keys);+#undef INIT_BITS+        }++        { /* run aes and ghash */+#define AESECB6_UPDATE(i)                                                                                                          \+    do {                                                                                                                           \+        __m128i k = ctx->ecb.keys[i];                                                                                              \+        bits0 = _mm_aesenc_si128(bits0, k);                                                                                        \+        bits1 = _mm_aesenc_si128(bits1, k);                                                                                        \+        bits2 = _mm_aesenc_si128(bits2, k);                                                                                        \+        bits3 = _mm_aesenc_si128(bits3, k);                                                                                        \+        bits4 = _mm_aesenc_si128(bits4, k);                                                                                        \+        bits5 = _mm_aesenc_si128(bits5, k);                                                                                        \+    } while (0)++            size_t aesi;+            for (aesi = 1; aesi <= gdata_cnt; ++aesi) {+                AESECB6_UPDATE(aesi);+                gfmul_onestep(&gstate, _mm_loadu_si128(gdata++), --ghash_precompute);+            }+            for (; aesi < ctx->ecb.rounds; ++aesi)+                AESECB6_UPDATE(aesi);+            __m128i k = ctx->ecb.keys[aesi];+            bits0 = _mm_aesenclast_si128(bits0, k);+            bits1 = _mm_aesenclast_si128(bits1, k);+            bits2 = _mm_aesenclast_si128(bits2, k);+            bits3 = _mm_aesenclast_si128(bits3, k);+            bits4 = _mm_aesenclast_si128(bits4, k);+            bits5 = _mm_aesenclast_si128(bits5, k);++#undef AESECB6_UPDATE+        }++        /* apply aes bits */+        if (PTLS_LIKELY(nondata_aes_cnt == 0 && src_aeslen >= 6 * 16)) {+#define APPLY(i) _mm_storeu_si128(dst + i, _mm_xor_si128(_mm_loadu_si128(src_aes + i), bits##i))+            APPLY(0);+            APPLY(1);+            APPLY(2);+            APPLY(3);+            APPLY(4);+            APPLY(5);+#undef APPLY+            dst += 6;+            src_aes += 6;+            src_aeslen -= 6 * 16;+        } else {+            if ((state & STATE_IS_FIRST_RUN) != 0) {+                ek0 = bits0;+                state &= ~STATE_IS_FIRST_RUN;+            }+            switch (nondata_aes_cnt) {+#define APPLY(i)                                                                                                                   \+    case i:                                                                                                                        \+        if (PTLS_LIKELY(src_aeslen > 16)) {                                                                                        \+            _mm_storeu_si128(dst++, _mm_xor_si128(_mm_loadu_si128(src_aes++), bits##i));                                           \+            src_aeslen -= 16;                                                                                                      \+        } else {                                                                                                                   \+            bits0 = bits##i;                                                                                                       \+            goto Finish;                                                                                                           \+        }+                APPLY(0);+                APPLY(1);+                APPLY(2);+                APPLY(3);+                APPLY(4);+                APPLY(5);+#undef APPLY+            }+            nondata_aes_cnt = 0;+        }+    }++Finish:+    if (src_aeslen == 16) {+        _mm_storeu_si128(dst, _mm_xor_si128(_mm_loadu_si128(src_aes), bits0));+    } else if (src_aeslen != 0) {+        storen(dst, src_aeslen, _mm_xor_si128(loadn(src_aes, src_aeslen), bits0));+    }++    assert((state & STATE_IS_FIRST_RUN) == 0);++    /* the only case where AES operation is complete and GHASH is not is when the application of AC is remaining */+    if ((state & STATE_GHASH_HAS_MORE) != 0) {+        assert(ghash_precompute - 1 == ctx->ghash);+        gfmul_onestep(&gstate, ac, --ghash_precompute);+    }++    __m128i calctag = gfmul_final(&gstate, ek0);++    return _mm_movemask_epi8(_mm_cmpeq_epi8(calctag, _mm_loadu_si128(tag))) == 0xffff;++#undef STATE_IS_FIRST_RUN+#undef STATE_GHASH_HAS_MORE+}++static __m128i expand_key(__m128i key, __m128i temp)+{+    key = _mm_xor_si128(key, _mm_slli_si128(key, 4));+    key = _mm_xor_si128(key, _mm_slli_si128(key, 4));+    key = _mm_xor_si128(key, _mm_slli_si128(key, 4));++    key = _mm_xor_si128(key, temp);++    return key;+}++void ptls_fusion_aesecb_init(ptls_fusion_aesecb_context_t *ctx, int is_enc, const void *key, size_t key_size)+{+    assert(is_enc && "decryption is not supported (yet)");++    size_t i = 0;++    switch (key_size) {+    case 16: /* AES128 */+        ctx->rounds = 10;+        break;+    case 32: /* AES256 */+        ctx->rounds = 14;+        break;+    default:+        assert(!"invalid key size; AES128 / AES256 are supported");+        break;+    }++    ctx->keys[i++] = _mm_loadu_si128((__m128i *)key);+    if (key_size == 32)+        ctx->keys[i++] = _mm_loadu_si128((__m128i *)key + 1);++#define EXPAND(R)                                                                                                                  \+    do {                                                                                                                           \+        ctx->keys[i] = expand_key(ctx->keys[i - key_size / 16],                                                                    \+                                  _mm_shuffle_epi32(_mm_aeskeygenassist_si128(ctx->keys[i - 1], R), _MM_SHUFFLE(3, 3, 3, 3)));     \+        if (i == ctx->rounds)                                                                                                      \+            goto Done;                                                                                                             \+        ++i;                                                                                                                       \+        if (key_size > 24) {                                                                                                       \+            ctx->keys[i] = expand_key(ctx->keys[i - key_size / 16],                                                                \+                                      _mm_shuffle_epi32(_mm_aeskeygenassist_si128(ctx->keys[i - 1], R), _MM_SHUFFLE(2, 2, 2, 2))); \+            ++i;                                                                                                                   \+        }                                                                                                                          \+    } while (0)+    EXPAND(0x1);+    EXPAND(0x2);+    EXPAND(0x4);+    EXPAND(0x8);+    EXPAND(0x10);+    EXPAND(0x20);+    EXPAND(0x40);+    EXPAND(0x80);+    EXPAND(0x1b);+    EXPAND(0x36);+#undef EXPAND+Done:+    assert(i == ctx->rounds);+}++void ptls_fusion_aesecb_dispose(ptls_fusion_aesecb_context_t *ctx)+{+    ptls_clear_memory(ctx, sizeof(*ctx));+}++void ptls_fusion_aesecb_encrypt(ptls_fusion_aesecb_context_t *ctx, void *dst, const void *src)+{+    __m128i v = _mm_loadu_si128(src);+    v = aesecb_encrypt(ctx, v);+    _mm_storeu_si128(dst, v);+}++/**+ * returns the number of ghash entries that is required to handle an AEAD block of given size+ */+static size_t aesgcm_calc_ghash_cnt(size_t capacity)+{+    // round-up by block size, add to handle worst split of the size between AAD and payload, plus context to hash AC+    return (capacity + 15) / 16 + 2;+}++static void setup_one_ghash_entry(ptls_fusion_aesgcm_context_t *ctx)+{+    if (ctx->ghash_cnt != 0)+        ctx->ghash[ctx->ghash_cnt].H = gfmul(ctx->ghash[ctx->ghash_cnt - 1].H, ctx->ghash[0].H);++    __m128i r = _mm_shuffle_epi32(ctx->ghash[ctx->ghash_cnt].H, 78);+    r = _mm_xor_si128(r, ctx->ghash[ctx->ghash_cnt].H);+    ctx->ghash[ctx->ghash_cnt].r = r;++    ++ctx->ghash_cnt;+}++ptls_fusion_aesgcm_context_t *ptls_fusion_aesgcm_new(const void *key, size_t key_size, size_t capacity)+{+    ptls_fusion_aesgcm_context_t *ctx;+    size_t ghash_cnt = aesgcm_calc_ghash_cnt(capacity);++    if ((ctx = malloc(sizeof(*ctx) + sizeof(ctx->ghash[0]) * ghash_cnt)) == NULL)+        return NULL;++    ptls_fusion_aesecb_init(&ctx->ecb, 1, key, key_size);++    ctx->capacity = capacity;++    ctx->ghash[0].H = aesecb_encrypt(&ctx->ecb, _mm_setzero_si128());+    ctx->ghash[0].H = _mm_shuffle_epi8(ctx->ghash[0].H, bswap8);+    ctx->ghash[0].H = transformH(ctx->ghash[0].H);+    ctx->ghash_cnt = 0;+    while (ctx->ghash_cnt < ghash_cnt)+        setup_one_ghash_entry(ctx);++    return ctx;+}++ptls_fusion_aesgcm_context_t *ptls_fusion_aesgcm_set_capacity(ptls_fusion_aesgcm_context_t *ctx, size_t capacity)+{+    size_t ghash_cnt = aesgcm_calc_ghash_cnt(capacity);++    if (ghash_cnt <= ctx->ghash_cnt)+        return ctx;++    if ((ctx = realloc(ctx, sizeof(*ctx) + sizeof(ctx->ghash[0]) * ghash_cnt)) == NULL)+        return NULL;++    ctx->capacity = capacity;+    while (ghash_cnt < ctx->ghash_cnt)+        setup_one_ghash_entry(ctx);++    return ctx;+}++void ptls_fusion_aesgcm_free(ptls_fusion_aesgcm_context_t *ctx)+{+    ptls_clear_memory(ctx->ghash, sizeof(ctx->ghash[0]) * ctx->ghash_cnt);+    ctx->ghash_cnt = 0;+    ptls_fusion_aesecb_dispose(&ctx->ecb);+    free(ctx);+}++static void ctr_dispose(ptls_cipher_context_t *_ctx)+{+    struct ctr_context *ctx = (struct ctr_context *)_ctx;+    ptls_fusion_aesecb_dispose(&ctx->fusion);+    _mm_storeu_si128(&ctx->bits, _mm_setzero_si128());+}++static void ctr_init(ptls_cipher_context_t *_ctx, const void *iv)+{+    struct ctr_context *ctx = (struct ctr_context *)_ctx;+    _mm_storeu_si128(&ctx->bits, aesecb_encrypt(&ctx->fusion, _mm_loadu_si128(iv)));+    ctx->is_ready = 1;+}++static void ctr_transform(ptls_cipher_context_t *_ctx, void *output, const void *input, size_t len)+{+    struct ctr_context *ctx = (struct ctr_context *)_ctx;++    assert((ctx->is_ready && len <= 16) ||+           !"CTR transfomation is supported only once per call to `init` and the maximum size is limited  to 16 bytes");+    ctx->is_ready = 0;++    if (len < 16) {+        storen(output, len, _mm_xor_si128(_mm_loadu_si128(&ctx->bits), loadn(input, len)));+    } else {+        _mm_storeu_si128(output, _mm_xor_si128(_mm_loadu_si128(&ctx->bits), _mm_loadu_si128(input)));+    }+}++static int aesctr_setup(ptls_cipher_context_t *_ctx, int is_enc, const void *key, size_t key_size)+{+    struct ctr_context *ctx = (struct ctr_context *)_ctx;++    ctx->super.do_dispose = ctr_dispose;+    ctx->super.do_init = ctr_init;+    ctx->super.do_transform = ctr_transform;+    ptls_fusion_aesecb_init(&ctx->fusion, 1, key, key_size);+    ctx->is_ready = 0;++    return 0;+}++static int aes128ctr_setup(ptls_cipher_context_t *ctx, int is_enc, const void *key)+{+    return aesctr_setup(ctx, is_enc, key, PTLS_AES128_KEY_SIZE);+}++static int aes256ctr_setup(ptls_cipher_context_t *ctx, int is_enc, const void *key)+{+    return aesctr_setup(ctx, is_enc, key, PTLS_AES256_KEY_SIZE);+}++static void aesgcm_dispose_crypto(ptls_aead_context_t *_ctx)+{+    struct aesgcm_context *ctx = (struct aesgcm_context *)_ctx;++    ptls_fusion_aesgcm_free(ctx->aesgcm);+}++static void aead_do_encrypt_init(ptls_aead_context_t *_ctx, uint64_t seq, const void *aad, size_t aadlen)+{+    assert(!"FIXME");+}++static size_t aead_do_encrypt_update(ptls_aead_context_t *_ctx, void *output, const void *input, size_t inlen)+{+    assert(!"FIXME");+    return SIZE_MAX;+}++static size_t aead_do_encrypt_final(ptls_aead_context_t *_ctx, void *_output)+{+    assert(!"FIXME");+    return SIZE_MAX;+}++static inline __m128i calc_counter(struct aesgcm_context *ctx, uint64_t seq)+{+    __m128i ctr = _mm_setzero_si128();+    ctr = _mm_insert_epi64(ctr, seq, 0);+    ctr = _mm_slli_si128(ctr, 4);+    ctr = _mm_xor_si128(ctx->static_iv, ctr);+    return ctr;+}++void aead_do_encrypt(struct st_ptls_aead_context_t *_ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                     const void *aad, size_t aadlen, ptls_aead_supplementary_encryption_t *supp)+{+    struct aesgcm_context *ctx = (void *)_ctx;++    if (inlen + aadlen > ctx->aesgcm->capacity)+        ctx->aesgcm = ptls_fusion_aesgcm_set_capacity(ctx->aesgcm, inlen + aadlen);+    ptls_fusion_aesgcm_encrypt(ctx->aesgcm, output, input, inlen, calc_counter(ctx, seq), aad, aadlen, supp);+}++size_t aead_do_decrypt(ptls_aead_context_t *_ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                              const void *aad, size_t aadlen)+{+    struct aesgcm_context *ctx = (void *)_ctx;++    if (inlen < 16)+        return SIZE_MAX;++    size_t enclen = inlen - 16;+    if (enclen + aadlen > ctx->aesgcm->capacity)+        ctx->aesgcm = ptls_fusion_aesgcm_set_capacity(ctx->aesgcm, enclen + aadlen);+    if (!ptls_fusion_aesgcm_decrypt(ctx->aesgcm, output, input, enclen, calc_counter(ctx, seq), aad, aadlen,+                                    (const uint8_t *)input + enclen))+        return SIZE_MAX;+    return enclen;+}++static inline void aesgcm_xor_iv(ptls_aead_context_t *_ctx, const void *_bytes, size_t len)+{+    struct aesgcm_context *ctx = (struct aesgcm_context *)_ctx;+    __m128i xor_mask = loadn(_bytes, len);+    xor_mask = _mm_shuffle_epi8(xor_mask, bswap8);+    ctx->static_iv = _mm_xor_si128(ctx->static_iv, xor_mask);+}++static int aesgcm_setup(ptls_aead_context_t *_ctx, int is_enc, const void *key, const void *iv, size_t key_size)+{+    struct aesgcm_context *ctx = (struct aesgcm_context *)_ctx;++    ctx->static_iv = loadn(iv, PTLS_AESGCM_IV_SIZE);+    ctx->static_iv = _mm_shuffle_epi8(ctx->static_iv, bswap8);+    if (key == NULL)+        return 0;++    ctx->super.dispose_crypto = aesgcm_dispose_crypto;+    ctx->super.do_xor_iv = aesgcm_xor_iv;+    ctx->super.do_encrypt_init = aead_do_encrypt_init;+    ctx->super.do_encrypt_update = aead_do_encrypt_update;+    ctx->super.do_encrypt_final = aead_do_encrypt_final;+    ctx->super.do_encrypt = aead_do_encrypt;+    ctx->super.do_decrypt = aead_do_decrypt;++    ctx->aesgcm = ptls_fusion_aesgcm_new(key, key_size, 1500 /* assume ordinary packet size */);++    return 0;+}++int aes128gcm_setup(ptls_aead_context_t *ctx, int is_enc, const void *key, const void *iv)+{+    return aesgcm_setup(ctx, is_enc, key, iv, PTLS_AES128_KEY_SIZE);+}++int aes256gcm_setup(ptls_aead_context_t *ctx, int is_enc, const void *key, const void *iv)+{+    return aesgcm_setup(ctx, is_enc, key, iv, PTLS_AES256_KEY_SIZE);+}++ptls_cipher_algorithm_t ptls_fusion_aes128ctr = {"AES128-CTR",+                                                 PTLS_AES128_KEY_SIZE,+                                                 1, // block size+                                                 PTLS_AES_IV_SIZE,+                                                 sizeof(struct ctr_context),+                                                 aes128ctr_setup};+ptls_cipher_algorithm_t ptls_fusion_aes256ctr = {"AES256-CTR",+                                                 PTLS_AES256_KEY_SIZE,+                                                 1, // block size+                                                 PTLS_AES_IV_SIZE,+                                                 sizeof(struct ctr_context),+                                                 aes256ctr_setup};+ptls_aead_algorithm_t ptls_fusion_aes128gcm = {"AES128-GCM",+                                               PTLS_AESGCM_CONFIDENTIALITY_LIMIT,+                                               PTLS_AESGCM_INTEGRITY_LIMIT,+                                               &ptls_fusion_aes128ctr,+                                               NULL, // &ptls_fusion_aes128ecb,+                                               PTLS_AES128_KEY_SIZE,+                                               PTLS_AESGCM_IV_SIZE,+                                               PTLS_AESGCM_TAG_SIZE,+                                               sizeof(struct aesgcm_context),+                                               aes128gcm_setup};+ptls_aead_algorithm_t ptls_fusion_aes256gcm = {"AES256-GCM",+                                               PTLS_AESGCM_CONFIDENTIALITY_LIMIT,+                                               PTLS_AESGCM_INTEGRITY_LIMIT,+                                               &ptls_fusion_aes256ctr,+                                               NULL, // &ptls_fusion_aes256ecb,+                                               PTLS_AES256_KEY_SIZE,+                                               PTLS_AESGCM_IV_SIZE,+                                               PTLS_AESGCM_TAG_SIZE,+                                               sizeof(struct aesgcm_context),+                                               aes256gcm_setup};++#ifdef _WINDOWS+/**+ * ptls_fusion_is_supported_by_cpu:+ * Check that the CPU has extended instructions for PCMUL, AES and AVX2.+ * This test assumes that the CPU is following the x86/x64 architecture.+ * A slightly more refined test could check that the cpu_info spells out+ * "genuineIntel" or "authenticAMD", but would fail in presence of+ * little known CPU brands or some VM */+int ptls_fusion_is_supported_by_cpu(void)+{+    uint32_t cpu_info[4];+    uint32_t nb_ids;+    int is_supported = 0;++    __cpuid(cpu_info, 0);+    nb_ids = cpu_info[0];++    if (nb_ids >= 7) {+        uint32_t leaf1_ecx;+        __cpuid(cpu_info, 1);+        leaf1_ecx = cpu_info[2];++        if (/* PCLMUL */ (leaf1_ecx & (1 << 5)) != 0 && /* AES */ (leaf1_ecx & (1 << 25)) != 0) {+            uint32_t leaf7_ebx;+            __cpuid(cpu_info, 7);+            leaf7_ebx = cpu_info[1];++            is_supported = /* AVX2 */ (leaf7_ebx & (1 << 5)) != 0;+        }+    }++    return is_supported;+}+#else+int ptls_fusion_is_supported_by_cpu(void)+{+    unsigned leaf1_ecx, leaf7_ebx;++    { /* GCC-specific code to obtain CPU features */+        unsigned leaf_cnt;+        __asm__("cpuid" : "=a"(leaf_cnt) : "a"(0) : "ebx", "ecx", "edx");+        if (leaf_cnt < 7)+            return 0;+        __asm__("cpuid" : "=c"(leaf1_ecx) : "a"(1) : "ebx", "edx");+        __asm__("cpuid" : "=b"(leaf7_ebx) : "a"(7), "c"(0) : "edx");+    }++    /* AVX2 */+    if ((leaf7_ebx & (1 << 5)) == 0)+        return 0;+    /* AES */+    if ((leaf1_ecx & (1 << 25)) == 0)+        return 0;+    /* PCLMUL */+    if ((leaf1_ecx & (1 << 1)) == 0)+        return 0;++    return 1;+}+#endif++/* ---------------------------------------------------------------- */++// struct aesgcm_context {+//    ptls_aead_context_t super;+//    ptls_fusion_aesgcm_context_t *aesgcm; <- ptls_fusion_aesgcm_free++ptls_aead_context_t *aead_context_new() {+   ptls_aead_context_t *p = malloc(sizeof(struct aesgcm_context));+   return p;+}++void aead_context_free(ptls_aead_context_t *p) {+  aesgcm_dispose_crypto(p);+  free(p);+}++/* ---------------------------------------------------------------- */++ptls_aead_supplementary_encryption_t *supplement_new(uint8_t *key, uint siz) {+  ptls_aead_supplementary_encryption_t *supp = malloc(sizeof(ptls_aead_supplementary_encryption_t));+  if (siz == PTLS_AES256_KEY_SIZE) {+    supp->ctx = ptls_cipher_new(&ptls_fusion_aes256ctr, 1, key);+  } else {+    supp->ctx = ptls_cipher_new(&ptls_fusion_aes128ctr, 1, key);+  }+  return supp;+}++void supplement_free(ptls_aead_supplementary_encryption_t *supp) {+  ptls_cipher_free(supp->ctx);+  free(supp);+}++void supplement_set_sample(ptls_aead_supplementary_encryption_t *supp, uint8_t *sample) {+  supp->input = sample;+}++uint8_t *supplement_get_mask(ptls_aead_supplementary_encryption_t *supp) {+  return (supp->output);+}
+ cbits/picotls.c view
@@ -0,0 +1,5582 @@+/*+ * Copyright (c) 2016 DeNA Co., Ltd., Kazuho Oku+ *+ * Permission is hereby granted, free of charge, to any person obtaining a copy+ * of this software and associated documentation files (the "Software"), to+ * deal in the Software without restriction, including without limitation the+ * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+ * sell copies of the Software, and to permit persons to whom the Software is+ * furnished to do so, subject to the following conditions:+ *+ * The above copyright notice and this permission notice shall be included in+ * all copies or substantial portions of the Software.+ *+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+ * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+ * IN THE SOFTWARE.+ */+#include <assert.h>+#include <stddef.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#ifdef _WINDOWS+#include "wincompat.h"+#else+#include <arpa/inet.h>+#include <sys/time.h>+#endif+#include "picotls.h"+#if PICOTLS_USE_DTRACE+#include "picotls-probes.h"+#endif++#define PTLS_MAX_PLAINTEXT_RECORD_SIZE 16384+#define PTLS_MAX_ENCRYPTED_RECORD_SIZE (16384 + 256)++#define PTLS_RECORD_VERSION_MAJOR 3+#define PTLS_RECORD_VERSION_MINOR 3++#define PTLS_CONTENT_TYPE_CHANGE_CIPHER_SPEC 20+#define PTLS_CONTENT_TYPE_ALERT 21+#define PTLS_CONTENT_TYPE_HANDSHAKE 22+#define PTLS_CONTENT_TYPE_APPDATA 23++#define PTLS_PSK_KE_MODE_PSK 0+#define PTLS_PSK_KE_MODE_PSK_DHE 1++#define PTLS_HANDSHAKE_HEADER_SIZE 4++#define PTLS_EXTENSION_TYPE_SERVER_NAME 0+#define PTLS_EXTENSION_TYPE_STATUS_REQUEST 5+#define PTLS_EXTENSION_TYPE_SUPPORTED_GROUPS 10+#define PTLS_EXTENSION_TYPE_SIGNATURE_ALGORITHMS 13+#define PTLS_EXTENSION_TYPE_ALPN 16+#define PTLS_EXTENSION_TYPE_SERVER_CERTIFICATE_TYPE 20+#define PTLS_EXTENSION_TYPE_COMPRESS_CERTIFICATE 27+#define PTLS_EXTENSION_TYPE_PRE_SHARED_KEY 41+#define PTLS_EXTENSION_TYPE_EARLY_DATA 42+#define PTLS_EXTENSION_TYPE_SUPPORTED_VERSIONS 43+#define PTLS_EXTENSION_TYPE_COOKIE 44+#define PTLS_EXTENSION_TYPE_PSK_KEY_EXCHANGE_MODES 45+#define PTLS_EXTENSION_TYPE_KEY_SHARE 51+#define PTLS_EXTENSION_TYPE_ENCRYPTED_SERVER_NAME 0xffce++#define PTLS_PROTOCOL_VERSION_TLS13_FINAL 0x0304+#define PTLS_PROTOCOL_VERSION_TLS13_DRAFT26 0x7f1a+#define PTLS_PROTOCOL_VERSION_TLS13_DRAFT27 0x7f1b+#define PTLS_PROTOCOL_VERSION_TLS13_DRAFT28 0x7f1c++#define PTLS_SERVER_NAME_TYPE_HOSTNAME 0++#define PTLS_SERVER_CERTIFICATE_VERIFY_CONTEXT_STRING "TLS 1.3, server CertificateVerify"+#define PTLS_CLIENT_CERTIFICATE_VERIFY_CONTEXT_STRING "TLS 1.3, client CertificateVerify"+#define PTLS_MAX_CERTIFICATE_VERIFY_SIGNDATA_SIZE                                                                                  \+    (64 + sizeof(PTLS_SERVER_CERTIFICATE_VERIFY_CONTEXT_STRING) + PTLS_MAX_DIGEST_SIZE * 2)++#define PTLS_EARLY_DATA_MAX_DELAY 10000 /* max. RTT (in msec) to permit early data */++#ifndef PTLS_MAX_EARLY_DATA_SKIP_SIZE+#define PTLS_MAX_EARLY_DATA_SKIP_SIZE 65536+#endif+#if defined(PTLS_DEBUG) && PTLS_DEBUG+#define PTLS_DEBUGF(...) fprintf(stderr, __VA_ARGS__)+#else+#define PTLS_DEBUGF(...)+#endif++#ifndef PTLS_MEMORY_DEBUG+#define PTLS_MEMORY_DEBUG 0+#endif++#if PICOTLS_USE_DTRACE+#define PTLS_SHOULD_PROBE(LABEL, tls) (PTLS_UNLIKELY(PICOTLS_##LABEL##_ENABLED()) && !(tls)->skip_tracing)+#define PTLS_PROBE0(LABEL, tls)                                                                                                    \+    do {                                                                                                                           \+        ptls_t *_tls = (tls);                                                                                                      \+        if (PTLS_SHOULD_PROBE(LABEL, _tls))                                                                                        \+            PICOTLS_##LABEL(_tls);                                                                                                 \+    } while (0)+#define PTLS_PROBE(LABEL, tls, ...)                                                                                                \+    do {                                                                                                                           \+        ptls_t *_tls = (tls);                                                                                                      \+        if (PTLS_SHOULD_PROBE(LABEL, _tls))                                                                                        \+            PICOTLS_##LABEL(_tls, __VA_ARGS__);                                                                                    \+    } while (0)+#else+#define PTLS_PROBE0(LABEL, tls)+#define PTLS_PROBE(LABEL, tls, ...)+#endif++/**+ * list of supported versions in the preferred order+ */+static const uint16_t supported_versions[] = {PTLS_PROTOCOL_VERSION_TLS13_FINAL, PTLS_PROTOCOL_VERSION_TLS13_DRAFT28,+                                              PTLS_PROTOCOL_VERSION_TLS13_DRAFT27, PTLS_PROTOCOL_VERSION_TLS13_DRAFT26};++static const uint8_t hello_retry_random[PTLS_HELLO_RANDOM_SIZE] = {0xCF, 0x21, 0xAD, 0x74, 0xE5, 0x9A, 0x61, 0x11, 0xBE, 0x1D, 0x8C,+                                                                   0x02, 0x1E, 0x65, 0xB8, 0x91, 0xC2, 0xA2, 0x11, 0x16, 0x7A, 0xBB,+                                                                   0x8C, 0x5E, 0x07, 0x9E, 0x09, 0xE2, 0xC8, 0xA8, 0x33, 0x9C};++struct st_ptls_traffic_protection_t {+    uint8_t secret[PTLS_MAX_DIGEST_SIZE];+    size_t epoch;+    /* the following fields are not used if the key_change callback is set */+    ptls_aead_context_t *aead;+    uint64_t seq;+};++struct st_ptls_record_message_emitter_t {+    ptls_message_emitter_t super;+    size_t rec_start;+};++struct st_ptls_signature_algorithms_t {+    uint16_t list[16]; /* expand? */+    size_t count;+};++struct st_ptls_certificate_request_t {+    /**+     * context.base becomes non-NULL when a CertificateRequest is pending for processing+     */+    ptls_iovec_t context;+    struct st_ptls_signature_algorithms_t signature_algorithms;+};++struct st_ptls_t {+    /**+     * the context+     */+    ptls_context_t *ctx;+    /**+     * the state+     */+    enum en_ptls_state_t {+        PTLS_STATE_CLIENT_HANDSHAKE_START,+        PTLS_STATE_CLIENT_EXPECT_SERVER_HELLO,+        PTLS_STATE_CLIENT_EXPECT_SECOND_SERVER_HELLO,+        PTLS_STATE_CLIENT_EXPECT_ENCRYPTED_EXTENSIONS,+        PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_REQUEST_OR_CERTIFICATE,+        PTLS_STATE_CLIENT_EXPECT_CERTIFICATE,+        PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_VERIFY,+        PTLS_STATE_CLIENT_EXPECT_FINISHED,+        PTLS_STATE_SERVER_EXPECT_CLIENT_HELLO,+        PTLS_STATE_SERVER_EXPECT_SECOND_CLIENT_HELLO,+        PTLS_STATE_SERVER_EXPECT_CERTIFICATE,+        PTLS_STATE_SERVER_EXPECT_CERTIFICATE_VERIFY,+        /* ptls_send can be called if the state is below here */+        PTLS_STATE_SERVER_EXPECT_END_OF_EARLY_DATA,+        PTLS_STATE_SERVER_EXPECT_FINISHED,+        PTLS_STATE_POST_HANDSHAKE_MIN,+        PTLS_STATE_CLIENT_POST_HANDSHAKE = PTLS_STATE_POST_HANDSHAKE_MIN,+        PTLS_STATE_SERVER_POST_HANDSHAKE+    } state;+    /**+     * receive buffers+     */+    struct {+        ptls_buffer_t rec;+        ptls_buffer_t mess;+    } recvbuf;+    /**+     * key schedule+     */+    ptls_key_schedule_t *key_schedule;+    /**+     * values used for record protection+     */+    struct {+        struct st_ptls_traffic_protection_t dec;+        struct st_ptls_traffic_protection_t enc;+    } traffic_protection;+    /**+     * server-name passed using SNI+     */+    char *server_name;+    /**+     * result of ALPN+     */+    char *negotiated_protocol;+    /**+     * selected key-exchange+     */+    ptls_key_exchange_algorithm_t *key_share;+    /**+     * selected cipher-suite+     */+    ptls_cipher_suite_t *cipher_suite;+    /**+     * clienthello.random+     */+    uint8_t client_random[PTLS_HELLO_RANDOM_SIZE];+    /**+     * esni+     */+    ptls_esni_secret_t *esni;+    /**+     * exporter master secret (either 0rtt or 1rtt)+     */+    struct {+        uint8_t *early;+        uint8_t *one_rtt;+    } exporter_master_secret;+    /* flags */+    unsigned is_server : 1;+    unsigned is_psk_handshake : 1;+    unsigned send_change_cipher_spec : 1;+    unsigned needs_key_update : 1;+    unsigned key_update_send_request : 1;+    unsigned skip_tracing : 1;+    /**+     * misc.+     */+    union {+        struct {+            ptls_iovec_t legacy_session_id;+            uint8_t legacy_session_id_buf[32];+            ptls_key_exchange_context_t *key_share_ctx;+            unsigned offered_psk : 1;+            /**+             * if 1-RTT write key is active+             */+            unsigned using_early_data : 1;+            struct st_ptls_certificate_request_t certificate_request;+        } client;+        struct {+            uint8_t pending_traffic_secret[PTLS_MAX_DIGEST_SIZE];+            uint32_t early_data_skipped_bytes; /* if not UINT32_MAX, the server is skipping early data */+        } server;+    };+    /**+     * certificate verify+     * will be used by the client and the server (if require_client_authentication is set).+     */+    struct {+        int (*cb)(void *verify_ctx, uint16_t algo, ptls_iovec_t data, ptls_iovec_t signature);+        void *verify_ctx;+    } certificate_verify;+    /**+     * handshake traffic secret to be commisioned (an array of `uint8_t [PTLS_MAX_DIGEST_SIZE]` or NULL)+     */+    uint8_t *pending_handshake_secret;+    /**+     * user data+     */+    void *data_ptr;+};++struct st_ptls_record_t {+    uint8_t type;+    uint16_t version;+    size_t length;+    const uint8_t *fragment;+};++struct st_ptls_client_hello_psk_t {+    ptls_iovec_t identity;+    uint32_t obfuscated_ticket_age;+    ptls_iovec_t binder;+};++#define MAX_UNKNOWN_EXTENSIONS 16+#define MAX_CLIENT_CIPHERS 32+#define MAX_CERTIFICATE_TYPES 8++struct st_ptls_client_hello_t {+    uint16_t legacy_version;+    const uint8_t *random_bytes;+    ptls_iovec_t legacy_session_id;+    struct {+        const uint8_t *ids;+        size_t count;+    } compression_methods;+    uint16_t selected_version;+    ptls_iovec_t cipher_suites;+    ptls_iovec_t negotiated_groups;+    ptls_iovec_t key_shares;+    struct st_ptls_signature_algorithms_t signature_algorithms;+    ptls_iovec_t server_name;+    struct {+        ptls_cipher_suite_t *cipher; /* selected cipher-suite, or NULL if esni extension is not used */+        ptls_key_exchange_algorithm_t *key_share;+        ptls_iovec_t peer_key;+        const uint8_t *record_digest;+        ptls_iovec_t encrypted_sni;+    } esni;+    struct {+        ptls_iovec_t list[16];+        size_t count;+    } alpn;+    struct {+        uint16_t list[16];+        size_t count;+    } cert_compression_algos;+    struct {+        uint16_t list[MAX_CLIENT_CIPHERS];+        size_t count;+    } client_ciphers;+    struct {+        ptls_iovec_t all;+        ptls_iovec_t tbs;+        ptls_iovec_t ch1_hash;+        ptls_iovec_t signature;+        unsigned sent_key_share : 1;+    } cookie;+    struct {+        const uint8_t *hash_end;+        struct {+            struct st_ptls_client_hello_psk_t list[4];+            size_t count;+        } identities;+        unsigned ke_modes;+        unsigned early_data_indication : 1;+        unsigned is_last_extension : 1;+    } psk;+    struct {+        uint8_t list[MAX_CERTIFICATE_TYPES];+        size_t count;+    } server_certificate_types;+    ptls_raw_extension_t unknown_extensions[MAX_UNKNOWN_EXTENSIONS + 1];+    unsigned status_request : 1;+};++struct st_ptls_server_hello_t {+    uint8_t random_[PTLS_HELLO_RANDOM_SIZE];+    ptls_iovec_t legacy_session_id;+    int is_retry_request;+    union {+        ptls_iovec_t peerkey;+        struct {+            uint16_t selected_group;+            ptls_iovec_t cookie;+        } retry_request;+    };+};++struct st_ptls_key_schedule_t {+    unsigned generation; /* early secret (1), hanshake secret (2), master secret (3) */+    const char *hkdf_label_prefix;+    uint8_t secret[PTLS_MAX_DIGEST_SIZE];+    size_t num_hashes;+    struct {+        ptls_hash_algorithm_t *algo;+        ptls_hash_context_t *ctx;+    } hashes[1];+};++struct st_ptls_extension_decoder_t {+    uint16_t type;+    int (*cb)(ptls_t *tls, void *arg, const uint8_t *src, const uint8_t *const end);+};++struct st_ptls_extension_bitmap_t {+    uint8_t bits[8]; /* only ids below 64 is tracked */+};++static const uint8_t zeroes_of_max_digest_size[PTLS_MAX_DIGEST_SIZE] = {0};++static int hkdf_expand_label(ptls_hash_algorithm_t *algo, void *output, size_t outlen, ptls_iovec_t secret, const char *label,+                             ptls_iovec_t hash_value, const char *label_prefix);+static ptls_aead_context_t *new_aead(ptls_aead_algorithm_t *aead, ptls_hash_algorithm_t *hash, int is_enc, const void *secret,+                                     ptls_iovec_t hash_value, const char *label_prefix);++static int is_supported_version(uint16_t v)+{+    size_t i;+    for (i = 0; i != PTLS_ELEMENTSOF(supported_versions); ++i)+        if (supported_versions[i] == v)+            return 1;+    return 0;+}++static inline int extension_bitmap_is_set(struct st_ptls_extension_bitmap_t *bitmap, uint16_t id)+{+    if (id < sizeof(bitmap->bits) * 8)+        return (bitmap->bits[id / 8] & (1 << (id % 8))) != 0;+    return 0;+}++static inline void extension_bitmap_set(struct st_ptls_extension_bitmap_t *bitmap, uint16_t id)+{+    if (id < sizeof(bitmap->bits) * 8)+        bitmap->bits[id / 8] |= 1 << (id % 8);+}++static inline void init_extension_bitmap(struct st_ptls_extension_bitmap_t *bitmap, uint8_t hstype)+{+    *bitmap = (struct st_ptls_extension_bitmap_t){{0}};++#define EXT(extid, proc)                                                                                                           \+    do {                                                                                                                           \+        int _found = 0;                                                                                                            \+        do {                                                                                                                       \+            proc                                                                                                                   \+        } while (0);                                                                                                               \+        if (!_found)                                                                                                               \+            extension_bitmap_set(bitmap, PTLS_EXTENSION_TYPE_##extid);                                                             \+    } while (0)+#define ALLOW(allowed_hstype) _found = _found || hstype == PTLS_HANDSHAKE_TYPE_##allowed_hstype++    /* Implements the table found in section 4.2 of draft-19; "If an implementation receives an extension which it recognizes and+     * which is not specified for the message in which it appears it MUST abort the handshake with an “illegal_parameter” alert."+     */+    EXT(SERVER_NAME, {+        ALLOW(CLIENT_HELLO);+        ALLOW(ENCRYPTED_EXTENSIONS);+    });+    EXT(STATUS_REQUEST, {+        ALLOW(CLIENT_HELLO);+        ALLOW(CERTIFICATE);+        ALLOW(CERTIFICATE_REQUEST);+    });+    EXT(SUPPORTED_GROUPS, {+        ALLOW(CLIENT_HELLO);+        ALLOW(ENCRYPTED_EXTENSIONS);+    });+    EXT(SIGNATURE_ALGORITHMS, {+        ALLOW(CLIENT_HELLO);+        ALLOW(CERTIFICATE_REQUEST);+    });+    EXT(ALPN, {+        ALLOW(CLIENT_HELLO);+        ALLOW(ENCRYPTED_EXTENSIONS);+    });+    EXT(KEY_SHARE, {+        ALLOW(CLIENT_HELLO);+        ALLOW(SERVER_HELLO);+    });+    EXT(PRE_SHARED_KEY, {+        ALLOW(CLIENT_HELLO);+        ALLOW(SERVER_HELLO);+    });+    EXT(PSK_KEY_EXCHANGE_MODES, { ALLOW(CLIENT_HELLO); });+    EXT(EARLY_DATA, {+        ALLOW(CLIENT_HELLO);+        ALLOW(ENCRYPTED_EXTENSIONS);+        ALLOW(NEW_SESSION_TICKET);+    });+    EXT(COOKIE, {+        ALLOW(CLIENT_HELLO);+        ALLOW(SERVER_HELLO);+    });+    EXT(SUPPORTED_VERSIONS, {+        ALLOW(CLIENT_HELLO);+        ALLOW(SERVER_HELLO);+    });+    EXT(SERVER_CERTIFICATE_TYPE, {+        ALLOW(CLIENT_HELLO);+        ALLOW(ENCRYPTED_EXTENSIONS);+    });++#undef ALLOW+#undef EXT+}++#ifndef ntoh16+static uint16_t ntoh16(const uint8_t *src)+{+    return (uint16_t)src[0] << 8 | src[1];+}+#endif++#ifndef ntoh24+static uint32_t ntoh24(const uint8_t *src)+{+    return (uint32_t)src[0] << 16 | (uint32_t)src[1] << 8 | src[2];+}+#endif++#ifndef ntoh32+static uint32_t ntoh32(const uint8_t *src)+{+    return (uint32_t)src[0] << 24 | (uint32_t)src[1] << 16 | (uint32_t)src[2] << 8 | src[3];+}+#endif++#ifndef ntoh64+static uint64_t ntoh64(const uint8_t *src)+{+    return (uint64_t)src[0] << 56 | (uint64_t)src[1] << 48 | (uint64_t)src[2] << 40 | (uint64_t)src[3] << 32 |+           (uint64_t)src[4] << 24 | (uint64_t)src[5] << 16 | (uint64_t)src[6] << 8 | src[7];+}+#endif++void ptls_buffer__release_memory(ptls_buffer_t *buf)+{+    ptls_clear_memory(buf->base, buf->off);+    if (buf->is_allocated)+        free(buf->base);+}++int ptls_buffer_reserve(ptls_buffer_t *buf, size_t delta)+{+    if (buf->base == NULL)+        return PTLS_ERROR_NO_MEMORY;++    if (PTLS_MEMORY_DEBUG || buf->capacity < buf->off + delta) {+        uint8_t *newp;+        size_t new_capacity = buf->capacity;+        if (new_capacity < 1024)+            new_capacity = 1024;+        while (new_capacity < buf->off + delta) {+            new_capacity *= 2;+        }+        if ((newp = malloc(new_capacity)) == NULL)+            return PTLS_ERROR_NO_MEMORY;+        memcpy(newp, buf->base, buf->off);+        ptls_buffer__release_memory(buf);+        buf->base = newp;+        buf->capacity = new_capacity;+        buf->is_allocated = 1;+    }++    return 0;+}++int ptls_buffer__do_pushv(ptls_buffer_t *buf, const void *src, size_t len)+{+    int ret;++    if (len == 0)+        return 0;+    if ((ret = ptls_buffer_reserve(buf, len)) != 0)+        return ret;+    memcpy(buf->base + buf->off, src, len);+    buf->off += len;+    return 0;+}++int ptls_buffer__adjust_quic_blocksize(ptls_buffer_t *buf, size_t body_size)+{+    uint8_t sizebuf[PTLS_ENCODE_QUICINT_CAPACITY];+    size_t sizelen = ptls_encode_quicint(sizebuf, body_size) - sizebuf;++    /* adjust amount of space before body_size to `sizelen` bytes */+    if (sizelen != 1) {+        int ret;+        if ((ret = ptls_buffer_reserve(buf, sizelen - 1)) != 0)+            return ret;+        memmove(buf->base + buf->off - body_size - 1 + sizelen, buf->base + buf->off - body_size, body_size);+        buf->off += sizelen - 1;+    }++    /* write the size */+    memcpy(buf->base + buf->off - body_size - sizelen, sizebuf, sizelen);++    return 0;+}++int ptls_buffer__adjust_asn1_blocksize(ptls_buffer_t *buf, size_t body_size)+{+    fprintf(stderr, "unimplemented\n");+    abort();+}++int ptls_buffer_push_asn1_ubigint(ptls_buffer_t *buf, const void *bignum, size_t size)+{+    const uint8_t *p = bignum, *const end = p + size;+    int ret;++    /* skip zeroes */+    for (; end - p >= 1; ++p)+        if (*p != 0)+            break;++    /* emit */+    ptls_buffer_push(buf, 2);+    ptls_buffer_push_asn1_block(buf, {+        if (*p >= 0x80)+            ptls_buffer_push(buf, 0);+        if (p != end) {+            ptls_buffer_pushv(buf, p, end - p);+        } else {+            ptls_buffer_pushv(buf, "", 1);+        }+    });+    ret = 0;++Exit:+    return ret;+}++#if PTLS_FUZZ_HANDSHAKE++static size_t aead_encrypt(struct st_ptls_traffic_protection_t *ctx, void *output, const void *input, size_t inlen,+                           uint8_t content_type)+{+    memcpy(output, input, inlen);+    memcpy(output + inlen, &content_type, 1);+    return inlen + 1 + 16;+}++static int aead_decrypt(struct st_ptls_traffic_protection_t *ctx, void *output, size_t *outlen, const void *input, size_t inlen)+{+    if (inlen < 16) {+        return PTLS_ALERT_BAD_RECORD_MAC;+    }+    memcpy(output, input, inlen - 16);+    *outlen = inlen - 16; /* removing the 16 bytes of tag */+    return 0;+}++#else++static void build_aad(uint8_t aad[5], size_t reclen)+{+    aad[0] = PTLS_CONTENT_TYPE_APPDATA;+    aad[1] = PTLS_RECORD_VERSION_MAJOR;+    aad[2] = PTLS_RECORD_VERSION_MINOR;+    aad[3] = (uint8_t)(reclen >> 8);+    aad[4] = (uint8_t)reclen;+}++static size_t aead_encrypt(struct st_ptls_traffic_protection_t *ctx, void *output, const void *input, size_t inlen,+                           uint8_t content_type)+{+    uint8_t aad[5];+    size_t off = 0;++    build_aad(aad, inlen + 1 + ctx->aead->algo->tag_size);+    ptls_aead_encrypt_init(ctx->aead, ctx->seq++, aad, sizeof(aad));+    off += ptls_aead_encrypt_update(ctx->aead, ((uint8_t *)output) + off, input, inlen);+    off += ptls_aead_encrypt_update(ctx->aead, ((uint8_t *)output) + off, &content_type, 1);+    off += ptls_aead_encrypt_final(ctx->aead, ((uint8_t *)output) + off);++    return off;+}++static int aead_decrypt(struct st_ptls_traffic_protection_t *ctx, void *output, size_t *outlen, const void *input, size_t inlen)+{+    uint8_t aad[5];++    build_aad(aad, inlen);+    if ((*outlen = ptls_aead_decrypt(ctx->aead, output, input, inlen, ctx->seq, aad, sizeof(aad))) == SIZE_MAX)+        return PTLS_ALERT_BAD_RECORD_MAC;+    ++ctx->seq;+    return 0;+}++#endif /* #if PTLS_FUZZ_HANDSHAKE */++#define buffer_push_record(buf, type, block)                                                                                       \+    do {                                                                                                                           \+        ptls_buffer_push((buf), (type), PTLS_RECORD_VERSION_MAJOR, PTLS_RECORD_VERSION_MINOR);                                     \+        ptls_buffer_push_block((buf), 2, block);                                                                                   \+    } while (0)++static int buffer_push_encrypted_records(ptls_buffer_t *buf, uint8_t type, const uint8_t *src, size_t len,+                                         struct st_ptls_traffic_protection_t *enc)+{+    int ret = 0;++    while (len != 0) {+        size_t chunk_size = len;+        if (chunk_size > PTLS_MAX_PLAINTEXT_RECORD_SIZE)+            chunk_size = PTLS_MAX_PLAINTEXT_RECORD_SIZE;+        buffer_push_record(buf, PTLS_CONTENT_TYPE_APPDATA, {+            if ((ret = ptls_buffer_reserve(buf, chunk_size + enc->aead->algo->tag_size + 1)) != 0)+                goto Exit;+            buf->off += aead_encrypt(enc, buf->base + buf->off, src, chunk_size, type);+        });+        src += chunk_size;+        len -= chunk_size;+    }++Exit:+    return ret;+}++static int buffer_encrypt_record(ptls_buffer_t *buf, size_t rec_start, struct st_ptls_traffic_protection_t *enc)+{+    size_t bodylen = buf->off - rec_start - 5;+    uint8_t *tmpbuf, type = buf->base[rec_start];+    int ret;++    /* fast path: do in-place encryption if only one record needs to be emitted */+    if (bodylen <= PTLS_MAX_PLAINTEXT_RECORD_SIZE) {+        size_t overhead = 1 + enc->aead->algo->tag_size;+        if ((ret = ptls_buffer_reserve(buf, overhead)) != 0)+            return ret;+        size_t encrypted_len = aead_encrypt(enc, buf->base + rec_start + 5, buf->base + rec_start + 5, bodylen, type);+        assert(encrypted_len == bodylen + overhead);+        buf->off += overhead;+        buf->base[rec_start] = PTLS_CONTENT_TYPE_APPDATA;+        buf->base[rec_start + 3] = (encrypted_len >> 8) & 0xff;+        buf->base[rec_start + 4] = encrypted_len & 0xff;+        return 0;+    }++    /* move plaintext to temporary buffer */+    if ((tmpbuf = malloc(bodylen)) == NULL) {+        ret = PTLS_ERROR_NO_MEMORY;+        goto Exit;+    }+    memcpy(tmpbuf, buf->base + rec_start + 5, bodylen);+    ptls_clear_memory(buf->base + rec_start, bodylen + 5);+    buf->off = rec_start;++    /* push encrypted records */+    ret = buffer_push_encrypted_records(buf, type, tmpbuf, bodylen, enc);++Exit:+    if (tmpbuf != NULL) {+        ptls_clear_memory(tmpbuf, bodylen);+        free(tmpbuf);+    }+    return ret;+}++static int begin_record_message(ptls_message_emitter_t *_self)+{+    struct st_ptls_record_message_emitter_t *self = (void *)_self;+    int ret;++    self->rec_start = self->super.buf->off;+    ptls_buffer_push(self->super.buf, PTLS_CONTENT_TYPE_HANDSHAKE, PTLS_RECORD_VERSION_MAJOR, PTLS_RECORD_VERSION_MINOR, 0, 0);+    ret = 0;+Exit:+    return ret;+}++static int commit_record_message(ptls_message_emitter_t *_self)+{+    struct st_ptls_record_message_emitter_t *self = (void *)_self;+    int ret;++    if (self->super.enc->aead != NULL) {+        ret = buffer_encrypt_record(self->super.buf, self->rec_start, self->super.enc);+    } else {+        /* TODO allow CH,SH,HRR above 16KB */+        size_t sz = self->super.buf->off - self->rec_start - 5;+        assert(sz <= PTLS_MAX_PLAINTEXT_RECORD_SIZE);+        self->super.buf->base[self->rec_start + 3] = (uint8_t)(sz >> 8);+        self->super.buf->base[self->rec_start + 4] = (uint8_t)(sz);+        ret = 0;+    }++    return ret;+}++#define buffer_push_extension(buf, type, block)                                                                                    \+    do {                                                                                                                           \+        ptls_buffer_push16((buf), (type));                                                                                         \+        ptls_buffer_push_block((buf), 2, block);                                                                                   \+    } while (0);++#define decode_open_extensions(src, end, hstype, exttype, block)                                                                   \+    do {                                                                                                                           \+        struct st_ptls_extension_bitmap_t bitmap;                                                                                  \+        init_extension_bitmap(&bitmap, (hstype));                                                                                  \+        ptls_decode_open_block((src), end, 2, {                                                                                    \+            while ((src) != end) {                                                                                                 \+                if ((ret = ptls_decode16((exttype), &(src), end)) != 0)                                                            \+                    goto Exit;                                                                                                     \+                if (extension_bitmap_is_set(&bitmap, *(exttype)) != 0) {                                                           \+                    ret = PTLS_ALERT_ILLEGAL_PARAMETER;                                                                            \+                    goto Exit;                                                                                                     \+                }                                                                                                                  \+                extension_bitmap_set(&bitmap, *(exttype));                                                                         \+                ptls_decode_open_block((src), end, 2, block);                                                                      \+            }                                                                                                                      \+        });                                                                                                                        \+    } while (0)++#define decode_extensions(src, end, hstype, exttype, block)                                                                        \+    do {                                                                                                                           \+        decode_open_extensions((src), end, hstype, exttype, block);                                                                \+        ptls_decode_assert_block_close((src), end);                                                                                \+    } while (0)++int ptls_decode16(uint16_t *value, const uint8_t **src, const uint8_t *end)+{+    if (end - *src < 2)+        return PTLS_ALERT_DECODE_ERROR;+    *value = ntoh16(*src);+    *src += 2;+    return 0;+}++int ptls_decode24(uint32_t *value, const uint8_t **src, const uint8_t *end)+{+    if (end - *src < 3)+        return PTLS_ALERT_DECODE_ERROR;+    *value = ((uint32_t)(*src)[0] << 16) | ((uint32_t)(*src)[1] << 8) | (*src)[2];+    *src += 3;+    return 0;+}++int ptls_decode32(uint32_t *value, const uint8_t **src, const uint8_t *end)+{+    if (end - *src < 4)+        return PTLS_ALERT_DECODE_ERROR;+    *value = ntoh32(*src);+    *src += 4;+    return 0;+}++int ptls_decode64(uint64_t *value, const uint8_t **src, const uint8_t *end)+{+    if (end - *src < 8)+        return PTLS_ALERT_DECODE_ERROR;+    *value = ntoh64(*src);+    *src += 8;+    return 0;+}++uint64_t ptls_decode_quicint(const uint8_t **src, const uint8_t *end)+{+    if (PTLS_UNLIKELY(*src == end))+        return UINT64_MAX;++    uint8_t b = *(*src)++;++    if (PTLS_LIKELY(b <= 0x3f))+        return b;++    uint64_t v = b & 0x3f;+    unsigned bytes_left = (1 << (b >> 6)) - 1;+    if (PTLS_UNLIKELY((size_t)(end - *src) < bytes_left))+        return UINT64_MAX;+    do {+        v = (v << 8) | *(*src)++;+    } while (--bytes_left != 0);+    return v;+}++static void log_secret(ptls_t *tls, const char *type, ptls_iovec_t secret)+{+    char hexbuf[PTLS_MAX_DIGEST_SIZE * 2 + 1];++    PTLS_PROBE(NEW_SECRET, tls, type, ptls_hexdump(hexbuf, secret.base, secret.len));++    if (tls->ctx->log_event != NULL)+        tls->ctx->log_event->cb(tls->ctx->log_event, tls, type, "%s", ptls_hexdump(hexbuf, secret.base, secret.len));+}++static void key_schedule_free(ptls_key_schedule_t *sched)+{+    size_t i;+    ptls_clear_memory(sched->secret, sizeof(sched->secret));+    for (i = 0; i != sched->num_hashes; ++i)+        sched->hashes[i].ctx->final(sched->hashes[i].ctx, NULL, PTLS_HASH_FINAL_MODE_FREE);+    free(sched);+}++static ptls_key_schedule_t *key_schedule_new(ptls_cipher_suite_t *preferred, ptls_cipher_suite_t **offered,+                                             const char *hkdf_label_prefix)+{+#define FOREACH_HASH(block)                                                                                                        \+    do {                                                                                                                           \+        ptls_cipher_suite_t *cs;                                                                                                   \+        if ((cs = preferred) != NULL) {                                                                                            \+            block                                                                                                                  \+        }                                                                                                                          \+        if (offered != NULL) {                                                                                                     \+            size_t i, j;                                                                                                           \+            for (i = 0; (cs = offered[i]) != NULL; ++i) {                                                                          \+                if (preferred == NULL || cs->hash != preferred->hash) {                                                            \+                    for (j = 0; j != i; ++j)                                                                                       \+                        if (cs->hash == offered[j]->hash)                                                                          \+                            break;                                                                                                 \+                    if (j == i) {                                                                                                  \+                        block                                                                                                      \+                    }                                                                                                              \+                }                                                                                                                  \+            }                                                                                                                      \+        }                                                                                                                          \+    } while (0)++    ptls_key_schedule_t *sched;++    if (hkdf_label_prefix == NULL)+        hkdf_label_prefix = PTLS_HKDF_EXPAND_LABEL_PREFIX;++    { /* allocate */+        size_t num_hashes = 0;+        FOREACH_HASH({ ++num_hashes; });+        if ((sched = malloc(offsetof(ptls_key_schedule_t, hashes) + sizeof(sched->hashes[0]) * num_hashes)) == NULL)+            return NULL;+        *sched = (ptls_key_schedule_t){0, hkdf_label_prefix};+    }++    /* setup the hash algos and contexts */+    FOREACH_HASH({+        sched->hashes[sched->num_hashes].algo = cs->hash;+        if ((sched->hashes[sched->num_hashes].ctx = cs->hash->create()) == NULL)+            goto Fail;+        ++sched->num_hashes;+    });++    return sched;+Fail:+    key_schedule_free(sched);+    return NULL;++#undef FOREACH_HASH+}++static int key_schedule_extract(ptls_key_schedule_t *sched, ptls_iovec_t ikm)+{+    int ret;++    if (ikm.base == NULL)+        ikm = ptls_iovec_init(zeroes_of_max_digest_size, sched->hashes[0].algo->digest_size);++    if (sched->generation != 0 &&+        (ret = hkdf_expand_label(sched->hashes[0].algo, sched->secret, sched->hashes[0].algo->digest_size,+                                 ptls_iovec_init(sched->secret, sched->hashes[0].algo->digest_size), "derived",+                                 ptls_iovec_init(sched->hashes[0].algo->empty_digest, sched->hashes[0].algo->digest_size),+                                 sched->hkdf_label_prefix)) != 0)+        return ret;++    ++sched->generation;+    ret = ptls_hkdf_extract(sched->hashes[0].algo, sched->secret,+                            ptls_iovec_init(sched->secret, sched->hashes[0].algo->digest_size), ikm);+    PTLS_DEBUGF("%s: %u, %02x%02x\n", __FUNCTION__, sched->generation, (int)sched->secret[0], (int)sched->secret[1]);+    return ret;+}++static int key_schedule_select_one(ptls_key_schedule_t *sched, ptls_cipher_suite_t *cs, int reset)+{+    size_t found_slot = SIZE_MAX, i;+    int ret;++    assert(sched->generation == 1);++    /* find the one, while freeing others */+    for (i = 0; i != sched->num_hashes; ++i) {+        if (sched->hashes[i].algo == cs->hash) {+            assert(found_slot == SIZE_MAX);+            found_slot = i;+        } else {+            sched->hashes[i].ctx->final(sched->hashes[i].ctx, NULL, PTLS_HASH_FINAL_MODE_FREE);+        }+    }+    if (found_slot != 0) {+        sched->hashes[0] = sched->hashes[found_slot];+        reset = 1;+    }+    sched->num_hashes = 1;++    /* recalculate the hash if a different hash as been selected than the one we used for calculating the early secrets */+    if (reset) {+        --sched->generation;+        memset(sched->secret, 0, sizeof(sched->secret));+        if ((ret = key_schedule_extract(sched, ptls_iovec_init(NULL, 0))) != 0)+            goto Exit;+    }++    ret = 0;+Exit:+    return ret;+}++void ptls__key_schedule_update_hash(ptls_key_schedule_t *sched, const uint8_t *msg, size_t msglen)+{+    size_t i;++    PTLS_DEBUGF("%s:%zu\n", __FUNCTION__, msglen);+    for (i = 0; i != sched->num_hashes; ++i)+        sched->hashes[i].ctx->update(sched->hashes[i].ctx, msg, msglen);+}++static void key_schedule_update_ch1hash_prefix(ptls_key_schedule_t *sched)+{+    uint8_t prefix[4] = {PTLS_HANDSHAKE_TYPE_MESSAGE_HASH, 0, 0, (uint8_t)sched->hashes[0].algo->digest_size};+    ptls__key_schedule_update_hash(sched, prefix, sizeof(prefix));+}++static void key_schedule_extract_ch1hash(ptls_key_schedule_t *sched, uint8_t *hash)+{+    sched->hashes[0].ctx->final(sched->hashes[0].ctx, hash, PTLS_HASH_FINAL_MODE_RESET);+}++static void key_schedule_transform_post_ch1hash(ptls_key_schedule_t *sched)+{+    uint8_t ch1hash[PTLS_MAX_DIGEST_SIZE];++    key_schedule_extract_ch1hash(sched, ch1hash);++    key_schedule_update_ch1hash_prefix(sched);+    ptls__key_schedule_update_hash(sched, ch1hash, sched->hashes[0].algo->digest_size);+}++static int derive_secret_with_hash(ptls_key_schedule_t *sched, void *secret, const char *label, const uint8_t *hash)+{+    int ret = hkdf_expand_label(sched->hashes[0].algo, secret, sched->hashes[0].algo->digest_size,+                                ptls_iovec_init(sched->secret, sched->hashes[0].algo->digest_size), label,+                                ptls_iovec_init(hash, sched->hashes[0].algo->digest_size), sched->hkdf_label_prefix);+    PTLS_DEBUGF("%s: (label=%s, hash=%02x%02x) => %02x%02x\n", __FUNCTION__, label, hash[0], hash[1], ((uint8_t *)secret)[0],+                ((uint8_t *)secret)[1]);+    return ret;+}++static int derive_secret(ptls_key_schedule_t *sched, void *secret, const char *label)+{+    uint8_t hash_value[PTLS_MAX_DIGEST_SIZE];++    sched->hashes[0].ctx->final(sched->hashes[0].ctx, hash_value, PTLS_HASH_FINAL_MODE_SNAPSHOT);+    int ret = derive_secret_with_hash(sched, secret, label, hash_value);+    ptls_clear_memory(hash_value, sizeof(hash_value));+    return ret;+}++static int derive_secret_with_empty_digest(ptls_key_schedule_t *sched, void *secret, const char *label)+{+    return derive_secret_with_hash(sched, secret, label, sched->hashes[0].algo->empty_digest);+}++static int derive_exporter_secret(ptls_t *tls, int is_early)+{+    int ret;++    if (!tls->ctx->use_exporter)+        return 0;++    uint8_t **slot = is_early ? &tls->exporter_master_secret.early : &tls->exporter_master_secret.one_rtt;+    assert(*slot == NULL);+    if ((*slot = malloc(tls->key_schedule->hashes[0].algo->digest_size)) == NULL)+        return PTLS_ERROR_NO_MEMORY;++    if ((ret = derive_secret(tls->key_schedule, *slot, is_early ? "e exp master" : "exp master")) != 0)+        return ret;++    log_secret(tls, is_early ? "EARLY_EXPORTER_SECRET" : "EXPORTER_SECRET",+               ptls_iovec_init(*slot, tls->key_schedule->hashes[0].algo->digest_size));++    return 0;+}++static void free_exporter_master_secret(ptls_t *tls, int is_early)+{+    uint8_t *slot = is_early ? tls->exporter_master_secret.early : tls->exporter_master_secret.one_rtt;+    if (slot == NULL)+        return;+    assert(tls->key_schedule != NULL);+    ptls_clear_memory(slot, tls->key_schedule->hashes[0].algo->digest_size);+    free(slot);+}++static int derive_resumption_secret(ptls_key_schedule_t *sched, uint8_t *secret, ptls_iovec_t nonce)+{+    int ret;++    if ((ret = derive_secret(sched, secret, "res master")) != 0)+        goto Exit;+    if ((ret = hkdf_expand_label(sched->hashes[0].algo, secret, sched->hashes[0].algo->digest_size,+                                 ptls_iovec_init(secret, sched->hashes[0].algo->digest_size), "resumption", nonce,+                                 sched->hkdf_label_prefix)) != 0)+        goto Exit;++Exit:+    if (ret != 0)+        ptls_clear_memory(secret, sched->hashes[0].algo->digest_size);+    return ret;+}++static int decode_new_session_ticket(ptls_t *tls, uint32_t *lifetime, uint32_t *age_add, ptls_iovec_t *nonce, ptls_iovec_t *ticket,+                                     uint32_t *max_early_data_size, const uint8_t *src, const uint8_t *const end)+{+    uint16_t exttype;+    int ret;++    if ((ret = ptls_decode32(lifetime, &src, end)) != 0)+        goto Exit;+    if ((ret = ptls_decode32(age_add, &src, end)) != 0)+        goto Exit;+    ptls_decode_open_block(src, end, 1, {+        *nonce = ptls_iovec_init(src, end - src);+        src = end;+    });+    ptls_decode_open_block(src, end, 2, {+        if (src == end) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        *ticket = ptls_iovec_init(src, end - src);+        src = end;+    });++    *max_early_data_size = 0;+    decode_extensions(src, end, PTLS_HANDSHAKE_TYPE_NEW_SESSION_TICKET, &exttype, {+        if (tls->ctx->on_extension != NULL &&+            (ret = tls->ctx->on_extension->cb(tls->ctx->on_extension, tls, PTLS_HANDSHAKE_TYPE_NEW_SESSION_TICKET, exttype,+                                              ptls_iovec_init(src, end - src)) != 0))+            goto Exit;+        switch (exttype) {+        case PTLS_EXTENSION_TYPE_EARLY_DATA:+            if ((ret = ptls_decode32(max_early_data_size, &src, end)) != 0)+                goto Exit;+            break;+        default:+            src = end;+            break;+        }+    });++    ret = 0;+Exit:+    return ret;+}++static int decode_stored_session_ticket(ptls_t *tls, ptls_key_exchange_algorithm_t **key_share, ptls_cipher_suite_t **cs,+                                        ptls_iovec_t *secret, uint32_t *obfuscated_ticket_age, ptls_iovec_t *ticket,+                                        uint32_t *max_early_data_size, const uint8_t *src, const uint8_t *const end)+{+    uint16_t kxid, csid;+    uint32_t lifetime, age_add;+    uint64_t obtained_at, now;+    ptls_iovec_t nonce;+    int ret;++    /* decode */+    if ((ret = ptls_decode64(&obtained_at, &src, end)) != 0)+        goto Exit;+    if ((ret = ptls_decode16(&kxid, &src, end)) != 0)+        goto Exit;+    if ((ret = ptls_decode16(&csid, &src, end)) != 0)+        goto Exit;+    ptls_decode_open_block(src, end, 3, {+        if ((ret = decode_new_session_ticket(tls, &lifetime, &age_add, &nonce, ticket, max_early_data_size, src, end)) != 0)+            goto Exit;+        src = end;+    });+    ptls_decode_block(src, end, 2, {+        *secret = ptls_iovec_init(src, end - src);+        src = end;+    });++    { /* determine the key-exchange */+        ptls_key_exchange_algorithm_t **cand;+        for (cand = tls->ctx->key_exchanges; *cand != NULL; ++cand)+            if ((*cand)->id == kxid)+                break;+        if (*cand == NULL) {+            ret = PTLS_ERROR_LIBRARY;+            goto Exit;+        }+        *key_share = *cand;+    }++    { /* determine the cipher-suite */+        ptls_cipher_suite_t **cand;+        for (cand = tls->ctx->cipher_suites; *cand != NULL; ++cand)+            if ((*cand)->id == csid)+                break;+        if (*cand == NULL) {+            ret = PTLS_ERROR_LIBRARY;+            goto Exit;+        }+        *cs = *cand;+    }++    /* calculate obfuscated_ticket_age */+    now = tls->ctx->get_time->cb(tls->ctx->get_time);+    if (!(obtained_at <= now && now - obtained_at < 7 * 86400 * 1000)) {+        ret = PTLS_ERROR_LIBRARY;+        goto Exit;+    }+    *obfuscated_ticket_age = (uint32_t)(now - obtained_at) + age_add;++    ret = 0;+Exit:+    return ret;+}++static int get_traffic_key(ptls_hash_algorithm_t *algo, void *key, size_t key_size, int is_iv, const void *secret,+                           ptls_iovec_t hash_value, const char *label_prefix)+{+    return ptls_hkdf_expand_label(algo, key, key_size, ptls_iovec_init(secret, algo->digest_size), is_iv ? "iv" : "key", hash_value,+                                  label_prefix);+}++static int setup_traffic_protection(ptls_t *tls, int is_enc, const char *secret_label, size_t epoch, int skip_notify)+{+    static const char *log_labels[2][4] = {+        {NULL, "CLIENT_EARLY_TRAFFIC_SECRET", "CLIENT_HANDSHAKE_TRAFFIC_SECRET", "CLIENT_TRAFFIC_SECRET_0"},+        {NULL, NULL, "SERVER_HANDSHAKE_TRAFFIC_SECRET", "SERVER_TRAFFIC_SECRET_0"}};+    struct st_ptls_traffic_protection_t *ctx = is_enc ? &tls->traffic_protection.enc : &tls->traffic_protection.dec;++    if (secret_label != NULL) {+        int ret;+        if ((ret = derive_secret(tls->key_schedule, ctx->secret, secret_label)) != 0)+            return ret;+    }++    ctx->epoch = epoch;++    /* special path for applications having their own record layer */+    if (tls->ctx->update_traffic_key != NULL) {+        if (skip_notify)+            return 0;+        return tls->ctx->update_traffic_key->cb(tls->ctx->update_traffic_key, tls, is_enc, epoch, ctx->secret);+    }++    if (ctx->aead != NULL)+        ptls_aead_free(ctx->aead);+    if ((ctx->aead = ptls_aead_new(tls->cipher_suite->aead, tls->cipher_suite->hash, is_enc, ctx->secret,+                                   tls->ctx->hkdf_label_prefix__obsolete)) == NULL)+        return PTLS_ERROR_NO_MEMORY; /* TODO obtain error from ptls_aead_new */+    ctx->seq = 0;++    log_secret(tls, log_labels[ptls_is_server(tls) == is_enc][epoch],+               ptls_iovec_init(ctx->secret, tls->key_schedule->hashes[0].algo->digest_size));+    PTLS_DEBUGF("[%s] %02x%02x,%02x%02x\n", log_labels[ptls_is_server(tls)][epoch], (unsigned)ctx->secret[0],+                (unsigned)ctx->secret[1], (unsigned)ctx->aead->static_iv[0], (unsigned)ctx->aead->static_iv[1]);++    return 0;+}++static int commission_handshake_secret(ptls_t *tls)+{+    int is_enc = !ptls_is_server(tls);++    assert(tls->pending_handshake_secret != NULL);+    memcpy((is_enc ? &tls->traffic_protection.enc : &tls->traffic_protection.dec)->secret, tls->pending_handshake_secret,+           PTLS_MAX_DIGEST_SIZE);+    ptls_clear_memory(tls->pending_handshake_secret, PTLS_MAX_DIGEST_SIZE);+    free(tls->pending_handshake_secret);+    tls->pending_handshake_secret = NULL;++    return setup_traffic_protection(tls, is_enc, NULL, 2, 1);+}++static void log_client_random(ptls_t *tls)+{+    PTLS_PROBE(CLIENT_RANDOM, tls,+               ptls_hexdump(alloca(sizeof(tls->client_random) * 2 + 1), tls->client_random, sizeof(tls->client_random)));+}++#define SESSION_IDENTIFIER_MAGIC "ptls0001" /* the number should be changed upon incompatible format change */+#define SESSION_IDENTIFIER_MAGIC_SIZE (sizeof(SESSION_IDENTIFIER_MAGIC) - 1)++static int encode_session_identifier(ptls_context_t *ctx, ptls_buffer_t *buf, uint32_t ticket_age_add, ptls_iovec_t ticket_nonce,+                                     ptls_key_schedule_t *sched, const char *server_name, uint16_t key_exchange_id, uint16_t csid,+                                     const char *negotiated_protocol)+{+    int ret = 0;++    ptls_buffer_push_block(buf, 2, {+        /* format id */+        ptls_buffer_pushv(buf, SESSION_IDENTIFIER_MAGIC, SESSION_IDENTIFIER_MAGIC_SIZE);+        /* date */+        ptls_buffer_push64(buf, ctx->get_time->cb(ctx->get_time));+        /* resumption master secret */+        ptls_buffer_push_block(buf, 2, {+            if ((ret = ptls_buffer_reserve(buf, sched->hashes[0].algo->digest_size)) != 0)+                goto Exit;+            if ((ret = derive_resumption_secret(sched, buf->base + buf->off, ticket_nonce)) != 0)+                goto Exit;+            buf->off += sched->hashes[0].algo->digest_size;+        });+        /* key-exchange */+        ptls_buffer_push16(buf, key_exchange_id);+        /* cipher-suite */+        ptls_buffer_push16(buf, csid);+        /* ticket_age_add */+        ptls_buffer_push32(buf, ticket_age_add);+        /* server-name */+        ptls_buffer_push_block(buf, 2, {+            if (server_name != NULL)+                ptls_buffer_pushv(buf, server_name, strlen(server_name));+        });+        /* alpn */+        ptls_buffer_push_block(buf, 1, {+            if (negotiated_protocol != NULL)+                ptls_buffer_pushv(buf, negotiated_protocol, strlen(negotiated_protocol));+        });+    });++Exit:+    return ret;+}++int decode_session_identifier(uint64_t *issued_at, ptls_iovec_t *psk, uint32_t *ticket_age_add, ptls_iovec_t *server_name,+                              uint16_t *key_exchange_id, uint16_t *csid, ptls_iovec_t *negotiated_protocol, const uint8_t *src,+                              const uint8_t *const end)+{+    int ret = 0;++    ptls_decode_block(src, end, 2, {+        if (end - src < SESSION_IDENTIFIER_MAGIC_SIZE ||+            memcmp(src, SESSION_IDENTIFIER_MAGIC, SESSION_IDENTIFIER_MAGIC_SIZE) != 0) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        src += SESSION_IDENTIFIER_MAGIC_SIZE;+        if ((ret = ptls_decode64(issued_at, &src, end)) != 0)+            goto Exit;+        ptls_decode_open_block(src, end, 2, {+            *psk = ptls_iovec_init(src, end - src);+            src = end;+        });+        if ((ret = ptls_decode16(key_exchange_id, &src, end)) != 0)+            goto Exit;+        if ((ret = ptls_decode16(csid, &src, end)) != 0)+            goto Exit;+        if ((ret = ptls_decode32(ticket_age_add, &src, end)) != 0)+            goto Exit;+        ptls_decode_open_block(src, end, 2, {+            *server_name = ptls_iovec_init(src, end - src);+            src = end;+        });+        ptls_decode_open_block(src, end, 1, {+            *negotiated_protocol = ptls_iovec_init(src, end - src);+            src = end;+        });+    });++Exit:+    return ret;+}++static size_t build_certificate_verify_signdata(uint8_t *data, ptls_key_schedule_t *sched, const char *context_string)+{+    size_t datalen = 0;++    memset(data + datalen, 32, 64);+    datalen += 64;+    memcpy(data + datalen, context_string, strlen(context_string) + 1);+    datalen += strlen(context_string) + 1;+    sched->hashes[0].ctx->final(sched->hashes[0].ctx, data + datalen, PTLS_HASH_FINAL_MODE_SNAPSHOT);+    datalen += sched->hashes[0].algo->digest_size;+    assert(datalen <= PTLS_MAX_CERTIFICATE_VERIFY_SIGNDATA_SIZE);++    return datalen;+}++static int calc_verify_data(void *output, ptls_key_schedule_t *sched, const void *secret)+{+    ptls_hash_context_t *hmac;+    uint8_t digest[PTLS_MAX_DIGEST_SIZE];+    int ret;++    if ((ret = hkdf_expand_label(sched->hashes[0].algo, digest, sched->hashes[0].algo->digest_size,+                                 ptls_iovec_init(secret, sched->hashes[0].algo->digest_size), "finished", ptls_iovec_init(NULL, 0),+                                 sched->hkdf_label_prefix)) != 0)+        return ret;+    if ((hmac = ptls_hmac_create(sched->hashes[0].algo, digest, sched->hashes[0].algo->digest_size)) == NULL) {+        ptls_clear_memory(digest, sizeof(digest));+        return PTLS_ERROR_NO_MEMORY;+    }++    sched->hashes[0].ctx->final(sched->hashes[0].ctx, digest, PTLS_HASH_FINAL_MODE_SNAPSHOT);+    PTLS_DEBUGF("%s: %02x%02x,%02x%02x\n", __FUNCTION__, ((uint8_t *)secret)[0], ((uint8_t *)secret)[1], digest[0], digest[1]);+    hmac->update(hmac, digest, sched->hashes[0].algo->digest_size);+    ptls_clear_memory(digest, sizeof(digest));+    hmac->final(hmac, output, PTLS_HASH_FINAL_MODE_FREE);++    return 0;+}++static int verify_finished(ptls_t *tls, ptls_iovec_t message)+{+    uint8_t verify_data[PTLS_MAX_DIGEST_SIZE];+    int ret;++    if (PTLS_HANDSHAKE_HEADER_SIZE + tls->key_schedule->hashes[0].algo->digest_size != message.len) {+        ret = PTLS_ALERT_DECODE_ERROR;+        goto Exit;+    }++    if ((ret = calc_verify_data(verify_data, tls->key_schedule, tls->traffic_protection.dec.secret)) != 0)+        goto Exit;+    if (!ptls_mem_equal(message.base + PTLS_HANDSHAKE_HEADER_SIZE, verify_data, tls->key_schedule->hashes[0].algo->digest_size)) {+        ret = PTLS_ALERT_HANDSHAKE_FAILURE;+        goto Exit;+    }++Exit:+    ptls_clear_memory(verify_data, sizeof(verify_data));+    return ret;+}++static int send_finished(ptls_t *tls, ptls_message_emitter_t *emitter)+{+    int ret;++    ptls_push_message(emitter, tls->key_schedule, PTLS_HANDSHAKE_TYPE_FINISHED, {+        if ((ret = ptls_buffer_reserve(emitter->buf, tls->key_schedule->hashes[0].algo->digest_size)) != 0)+            goto Exit;+        if ((ret = calc_verify_data(emitter->buf->base + emitter->buf->off, tls->key_schedule,+                                    tls->traffic_protection.enc.secret)) != 0)+            goto Exit;+        emitter->buf->off += tls->key_schedule->hashes[0].algo->digest_size;+    });++Exit:+    return ret;+}++static int send_session_ticket(ptls_t *tls, ptls_message_emitter_t *emitter)+{+    ptls_hash_context_t *msghash_backup = tls->key_schedule->hashes[0].ctx->clone_(tls->key_schedule->hashes[0].ctx);+    ptls_buffer_t session_id;+    char session_id_smallbuf[128];+    uint32_t ticket_age_add;+    int ret = 0;++    assert(tls->ctx->ticket_lifetime != 0);+    assert(tls->ctx->encrypt_ticket != NULL);++    { /* calculate verify-data that will be sent by the client */+        size_t orig_off = emitter->buf->off;+        if (tls->pending_handshake_secret != NULL && !tls->ctx->omit_end_of_early_data) {+            assert(tls->state == PTLS_STATE_SERVER_EXPECT_END_OF_EARLY_DATA);+            ptls_buffer_push_message_body(emitter->buf, tls->key_schedule, PTLS_HANDSHAKE_TYPE_END_OF_EARLY_DATA, {});+            emitter->buf->off = orig_off;+        }+        ptls_buffer_push_message_body(emitter->buf, tls->key_schedule, PTLS_HANDSHAKE_TYPE_FINISHED, {+            if ((ret = ptls_buffer_reserve(emitter->buf, tls->key_schedule->hashes[0].algo->digest_size)) != 0)+                goto Exit;+            if ((ret = calc_verify_data(emitter->buf->base + emitter->buf->off, tls->key_schedule,+                                        tls->pending_handshake_secret != NULL ? tls->pending_handshake_secret+                                                                              : tls->traffic_protection.dec.secret)) != 0)+                goto Exit;+            emitter->buf->off += tls->key_schedule->hashes[0].algo->digest_size;+        });+        emitter->buf->off = orig_off;+    }++    tls->ctx->random_bytes(&ticket_age_add, sizeof(ticket_age_add));++    /* build the raw nsk */+    ptls_buffer_init(&session_id, session_id_smallbuf, sizeof(session_id_smallbuf));+    ret = encode_session_identifier(tls->ctx, &session_id, ticket_age_add, ptls_iovec_init(NULL, 0), tls->key_schedule,+                                    tls->server_name, tls->key_share->id, tls->cipher_suite->id, tls->negotiated_protocol);+    if (ret != 0)+        goto Exit;++    /* encrypt and send */+    ptls_push_message(emitter, tls->key_schedule, PTLS_HANDSHAKE_TYPE_NEW_SESSION_TICKET, {+        ptls_buffer_push32(emitter->buf, tls->ctx->ticket_lifetime);+        ptls_buffer_push32(emitter->buf, ticket_age_add);+        ptls_buffer_push_block(emitter->buf, 1, {});+        ptls_buffer_push_block(emitter->buf, 2, {+            if ((ret = tls->ctx->encrypt_ticket->cb(tls->ctx->encrypt_ticket, tls, 1, emitter->buf,+                                                    ptls_iovec_init(session_id.base, session_id.off))) != 0)+                goto Exit;+        });+        ptls_buffer_push_block(emitter->buf, 2, {+            if (tls->ctx->max_early_data_size != 0)+                buffer_push_extension(emitter->buf, PTLS_EXTENSION_TYPE_EARLY_DATA,+                                      { ptls_buffer_push32(emitter->buf, tls->ctx->max_early_data_size); });+        });+    });++Exit:+    ptls_buffer_dispose(&session_id);++    /* restore handshake state */+    tls->key_schedule->hashes[0].ctx->final(tls->key_schedule->hashes[0].ctx, NULL, PTLS_HASH_FINAL_MODE_FREE);+    tls->key_schedule->hashes[0].ctx = msghash_backup;++    return ret;+}++static int push_change_cipher_spec(ptls_t *tls, ptls_message_emitter_t *emitter)+{+    int ret;++    /* check if we are requested to (or still need to) */+    if (!tls->send_change_cipher_spec) {+        ret = 0;+        goto Exit;+    }++    /* CCS is a record, can only be sent when using a record-based protocol. */+    if (emitter->begin_message != begin_record_message) {+        ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        goto Exit;+    }++    /* emit CCS */+    buffer_push_record(emitter->buf, PTLS_CONTENT_TYPE_CHANGE_CIPHER_SPEC, { ptls_buffer_push(emitter->buf, 1); });++    tls->send_change_cipher_spec = 0;+    ret = 0;+Exit:+    return ret;+}++static int push_additional_extensions(ptls_handshake_properties_t *properties, ptls_buffer_t *sendbuf)+{+    int ret;++    if (properties != NULL && properties->additional_extensions != NULL) {+        ptls_raw_extension_t *ext;+        for (ext = properties->additional_extensions; ext->type != UINT16_MAX; ++ext) {+            buffer_push_extension(sendbuf, ext->type, { ptls_buffer_pushv(sendbuf, ext->data.base, ext->data.len); });+        }+    }+    ret = 0;+Exit:+    return ret;+}++static int push_signature_algorithms(ptls_verify_certificate_t *vc, ptls_buffer_t *sendbuf)+{+    /* The list sent when verify callback is not registered */+    static const uint16_t default_algos[] = {PTLS_SIGNATURE_RSA_PSS_RSAE_SHA256, PTLS_SIGNATURE_ECDSA_SECP256R1_SHA256,+                                             PTLS_SIGNATURE_RSA_PKCS1_SHA256, PTLS_SIGNATURE_RSA_PKCS1_SHA1, UINT16_MAX};+    int ret;++    ptls_buffer_push_block(sendbuf, 2, {+        for (const uint16_t *p = vc != NULL ? vc->algos : default_algos; *p != UINT16_MAX; ++p)+            ptls_buffer_push16(sendbuf, *p);+    });++    ret = 0;+Exit:+    return ret;+}++static int decode_signature_algorithms(struct st_ptls_signature_algorithms_t *sa, const uint8_t **src, const uint8_t *end)+{+    int ret;++    ptls_decode_block(*src, end, 2, {+        do {+            uint16_t id;+            if ((ret = ptls_decode16(&id, src, end)) != 0)+                goto Exit;+            if (sa->count < PTLS_ELEMENTSOF(sa->list))+                sa->list[sa->count++] = id;+        } while (*src != end);+    });++    ret = 0;+Exit:+    return ret;+}++static ptls_hash_context_t *create_sha256_context(ptls_context_t *ctx)+{+    ptls_cipher_suite_t **cs;++    for (cs = ctx->cipher_suites; *cs != NULL; ++cs) {+        switch ((*cs)->id) {+        case PTLS_CIPHER_SUITE_AES_128_GCM_SHA256:+        case PTLS_CIPHER_SUITE_CHACHA20_POLY1305_SHA256:+            return (*cs)->hash->create();+        }+    }++    return NULL;+}++static int select_cipher(ptls_cipher_suite_t **selected, ptls_cipher_suite_t **candidates, const uint8_t *src,+                         const uint8_t *const end, int server_preference)+{+    size_t found_index = SIZE_MAX;+    int ret;++    while (src != end) {+        uint16_t id;+        if ((ret = ptls_decode16(&id, &src, end)) != 0)+            goto Exit;+        for (size_t i = 0; candidates[i] != NULL; ++i) {+            if (candidates[i]->id == id) {+                if (server_preference) {+                    /* preserve smallest matching index, and proceed to the next input */+                    if (i < found_index) {+                        found_index = i;+                        break;+                    }+                } else {+                    /* return the pointer matching to the first input that can be used */+                    *selected = candidates[i];+                    goto Exit;+                }+            }+        }+    }+    if (found_index != SIZE_MAX) {+        *selected = candidates[found_index];+        ret = 0;+    } else {+        ret = PTLS_ALERT_HANDSHAKE_FAILURE;+    }++Exit:+    return ret;+}++static int push_key_share_entry(ptls_buffer_t *buf, uint16_t group, ptls_iovec_t pubkey)+{+    int ret;++    ptls_buffer_push16(buf, group);+    ptls_buffer_push_block(buf, 2, { ptls_buffer_pushv(buf, pubkey.base, pubkey.len); });+    ret = 0;+Exit:+    return ret;+}++static int decode_key_share_entry(uint16_t *group, ptls_iovec_t *key_exchange, const uint8_t **src, const uint8_t *const end)+{+    int ret;++    if ((ret = ptls_decode16(group, src, end)) != 0)+        goto Exit;+    ptls_decode_open_block(*src, end, 2, {+        *key_exchange = ptls_iovec_init(*src, end - *src);+        *src = end;+    });++Exit:+    return ret;+}++static int select_key_share(ptls_key_exchange_algorithm_t **selected, ptls_iovec_t *peer_key,+                            ptls_key_exchange_algorithm_t **candidates, const uint8_t **src, const uint8_t *const end,+                            int expect_one)+{+    int ret;++    *selected = NULL;++    if (expect_one && *src == end) {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }++    while (*src != end) {+        uint16_t group;+        ptls_iovec_t key;+        if ((ret = decode_key_share_entry(&group, &key, src, end)) != 0)+            goto Exit;+        ptls_key_exchange_algorithm_t **c = candidates;+        for (; *c != NULL; ++c) {+            if (*selected == NULL && (*c)->id == group) {+                *selected = *c;+                *peer_key = key;+            }+        }+        if (expect_one) {+            ret = *selected != NULL ? 0 : PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+    }++    ret = 0;++Exit:+    return ret;+}++static int emit_server_name_extension(ptls_buffer_t *buf, const char *server_name)+{+    int ret;++    ptls_buffer_push_block(buf, 2, {+        ptls_buffer_push(buf, PTLS_SERVER_NAME_TYPE_HOSTNAME);+        ptls_buffer_push_block(buf, 2, { ptls_buffer_pushv(buf, server_name, strlen(server_name)); });+    });++    ret = 0;+Exit:+    return ret;+}++static int parse_esni_keys(ptls_context_t *ctx, uint16_t *esni_version, ptls_key_exchange_algorithm_t **selected_key_share,+                           ptls_cipher_suite_t **selected_cipher, ptls_iovec_t *peer_key, uint16_t *padded_length,+                           char **published_sni, ptls_iovec_t input)+{+    const uint8_t *src = input.base, *const end = input.base + input.len;+    uint16_t version;+    uint64_t not_before, not_after, now;+    int ret = 0;++    /* version */+    if ((ret = ptls_decode16(&version, &src, end)) != 0)+        goto Exit;+    if (version != PTLS_ESNI_VERSION_DRAFT03) {+        ret = PTLS_ALERT_DECODE_ERROR;+        goto Exit;+    }++    { /* verify checksum */+        ptls_hash_context_t *hctx;+        uint8_t digest[PTLS_SHA256_DIGEST_SIZE];+        if (end - src < 4) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        if ((hctx = create_sha256_context(ctx)) == NULL) {+            ret = PTLS_ERROR_LIBRARY;+            goto Exit;+        }+        hctx->update(hctx, input.base, src - input.base);+        hctx->update(hctx, "\0\0\0\0", 4);+        hctx->update(hctx, src + 4, end - (src + 4));+        hctx->final(hctx, digest, PTLS_HASH_FINAL_MODE_FREE);+        if (memcmp(src, digest, 4) != 0) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        src += 4;+    }+    *esni_version = version;+    /* published sni */+    ptls_decode_open_block(src, end, 2, {+        size_t len = end - src;+        *published_sni = malloc(len + 1);+        if (*published_sni == NULL) {+            ret = PTLS_ERROR_NO_MEMORY;+            goto Exit;+        }+        if (len > 0) {+            memcpy(*published_sni, src, len);+        }+        (*published_sni)[len] = 0;+        src = end;+    });+    /* key-shares */+    ptls_decode_open_block(src, end, 2, {+        if ((ret = select_key_share(selected_key_share, peer_key, ctx->key_exchanges, &src, end, 0)) != 0)+            goto Exit;+    });+    /* cipher-suite */+    ptls_decode_open_block(src, end, 2, {+        if ((ret = select_cipher(selected_cipher, ctx->cipher_suites, src, end, ctx->server_cipher_preference)) != 0)+            goto Exit;+        src = end;+    });+    /* padded-length */+    if ((ret = ptls_decode16(padded_length, &src, end)) != 0)+        goto Exit;+    if (padded_length == 0)+        goto Exit;+    /* not-before, not_after */+    if ((ret = ptls_decode64(&not_before, &src, end)) != 0 || (ret = ptls_decode64(&not_after, &src, end)) != 0)+        goto Exit;+    /* extensions */+    ptls_decode_block(src, end, 2, {+        while (src != end) {+            uint16_t id;+            if ((ret = ptls_decode16(&id, &src, end)) != 0)+                goto Exit;+            ptls_decode_open_block(src, end, 2, { src = end; });+        }+    });++    /* check validity period */+    now = ctx->get_time->cb(ctx->get_time);+    if (!(not_before * 1000 <= now && now <= not_after * 1000)) {+        ret = PTLS_ALERT_DECODE_ERROR;+        goto Exit;+    }++    ret = 0;+Exit:+    return ret;+}++static int create_esni_aead(ptls_aead_context_t **aead_ctx, int is_enc, ptls_cipher_suite_t *cipher, ptls_iovec_t ecdh_secret,+                            const uint8_t *esni_contents_hash)+{+    uint8_t aead_secret[PTLS_MAX_DIGEST_SIZE];+    int ret;++    if ((ret = ptls_hkdf_extract(cipher->hash, aead_secret, ptls_iovec_init(NULL, 0), ecdh_secret)) != 0)+        goto Exit;+    if ((*aead_ctx = new_aead(cipher->aead, cipher->hash, is_enc, aead_secret,+                              ptls_iovec_init(esni_contents_hash, cipher->hash->digest_size), "tls13 esni ")) == NULL) {+        ret = PTLS_ERROR_NO_MEMORY;+        goto Exit;+    }++    ret = 0;+Exit:+    ptls_clear_memory(aead_secret, sizeof(aead_secret));+    return ret;+}++static int build_esni_contents_hash(ptls_hash_algorithm_t *hash, uint8_t *digest, const uint8_t *record_digest, uint16_t group,+                                    ptls_iovec_t pubkey, const uint8_t *client_random)+{+    ptls_buffer_t buf;+    uint8_t smallbuf[256];+    int ret;++    /* build ESNIContents */+    ptls_buffer_init(&buf, smallbuf, sizeof(smallbuf));+    ptls_buffer_push_block(&buf, 2, { ptls_buffer_pushv(&buf, record_digest, hash->digest_size); });+    if ((ret = push_key_share_entry(&buf, group, pubkey)) != 0)+        goto Exit;+    ptls_buffer_pushv(&buf, client_random, PTLS_HELLO_RANDOM_SIZE);++    /* calculate digest */+    if ((ret = ptls_calc_hash(hash, digest, buf.base, buf.off)) != 0)+        goto Exit;++    ret = 0;+Exit:+    ptls_buffer_dispose(&buf);+    return ret;+}++static void free_esni_secret(ptls_esni_secret_t **esni, int is_server)+{+    assert(*esni != NULL);+    if ((*esni)->secret.base != NULL) {+        ptls_clear_memory((*esni)->secret.base, (*esni)->secret.len);+        free((*esni)->secret.base);+    }+    if (!is_server)+        free((*esni)->client.pubkey.base);+    ptls_clear_memory((*esni), sizeof(**esni));+    free(*esni);+    *esni = NULL;+}++static int client_setup_esni(ptls_context_t *ctx, ptls_esni_secret_t **esni, ptls_iovec_t esni_keys, char **published_sni,+                             const uint8_t *client_random)+{+    ptls_iovec_t peer_key;+    int ret;++    if ((*esni = malloc(sizeof(**esni))) == NULL)+        return PTLS_ERROR_NO_MEMORY;+    memset(*esni, 0, sizeof(**esni));++    /* parse ESNI_Keys (and return success while keeping *esni NULL) */+    if (parse_esni_keys(ctx, &(*esni)->version, &(*esni)->client.key_share, &(*esni)->client.cipher, &peer_key,+                        &(*esni)->client.padded_length, published_sni, esni_keys) != 0) {+        free(*esni);+        *esni = NULL;+        return 0;+    }++    ctx->random_bytes((*esni)->nonce, sizeof((*esni)->nonce));++    /* calc record digest */+    if ((ret = ptls_calc_hash((*esni)->client.cipher->hash, (*esni)->client.record_digest, esni_keys.base, esni_keys.len)) != 0)+        goto Exit;+    /* derive ECDH secret */+    if ((ret = (*esni)->client.key_share->exchange((*esni)->client.key_share, &(*esni)->client.pubkey, &(*esni)->secret,+                                                   peer_key)) != 0)+        goto Exit;+    /* calc H(ESNIContents) */+    if ((ret = build_esni_contents_hash((*esni)->client.cipher->hash, (*esni)->esni_contents_hash, (*esni)->client.record_digest,+                                        (*esni)->client.key_share->id, (*esni)->client.pubkey, client_random)) != 0)+        goto Exit;++    ret = 0;+Exit:+    if (ret != 0)+        free_esni_secret(esni, 0);+    return ret;+}++static int emit_esni_extension(ptls_esni_secret_t *esni, ptls_buffer_t *buf, ptls_iovec_t esni_keys, const char *server_name,+                               size_t key_share_ch_off, size_t key_share_ch_len)+{+    ptls_aead_context_t *aead = NULL;+    int ret;++    if ((ret = create_esni_aead(&aead, 1, esni->client.cipher, esni->secret, esni->esni_contents_hash)) != 0)+        goto Exit;++    /* cipher-suite id */+    ptls_buffer_push16(buf, esni->client.cipher->id);+    /* key-share */+    if ((ret = push_key_share_entry(buf, esni->client.key_share->id, esni->client.pubkey)) != 0)+        goto Exit;+    /* record-digest */+    ptls_buffer_push_block(buf, 2, { ptls_buffer_pushv(buf, esni->client.record_digest, esni->client.cipher->hash->digest_size); });+    /* encrypted sni */+    ptls_buffer_push_block(buf, 2, {+        size_t start_off = buf->off;+        /* nonce */+        ptls_buffer_pushv(buf, esni->nonce, PTLS_ESNI_NONCE_SIZE);+        /* emit server-name extension */+        if ((ret = emit_server_name_extension(buf, server_name)) != 0)+            goto Exit;+        /* pad */+        if (buf->off - start_off < (size_t)(esni->client.padded_length + PTLS_ESNI_NONCE_SIZE)) {+            size_t bytes_to_pad = esni->client.padded_length + PTLS_ESNI_NONCE_SIZE - (buf->off - start_off);+            if ((ret = ptls_buffer_reserve(buf, bytes_to_pad)) != 0)+                goto Exit;+            memset(buf->base + buf->off, 0, bytes_to_pad);+            buf->off += bytes_to_pad;+        }+        /* encrypt */+        if ((ret = ptls_buffer_reserve(buf, aead->algo->tag_size)) != 0)+            goto Exit;+        ptls_aead_encrypt(aead, buf->base + start_off, buf->base + start_off, buf->off - start_off, 0, buf->base + key_share_ch_off,+                          key_share_ch_len);+        buf->off += aead->algo->tag_size;+    });++    ret = 0;+Exit:+    if (aead != NULL)+        ptls_aead_free(aead);+    return ret;+}++static int send_client_hello(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_handshake_properties_t *properties,+                             ptls_iovec_t *cookie)+{+    ptls_iovec_t resumption_secret = {NULL}, resumption_ticket;+    char *published_sni = NULL;+    uint32_t obfuscated_ticket_age = 0;+    size_t msghash_off;+    uint8_t binder_key[PTLS_MAX_DIGEST_SIZE];+    int ret, is_second_flight = tls->key_schedule != NULL,+             send_sni = tls->server_name != NULL && !ptls_server_name_is_ipaddr(tls->server_name);++    if (properties != NULL) {+        /* try to use ESNI */+        if (!is_second_flight && send_sni && properties->client.esni_keys.base != NULL) {+            if ((ret = client_setup_esni(tls->ctx, &tls->esni, properties->client.esni_keys, &published_sni, tls->client_random)) !=+                0) {+                goto Exit;+            }+            if (tls->ctx->update_esni_key != NULL) {+                if ((ret = tls->ctx->update_esni_key->cb(tls->ctx->update_esni_key, tls, tls->esni->secret,+                                                         tls->esni->client.cipher->hash, tls->esni->esni_contents_hash)) != 0)+                    goto Exit;+            }+        }+        /* setup resumption-related data. If successful, resumption_secret becomes a non-zero value. */+        if (properties->client.session_ticket.base != NULL) {+            ptls_key_exchange_algorithm_t *key_share = NULL;+            ptls_cipher_suite_t *cipher_suite = NULL;+            uint32_t max_early_data_size;+            if (decode_stored_session_ticket(tls, &key_share, &cipher_suite, &resumption_secret, &obfuscated_ticket_age,+                                             &resumption_ticket, &max_early_data_size, properties->client.session_ticket.base,+                                             properties->client.session_ticket.base + properties->client.session_ticket.len) == 0) {+                tls->client.offered_psk = 1;+                /* key-share selected by HRR should not be overridden */+                if (tls->key_share == NULL)+                    tls->key_share = key_share;+                tls->cipher_suite = cipher_suite;+                if (!is_second_flight && max_early_data_size != 0 && properties->client.max_early_data_size != NULL) {+                    tls->client.using_early_data = 1;+                    *properties->client.max_early_data_size = max_early_data_size;+                }+            } else {+                resumption_secret = ptls_iovec_init(NULL, 0);+            }+        }+        if (tls->client.using_early_data) {+            properties->client.early_data_acceptance = PTLS_EARLY_DATA_ACCEPTANCE_UNKNOWN;+        } else {+            if (properties->client.max_early_data_size != NULL)+                *properties->client.max_early_data_size = 0;+            properties->client.early_data_acceptance = PTLS_EARLY_DATA_REJECTED;+        }+    }++    /* use the default key share if still not undetermined */+    if (tls->key_share == NULL && !(properties != NULL && properties->client.negotiate_before_key_exchange))+        tls->key_share = tls->ctx->key_exchanges[0];++    if (!is_second_flight) {+        tls->key_schedule = key_schedule_new(tls->cipher_suite, tls->ctx->cipher_suites, tls->ctx->hkdf_label_prefix__obsolete);+        if ((ret = key_schedule_extract(tls->key_schedule, resumption_secret)) != 0)+            goto Exit;+    }++    msghash_off = emitter->buf->off + emitter->record_header_length;+    ptls_push_message(emitter, NULL, PTLS_HANDSHAKE_TYPE_CLIENT_HELLO, {+        ptls_buffer_t *sendbuf = emitter->buf;+        /* legacy_version */+        ptls_buffer_push16(sendbuf, 0x0303);+        /* random_bytes */+        ptls_buffer_pushv(sendbuf, tls->client_random, sizeof(tls->client_random));+        /* lecagy_session_id */+        ptls_buffer_push_block(+            sendbuf, 1, { ptls_buffer_pushv(sendbuf, tls->client.legacy_session_id.base, tls->client.legacy_session_id.len); });+        /* cipher_suites */+        ptls_buffer_push_block(sendbuf, 2, {+            ptls_cipher_suite_t **cs = tls->ctx->cipher_suites;+            for (; *cs != NULL; ++cs)+                ptls_buffer_push16(sendbuf, (*cs)->id);+        });+        /* legacy_compression_methods */+        ptls_buffer_push_block(sendbuf, 1, { ptls_buffer_push(sendbuf, 0); });+        /* extensions */+        ptls_buffer_push_block(sendbuf, 2, {+            struct {+                size_t off;+                size_t len;+            } key_share_client_hello;+            buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_KEY_SHARE, {+                key_share_client_hello.off = sendbuf->off;+                ptls_buffer_push_block(sendbuf, 2, {+                    if (tls->key_share != NULL) {+                        if ((ret = tls->key_share->create(tls->key_share, &tls->client.key_share_ctx)) != 0)+                            goto Exit;+                        if ((ret = push_key_share_entry(sendbuf, tls->key_share->id, tls->client.key_share_ctx->pubkey)) != 0)+                            goto Exit;+                    }+                });+                key_share_client_hello.len = sendbuf->off - key_share_client_hello.off;+            });+            if (send_sni) {+                if (tls->esni != NULL) {+                    if (published_sni != NULL) {+                        buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SERVER_NAME, {+                            if ((ret = emit_server_name_extension(sendbuf, published_sni)) != 0)+                                goto Exit;+                        });+                    }+                    buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_ENCRYPTED_SERVER_NAME, {+                        if ((ret = emit_esni_extension(tls->esni, sendbuf, properties->client.esni_keys, tls->server_name,+                                                       key_share_client_hello.off, key_share_client_hello.len)) != 0)+                            goto Exit;+                    });+                } else {+                    buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SERVER_NAME, {+                        if ((ret = emit_server_name_extension(sendbuf, tls->server_name)) != 0)+                            goto Exit;+                    });+                }+            }+            if (properties != NULL && properties->client.negotiated_protocols.count != 0) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_ALPN, {+                    ptls_buffer_push_block(sendbuf, 2, {+                        size_t i;+                        for (i = 0; i != properties->client.negotiated_protocols.count; ++i) {+                            ptls_buffer_push_block(sendbuf, 1, {+                                ptls_iovec_t p = properties->client.negotiated_protocols.list[i];+                                ptls_buffer_pushv(sendbuf, p.base, p.len);+                            });+                        }+                    });+                });+            }+            if (tls->ctx->decompress_certificate != NULL) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_COMPRESS_CERTIFICATE, {+                    ptls_buffer_push_block(sendbuf, 1, {+                        const uint16_t *algo = tls->ctx->decompress_certificate->supported_algorithms;+                        assert(*algo != UINT16_MAX);+                        for (; *algo != UINT16_MAX; ++algo)+                            ptls_buffer_push16(sendbuf, *algo);+                    });+                });+            }+            buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SUPPORTED_VERSIONS, {+                ptls_buffer_push_block(sendbuf, 1, {+                    size_t i;+                    for (i = 0; i != PTLS_ELEMENTSOF(supported_versions); ++i)+                        ptls_buffer_push16(sendbuf, supported_versions[i]);+                });+            });+            buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SIGNATURE_ALGORITHMS, {+                if ((ret = push_signature_algorithms(tls->ctx->verify_certificate, sendbuf)) != 0)+                    goto Exit;+            });+            buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SUPPORTED_GROUPS, {+                ptls_key_exchange_algorithm_t **algo = tls->ctx->key_exchanges;+                ptls_buffer_push_block(sendbuf, 2, {+                    for (; *algo != NULL; ++algo)+                        ptls_buffer_push16(sendbuf, (*algo)->id);+                });+            });+            if (cookie != NULL && cookie->base != NULL) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_COOKIE, {+                    ptls_buffer_push_block(sendbuf, 2, { ptls_buffer_pushv(sendbuf, cookie->base, cookie->len); });+                });+            }+            if (tls->ctx->use_raw_public_keys) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SERVER_CERTIFICATE_TYPE, {+                    ptls_buffer_push_block(sendbuf, 1, { ptls_buffer_push(sendbuf, PTLS_CERTIFICATE_TYPE_RAW_PUBLIC_KEY); });+                });+            }+            if ((ret = push_additional_extensions(properties, sendbuf)) != 0)+                goto Exit;+            if (tls->ctx->save_ticket != NULL || resumption_secret.base != NULL) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_PSK_KEY_EXCHANGE_MODES, {+                    ptls_buffer_push_block(sendbuf, 1, {+                        if (!tls->ctx->require_dhe_on_psk)+                            ptls_buffer_push(sendbuf, PTLS_PSK_KE_MODE_PSK);+                        ptls_buffer_push(sendbuf, PTLS_PSK_KE_MODE_PSK_DHE);+                    });+                });+            }+            if (resumption_secret.base != NULL) {+                if (tls->client.using_early_data && !is_second_flight)+                    buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_EARLY_DATA, {});+                /* pre-shared key "MUST be the last extension in the ClientHello" (draft-17 section 4.2.6) */+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_PRE_SHARED_KEY, {+                    ptls_buffer_push_block(sendbuf, 2, {+                        ptls_buffer_push_block(sendbuf, 2,+                                               { ptls_buffer_pushv(sendbuf, resumption_ticket.base, resumption_ticket.len); });+                        ptls_buffer_push32(sendbuf, obfuscated_ticket_age);+                    });+                    /* allocate space for PSK binder. the space is filled at the bottom of the function */+                    ptls_buffer_push_block(sendbuf, 2, {+                        ptls_buffer_push_block(sendbuf, 1, {+                            if ((ret = ptls_buffer_reserve(sendbuf, tls->key_schedule->hashes[0].algo->digest_size)) != 0)+                                goto Exit;+                            sendbuf->off += tls->key_schedule->hashes[0].algo->digest_size;+                        });+                    });+                });+            }+        });+    });++    /* update the message hash, filling in the PSK binder HMAC if necessary */+    if (resumption_secret.base != NULL) {+        size_t psk_binder_off = emitter->buf->off - (3 + tls->key_schedule->hashes[0].algo->digest_size);+        if ((ret = derive_secret_with_empty_digest(tls->key_schedule, binder_key, "res binder")) != 0)+            goto Exit;+        ptls__key_schedule_update_hash(tls->key_schedule, emitter->buf->base + msghash_off, psk_binder_off - msghash_off);+        msghash_off = psk_binder_off;+        if ((ret = calc_verify_data(emitter->buf->base + psk_binder_off + 3, tls->key_schedule, binder_key)) != 0)+            goto Exit;+    }+    ptls__key_schedule_update_hash(tls->key_schedule, emitter->buf->base + msghash_off, emitter->buf->off - msghash_off);++    if (tls->client.using_early_data) {+        assert(!is_second_flight);+        if ((ret = setup_traffic_protection(tls, 1, "c e traffic", 1, 0)) != 0)+            goto Exit;+        if ((ret = push_change_cipher_spec(tls, emitter)) != 0)+            goto Exit;+    }+    if (resumption_secret.base != NULL && !is_second_flight) {+        if ((ret = derive_exporter_secret(tls, 1)) != 0)+            goto Exit;+    }+    tls->state = cookie == NULL ? PTLS_STATE_CLIENT_EXPECT_SERVER_HELLO : PTLS_STATE_CLIENT_EXPECT_SECOND_SERVER_HELLO;+    ret = PTLS_ERROR_IN_PROGRESS;++Exit:+    if (published_sni != NULL) {+        free(published_sni);+    }+    ptls_clear_memory(binder_key, sizeof(binder_key));+    return ret;+}++static ptls_cipher_suite_t *find_cipher_suite(ptls_context_t *ctx, uint16_t id)+{+    ptls_cipher_suite_t **cs;++    for (cs = ctx->cipher_suites; *cs != NULL && (*cs)->id != id; ++cs)+        ;+    return *cs;+}++static int decode_server_hello(ptls_t *tls, struct st_ptls_server_hello_t *sh, const uint8_t *src, const uint8_t *const end)+{+    int ret;++    *sh = (struct st_ptls_server_hello_t){{0}};++    /* ignore legacy-version */+    if (end - src < 2) {+        ret = PTLS_ALERT_DECODE_ERROR;+        goto Exit;+    }+    src += 2;++    /* random */+    if (end - src < PTLS_HELLO_RANDOM_SIZE) {+        ret = PTLS_ALERT_DECODE_ERROR;+        goto Exit;+    }+    sh->is_retry_request = memcmp(src, hello_retry_random, PTLS_HELLO_RANDOM_SIZE) == 0;+    src += PTLS_HELLO_RANDOM_SIZE;++    /* legacy_session_id */+    ptls_decode_open_block(src, end, 1, {+        if (end - src > 32) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        sh->legacy_session_id = ptls_iovec_init(src, end - src);+        src = end;+    });++    { /* select cipher_suite */+        uint16_t csid;+        if ((ret = ptls_decode16(&csid, &src, end)) != 0)+            goto Exit;+        if ((tls->cipher_suite = find_cipher_suite(tls->ctx, csid)) == NULL) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+    }++    /* legacy_compression_method */+    if (src == end || *src++ != 0) {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }++    if (sh->is_retry_request)+        sh->retry_request.selected_group = UINT16_MAX;++    uint16_t exttype, found_version = UINT16_MAX, selected_psk_identity = UINT16_MAX;+    decode_extensions(src, end, PTLS_HANDSHAKE_TYPE_SERVER_HELLO, &exttype, {+        if (tls->ctx->on_extension != NULL &&+            (ret = tls->ctx->on_extension->cb(tls->ctx->on_extension, tls, PTLS_HANDSHAKE_TYPE_SERVER_HELLO, exttype,+                                              ptls_iovec_init(src, end - src)) != 0))+            goto Exit;+        switch (exttype) {+        case PTLS_EXTENSION_TYPE_SUPPORTED_VERSIONS:+            if ((ret = ptls_decode16(&found_version, &src, end)) != 0)+                goto Exit;+            break;+        case PTLS_EXTENSION_TYPE_KEY_SHARE:+            if (sh->is_retry_request) {+                if ((ret = ptls_decode16(&sh->retry_request.selected_group, &src, end)) != 0)+                    goto Exit;+            } else {+                uint16_t group;+                if ((ret = decode_key_share_entry(&group, &sh->peerkey, &src, end)) != 0)+                    goto Exit;+                if (src != end) {+                    ret = PTLS_ALERT_DECODE_ERROR;+                    goto Exit;+                }+                if (tls->key_share == NULL || tls->key_share->id != group) {+                    ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                    goto Exit;+                }+            }+            break;+        case PTLS_EXTENSION_TYPE_COOKIE:+            if (sh->is_retry_request) {+                ptls_decode_block(src, end, 2, {+                    if (src == end) {+                        ret = PTLS_ALERT_DECODE_ERROR;+                        goto Exit;+                    }+                    sh->retry_request.cookie = ptls_iovec_init(src, end - src);+                    src = end;+                });+            } else {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            }+            break;+        case PTLS_EXTENSION_TYPE_PRE_SHARED_KEY:+            if (sh->is_retry_request) {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            } else {+                if ((ret = ptls_decode16(&selected_psk_identity, &src, end)) != 0)+                    goto Exit;+            }+            break;+        default:+            src = end;+            break;+        }+    });++    if (!is_supported_version(found_version)) {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }+    if (!sh->is_retry_request) {+        if (selected_psk_identity != UINT16_MAX) {+            if (!tls->client.offered_psk) {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            }+            if (selected_psk_identity != 0) {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            }+            tls->is_psk_handshake = 1;+        }+        if (sh->peerkey.base == NULL && !tls->is_psk_handshake) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+    }++    ret = 0;+Exit:+    return ret;+}++static int handle_hello_retry_request(ptls_t *tls, ptls_message_emitter_t *emitter, struct st_ptls_server_hello_t *sh,+                                      ptls_iovec_t message, ptls_handshake_properties_t *properties)+{+    int ret;++    if (tls->client.key_share_ctx != NULL) {+        tls->client.key_share_ctx->on_exchange(&tls->client.key_share_ctx, 1, NULL, ptls_iovec_init(NULL, 0));+        tls->client.key_share_ctx = NULL;+    }+    if (tls->client.using_early_data) {+        /* release traffic encryption key so that 2nd CH goes out in cleartext, but keep the epoch at 1 since we've already+         * called derive-secret */+        if (tls->ctx->update_traffic_key == NULL) {+            assert(tls->traffic_protection.enc.aead != NULL);+            ptls_aead_free(tls->traffic_protection.enc.aead);+            tls->traffic_protection.enc.aead = NULL;+        }+        tls->client.using_early_data = 0;+    }++    if (sh->retry_request.selected_group != UINT16_MAX) {+        /* we offer the first key_exchanges[0] as KEY_SHARE unless client.negotiate_before_key_exchange is set */+        ptls_key_exchange_algorithm_t **cand;+        for (cand = tls->ctx->key_exchanges; *cand != NULL; ++cand)+            if ((*cand)->id == sh->retry_request.selected_group)+                break;+        if (*cand == NULL) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+        tls->key_share = *cand;+    } else if (tls->key_share != NULL) {+        /* retain the key-share using in first CH, if server does not specify one */+    } else {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }++    key_schedule_transform_post_ch1hash(tls->key_schedule);+    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);+    ret = send_client_hello(tls, emitter, properties, &sh->retry_request.cookie);++Exit:+    return ret;+}++static int client_handle_hello(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_iovec_t message,+                               ptls_handshake_properties_t *properties)+{+    struct st_ptls_server_hello_t sh;+    ptls_iovec_t ecdh_secret = {NULL};+    int ret;++    if ((ret = decode_server_hello(tls, &sh, message.base + PTLS_HANDSHAKE_HEADER_SIZE, message.base + message.len)) != 0)+        goto Exit;+    if (!(sh.legacy_session_id.len == tls->client.legacy_session_id.len &&+          ptls_mem_equal(sh.legacy_session_id.base, tls->client.legacy_session_id.base, tls->client.legacy_session_id.len))) {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }++    if (sh.is_retry_request) {+        if ((ret = key_schedule_select_one(tls->key_schedule, tls->cipher_suite, 0)) != 0)+            goto Exit;+        return handle_hello_retry_request(tls, emitter, &sh, message, properties);+    }++    if ((ret = key_schedule_select_one(tls->key_schedule, tls->cipher_suite, tls->client.offered_psk && !tls->is_psk_handshake)) !=+        0)+        goto Exit;++    if (sh.peerkey.base != NULL) {+        if ((ret = tls->client.key_share_ctx->on_exchange(&tls->client.key_share_ctx, 1, &ecdh_secret, sh.peerkey)) != 0)+            goto Exit;+    }++    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);++    if ((ret = key_schedule_extract(tls->key_schedule, ecdh_secret)) != 0)+        goto Exit;+    if ((ret = setup_traffic_protection(tls, 0, "s hs traffic", 2, 0)) != 0)+        goto Exit;+    if (tls->client.using_early_data) {+        if ((tls->pending_handshake_secret = malloc(PTLS_MAX_DIGEST_SIZE)) == NULL) {+            ret = PTLS_ERROR_NO_MEMORY;+            goto Exit;+        }+        if ((ret = derive_secret(tls->key_schedule, tls->pending_handshake_secret, "c hs traffic")) != 0)+            goto Exit;+        if (tls->ctx->update_traffic_key != NULL &&+            (ret = tls->ctx->update_traffic_key->cb(tls->ctx->update_traffic_key, tls, 1, 2, tls->pending_handshake_secret)) != 0)+            goto Exit;+    } else {+        if ((ret = setup_traffic_protection(tls, 1, "c hs traffic", 2, 0)) != 0)+            goto Exit;+    }++    tls->state = PTLS_STATE_CLIENT_EXPECT_ENCRYPTED_EXTENSIONS;+    ret = PTLS_ERROR_IN_PROGRESS;++Exit:+    if (ecdh_secret.base != NULL) {+        ptls_clear_memory(ecdh_secret.base, ecdh_secret.len);+        free(ecdh_secret.base);+    }+    return ret;+}++static int should_collect_unknown_extension(ptls_t *tls, ptls_handshake_properties_t *properties, uint16_t type)+{+    return properties != NULL && properties->collect_extension != NULL && properties->collect_extension(tls, properties, type);+}++static int collect_unknown_extension(ptls_t *tls, uint16_t type, const uint8_t *src, const uint8_t *const end,+                                     ptls_raw_extension_t *slots)+{+    size_t i;+    for (i = 0; slots[i].type != UINT16_MAX; ++i) {+        assert(i < MAX_UNKNOWN_EXTENSIONS);+        if (slots[i].type == type)+            return PTLS_ALERT_ILLEGAL_PARAMETER;+    }+    if (i < MAX_UNKNOWN_EXTENSIONS) {+        slots[i].type = type;+        slots[i].data = ptls_iovec_init(src, end - src);+        slots[i + 1].type = UINT16_MAX;+    }+    return 0;+}++static int report_unknown_extensions(ptls_t *tls, ptls_handshake_properties_t *properties, ptls_raw_extension_t *slots)+{+    if (properties != NULL && properties->collect_extension != NULL) {+        assert(properties->collected_extensions != NULL);+        return properties->collected_extensions(tls, properties, slots);+    } else {+        return 0;+    }+}++static int client_handle_encrypted_extensions(ptls_t *tls, ptls_iovec_t message, ptls_handshake_properties_t *properties)+{+    const uint8_t *src = message.base + PTLS_HANDSHAKE_HEADER_SIZE, *const end = message.base + message.len, *esni_nonce = NULL;+    uint16_t type;+    static const ptls_raw_extension_t no_unknown_extensions = {UINT16_MAX};+    ptls_raw_extension_t *unknown_extensions = (ptls_raw_extension_t *)&no_unknown_extensions;+    int ret, skip_early_data = 1;+    uint8_t server_offered_cert_type = PTLS_CERTIFICATE_TYPE_X509;++    decode_extensions(src, end, PTLS_HANDSHAKE_TYPE_ENCRYPTED_EXTENSIONS, &type, {+        if (tls->ctx->on_extension != NULL &&+            (ret = tls->ctx->on_extension->cb(tls->ctx->on_extension, tls, PTLS_HANDSHAKE_TYPE_ENCRYPTED_EXTENSIONS, type,+                                              ptls_iovec_init(src, end - src)) != 0))+            goto Exit;+        switch (type) {+        case PTLS_EXTENSION_TYPE_SERVER_NAME:+            if (src != end) {+                ret = PTLS_ALERT_DECODE_ERROR;+                goto Exit;+            }+            if (!(tls->server_name != NULL && !ptls_server_name_is_ipaddr(tls->server_name))) {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            }+            break;+        case PTLS_EXTENSION_TYPE_ENCRYPTED_SERVER_NAME:+            if (*src == PTLS_ESNI_RESPONSE_TYPE_ACCEPT) {+                if (end - src != PTLS_ESNI_NONCE_SIZE + 1) {+                    ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                    goto Exit;+                }+                esni_nonce = src + 1;+            } else {+                /* TODO: provide API to parse the RETRY REQUEST response */+                ret = PTLS_ERROR_ESNI_RETRY;+                goto Exit;+            }+            break;+        case PTLS_EXTENSION_TYPE_ALPN:+            ptls_decode_block(src, end, 2, {+                ptls_decode_open_block(src, end, 1, {+                    if (src == end) {+                        ret = PTLS_ALERT_DECODE_ERROR;+                        goto Exit;+                    }+                    if ((ret = ptls_set_negotiated_protocol(tls, (const char *)src, end - src)) != 0)+                        goto Exit;+                    src = end;+                });+                if (src != end) {+                    ret = PTLS_ALERT_HANDSHAKE_FAILURE;+                    goto Exit;+                }+            });+            break;+        case PTLS_EXTENSION_TYPE_EARLY_DATA:+            if (!tls->client.using_early_data) {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            }+            skip_early_data = 0;+            break;+        case PTLS_EXTENSION_TYPE_SERVER_CERTIFICATE_TYPE:+            if (end - src != 1) {+                ret = PTLS_ALERT_DECODE_ERROR;+                goto Exit;+            }+            server_offered_cert_type = *src;+            src = end;+            break;+        default:+            if (should_collect_unknown_extension(tls, properties, type)) {+                if (unknown_extensions == &no_unknown_extensions) {+                    if ((unknown_extensions = malloc(sizeof(*unknown_extensions) * (MAX_UNKNOWN_EXTENSIONS + 1))) == NULL) {+                        ret = PTLS_ERROR_NO_MEMORY;+                        goto Exit;+                    }+                    unknown_extensions[0].type = UINT16_MAX;+                }+                if ((ret = collect_unknown_extension(tls, type, src, end, unknown_extensions)) != 0)+                    goto Exit;+            }+            break;+        }+        src = end;+    });++    if (server_offered_cert_type !=+        (tls->ctx->use_raw_public_keys ? PTLS_CERTIFICATE_TYPE_RAW_PUBLIC_KEY : PTLS_CERTIFICATE_TYPE_X509)) {+        ret = PTLS_ALERT_UNSUPPORTED_CERTIFICATE;+        goto Exit;+    }++    if (tls->esni != NULL) {+        if (esni_nonce == NULL || !ptls_mem_equal(esni_nonce, tls->esni->nonce, PTLS_ESNI_NONCE_SIZE)) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+        free_esni_secret(&tls->esni, 0);+    } else {+        if (esni_nonce != NULL) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+    }++    if (tls->client.using_early_data) {+        if (skip_early_data)+            tls->client.using_early_data = 0;+        if (properties != NULL)+            properties->client.early_data_acceptance = skip_early_data ? PTLS_EARLY_DATA_REJECTED : PTLS_EARLY_DATA_ACCEPTED;+    }+    if ((ret = report_unknown_extensions(tls, properties, unknown_extensions)) != 0)+        goto Exit;++    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);+    tls->state =+        tls->is_psk_handshake ? PTLS_STATE_CLIENT_EXPECT_FINISHED : PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_REQUEST_OR_CERTIFICATE;+    ret = PTLS_ERROR_IN_PROGRESS;++Exit:+    if (unknown_extensions != &no_unknown_extensions)+        free(unknown_extensions);+    return ret;+}++static int decode_certificate_request(ptls_t *tls, struct st_ptls_certificate_request_t *cr, const uint8_t *src,+                                      const uint8_t *const end)+{+    int ret;+    uint16_t exttype = 0;++    /* certificate request context */+    ptls_decode_open_block(src, end, 1, {+        size_t len = end - src;+        if (len > 255) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        if ((cr->context.base = malloc(len != 0 ? len : 1)) == NULL) {+            ret = PTLS_ERROR_NO_MEMORY;+            goto Exit;+        }+        cr->context.len = len;+        memcpy(cr->context.base, src, len);+        src = end;+    });++    /* decode extensions */+    decode_extensions(src, end, PTLS_HANDSHAKE_TYPE_CERTIFICATE_REQUEST, &exttype, {+        if (tls->ctx->on_extension != NULL &&+            (ret = tls->ctx->on_extension->cb(tls->ctx->on_extension, tls, PTLS_HANDSHAKE_TYPE_CERTIFICATE_REQUEST, exttype,+                                              ptls_iovec_init(src, end - src)) != 0))+            goto Exit;+        switch (exttype) {+        case PTLS_EXTENSION_TYPE_SIGNATURE_ALGORITHMS:+            if ((ret = decode_signature_algorithms(&cr->signature_algorithms, &src, end)) != 0)+                goto Exit;+            break;+        }+        src = end;+    });++    if (cr->signature_algorithms.count == 0) {+        ret = PTLS_ALERT_MISSING_EXTENSION;+        goto Exit;+    }++    ret = 0;+Exit:+    return ret;+}++int ptls_build_certificate_message(ptls_buffer_t *buf, ptls_iovec_t context, ptls_iovec_t *certificates, size_t num_certificates,+                                   ptls_iovec_t ocsp_status)+{+    int ret;++    ptls_buffer_push_block(buf, 1, { ptls_buffer_pushv(buf, context.base, context.len); });+    ptls_buffer_push_block(buf, 3, {+        size_t i;+        for (i = 0; i != num_certificates; ++i) {+            ptls_buffer_push_block(buf, 3, { ptls_buffer_pushv(buf, certificates[i].base, certificates[i].len); });+            ptls_buffer_push_block(buf, 2, {+                if (i == 0 && ocsp_status.len != 0) {+                    buffer_push_extension(buf, PTLS_EXTENSION_TYPE_STATUS_REQUEST, {+                        ptls_buffer_push(buf, 1); /* status_type == ocsp */+                        ptls_buffer_push_block(buf, 3, { ptls_buffer_pushv(buf, ocsp_status.base, ocsp_status.len); });+                    });+                }+            });+        }+    });++    ret = 0;+Exit:+    return ret;+}++static int default_emit_certificate_cb(ptls_emit_certificate_t *_self, ptls_t *tls, ptls_message_emitter_t *emitter,+                                       ptls_key_schedule_t *key_sched, ptls_iovec_t context, int push_status_request,+                                       const uint16_t *compress_algos, size_t num_compress_algos)+{+    int ret;++    ptls_push_message(emitter, key_sched, PTLS_HANDSHAKE_TYPE_CERTIFICATE, {+        if ((ret = ptls_build_certificate_message(emitter->buf, context, tls->ctx->certificates.list, tls->ctx->certificates.count,+                                                  ptls_iovec_init(NULL, 0))) != 0)+            goto Exit;+    });++    ret = 0;+Exit:+    return ret;+}++static int send_certificate_and_certificate_verify(ptls_t *tls, ptls_message_emitter_t *emitter,+                                                   struct st_ptls_signature_algorithms_t *signature_algorithms,+                                                   ptls_iovec_t context, const char *context_string, int push_status_request,+                                                   const uint16_t *compress_algos, size_t num_compress_algos)+{+    int ret;++    if (signature_algorithms->count == 0) {+        ret = PTLS_ALERT_MISSING_EXTENSION;+        goto Exit;+    }++    { /* send Certificate (or the equivalent) */+        static ptls_emit_certificate_t default_emit_certificate = {default_emit_certificate_cb};+        ptls_emit_certificate_t *emit_certificate =+            tls->ctx->emit_certificate != NULL ? tls->ctx->emit_certificate : &default_emit_certificate;+    Redo:+        if ((ret = emit_certificate->cb(emit_certificate, tls, emitter, tls->key_schedule, context, push_status_request,+                                        compress_algos, num_compress_algos)) != 0) {+            if (ret == PTLS_ERROR_DELEGATE) {+                assert(emit_certificate != &default_emit_certificate);+                emit_certificate = &default_emit_certificate;+                goto Redo;+            }+            goto Exit;+        }+    }++    /* build and send CertificateVerify */+    if (tls->ctx->sign_certificate != NULL) {+        ptls_push_message(emitter, tls->key_schedule, PTLS_HANDSHAKE_TYPE_CERTIFICATE_VERIFY, {+            ptls_buffer_t *sendbuf = emitter->buf;+            size_t algo_off = sendbuf->off;+            ptls_buffer_push16(sendbuf, 0); /* filled in later */+            ptls_buffer_push_block(sendbuf, 2, {+                uint16_t algo;+                uint8_t data[PTLS_MAX_CERTIFICATE_VERIFY_SIGNDATA_SIZE];+                size_t datalen = build_certificate_verify_signdata(data, tls->key_schedule, context_string);+                if ((ret = tls->ctx->sign_certificate->cb(tls->ctx->sign_certificate, tls, &algo, sendbuf,+                                                          ptls_iovec_init(data, datalen), signature_algorithms->list,+                                                          signature_algorithms->count)) != 0) {+                    goto Exit;+                }+                sendbuf->base[algo_off] = (uint8_t)(algo >> 8);+                sendbuf->base[algo_off + 1] = (uint8_t)algo;+            });+        });+    }++Exit:+    return ret;+}++static int client_handle_certificate_request(ptls_t *tls, ptls_iovec_t message, ptls_handshake_properties_t *properties)+{+    const uint8_t *src = message.base + PTLS_HANDSHAKE_HEADER_SIZE, *const end = message.base + message.len;+    int ret = 0;++    if ((ret = decode_certificate_request(tls, &tls->client.certificate_request, src, end)) != 0)+        return ret;++    /* This field SHALL be zero length unless used for the post-handshake authentication exchanges (section 4.3.2) */+    if (tls->client.certificate_request.context.len != 0)+        return PTLS_ALERT_ILLEGAL_PARAMETER;++    tls->state = PTLS_STATE_CLIENT_EXPECT_CERTIFICATE;+    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);++    return PTLS_ERROR_IN_PROGRESS;+}++static int handle_certificate(ptls_t *tls, const uint8_t *src, const uint8_t *end, int *got_certs)+{+    ptls_iovec_t certs[16];+    size_t num_certs = 0;+    int ret = 0;++    /* certificate request context */+    ptls_decode_open_block(src, end, 1, {+        if (src != end) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+    });+    /* certificate_list */+    ptls_decode_block(src, end, 3, {+        while (src != end) {+            ptls_decode_open_block(src, end, 3, {+                if (num_certs < PTLS_ELEMENTSOF(certs))+                    certs[num_certs++] = ptls_iovec_init(src, end - src);+                src = end;+            });+            uint16_t type;+            decode_open_extensions(src, end, PTLS_HANDSHAKE_TYPE_CERTIFICATE, &type, {+                if (tls->ctx->on_extension != NULL &&+                    (ret = tls->ctx->on_extension->cb(tls->ctx->on_extension, tls, PTLS_HANDSHAKE_TYPE_CERTIFICATE, type,+                                                      ptls_iovec_init(src, end - src)) != 0))+                    goto Exit;+                src = end;+            });+        }+    });++    if (num_certs != 0 && tls->ctx->verify_certificate != NULL) {+        if ((ret = tls->ctx->verify_certificate->cb(tls->ctx->verify_certificate, tls, &tls->certificate_verify.cb,+                                                    &tls->certificate_verify.verify_ctx, certs, num_certs)) != 0)+            goto Exit;+    }++    *got_certs = num_certs != 0;++Exit:+    return ret;+}++static int client_do_handle_certificate(ptls_t *tls, const uint8_t *src, const uint8_t *end)+{+    int got_certs, ret;++    if ((ret = handle_certificate(tls, src, end, &got_certs)) != 0)+        return ret;+    if (!got_certs)+        return PTLS_ALERT_ILLEGAL_PARAMETER;++    return 0;+}++static int client_handle_certificate(ptls_t *tls, ptls_iovec_t message)+{+    int ret;++    if ((ret = client_do_handle_certificate(tls, message.base + PTLS_HANDSHAKE_HEADER_SIZE, message.base + message.len)) != 0)+        return ret;++    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);++    tls->state = PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_VERIFY;+    return PTLS_ERROR_IN_PROGRESS;+}++static int client_handle_compressed_certificate(ptls_t *tls, ptls_iovec_t message)+{+    const uint8_t *src = message.base + PTLS_HANDSHAKE_HEADER_SIZE, *const end = message.base + message.len;+    uint16_t algo;+    uint32_t uncompressed_size;+    uint8_t *uncompressed = NULL;+    int ret;++    if (tls->ctx->decompress_certificate == NULL) {+        ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        goto Exit;+    }++    /* decode */+    if ((ret = ptls_decode16(&algo, &src, end)) != 0)+        goto Exit;+    if ((ret = ptls_decode24(&uncompressed_size, &src, end)) != 0)+        goto Exit;+    if (uncompressed_size > 65536) { /* TODO find a sensible number */+        ret = PTLS_ALERT_BAD_CERTIFICATE;+        goto Exit;+    }+    if ((uncompressed = malloc(uncompressed_size)) == NULL) {+        ret = PTLS_ERROR_NO_MEMORY;+        goto Exit;+    }+    ptls_decode_block(src, end, 3, {+        if ((ret = tls->ctx->decompress_certificate->cb(tls->ctx->decompress_certificate, tls, algo,+                                                        ptls_iovec_init(uncompressed, uncompressed_size),+                                                        ptls_iovec_init(src, end - src))) != 0)+            goto Exit;+        src = end;+    });++    /* handle */+    if ((ret = client_do_handle_certificate(tls, uncompressed, uncompressed + uncompressed_size)) != 0)+        goto Exit;++    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);+    tls->state = PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_VERIFY;+    ret = PTLS_ERROR_IN_PROGRESS;++Exit:+    free(uncompressed);+    return ret;+}++static int server_handle_certificate(ptls_t *tls, ptls_iovec_t message)+{+    int got_certs, ret;++    if ((ret = handle_certificate(tls, message.base + PTLS_HANDSHAKE_HEADER_SIZE, message.base + message.len, &got_certs)) != 0)+        return ret;+    if (!got_certs)+        return PTLS_ALERT_CERTIFICATE_REQUIRED;++    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);++    tls->state = PTLS_STATE_SERVER_EXPECT_CERTIFICATE_VERIFY;+    return PTLS_ERROR_IN_PROGRESS;+}++static int handle_certificate_verify(ptls_t *tls, ptls_iovec_t message, const char *context_string)+{+    const uint8_t *src = message.base + PTLS_HANDSHAKE_HEADER_SIZE, *const end = message.base + message.len;+    uint16_t algo;+    ptls_iovec_t signature;+    uint8_t signdata[PTLS_MAX_CERTIFICATE_VERIFY_SIGNDATA_SIZE];+    size_t signdata_size;+    int ret;++    /* decode */+    if ((ret = ptls_decode16(&algo, &src, end)) != 0)+        goto Exit;+    ptls_decode_block(src, end, 2, {+        signature = ptls_iovec_init(src, end - src);+        src = end;+    });++    signdata_size = build_certificate_verify_signdata(signdata, tls->key_schedule, context_string);+    if (tls->certificate_verify.cb != NULL) {+        ret = tls->certificate_verify.cb(tls->certificate_verify.verify_ctx, algo, ptls_iovec_init(signdata, signdata_size),+                                         signature);+    } else {+        ret = 0;+    }+    ptls_clear_memory(signdata, signdata_size);+    tls->certificate_verify.cb = NULL;+    if (ret != 0) {+        goto Exit;+    }++    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);++Exit:+    return ret;+}++static int client_handle_certificate_verify(ptls_t *tls, ptls_iovec_t message)+{+    int ret = handle_certificate_verify(tls, message, PTLS_SERVER_CERTIFICATE_VERIFY_CONTEXT_STRING);++    if (ret == 0) {+        tls->state = PTLS_STATE_CLIENT_EXPECT_FINISHED;+        ret = PTLS_ERROR_IN_PROGRESS;+    }++    return ret;+}++static int server_handle_certificate_verify(ptls_t *tls, ptls_iovec_t message)+{+    int ret = handle_certificate_verify(tls, message, PTLS_CLIENT_CERTIFICATE_VERIFY_CONTEXT_STRING);++    if (ret == 0) {+        tls->state = PTLS_STATE_SERVER_EXPECT_FINISHED;+        ret = PTLS_ERROR_IN_PROGRESS;+    }++    return ret;+}++static int client_handle_finished(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_iovec_t message)+{+    uint8_t send_secret[PTLS_MAX_DIGEST_SIZE];+    int ret;++    if ((ret = verify_finished(tls, message)) != 0)+        goto Exit;+    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);++    /* update traffic keys by using messages upto ServerFinished, but commission them after sending ClientFinished */+    if ((ret = key_schedule_extract(tls->key_schedule, ptls_iovec_init(NULL, 0))) != 0)+        goto Exit;+    if ((ret = setup_traffic_protection(tls, 0, "s ap traffic", 3, 0)) != 0)+        goto Exit;+    if ((ret = derive_secret(tls->key_schedule, send_secret, "c ap traffic")) != 0)+        goto Exit;+    if ((ret = derive_exporter_secret(tls, 0)) != 0)+        goto Exit;++    /* if sending early data, emit EOED and commision the client handshake traffic secret */+    if (tls->pending_handshake_secret != NULL) {+        assert(tls->traffic_protection.enc.aead != NULL || tls->ctx->update_traffic_key != NULL);+        if (tls->client.using_early_data && !tls->ctx->omit_end_of_early_data)+            ptls_push_message(emitter, tls->key_schedule, PTLS_HANDSHAKE_TYPE_END_OF_EARLY_DATA, {});+        tls->client.using_early_data = 0;+        if ((ret = commission_handshake_secret(tls)) != 0)+            goto Exit;+    }++    if ((ret = push_change_cipher_spec(tls, emitter)) != 0)+        goto Exit;++    if (tls->client.certificate_request.context.base != NULL) {+        /* If this is a resumed session, the server must not send the certificate request in the handshake */+        if (tls->is_psk_handshake) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+        ret = send_certificate_and_certificate_verify(tls, emitter, &tls->client.certificate_request.signature_algorithms,+                                                      tls->client.certificate_request.context,+                                                      PTLS_CLIENT_CERTIFICATE_VERIFY_CONTEXT_STRING, 0, NULL, 0);+        free(tls->client.certificate_request.context.base);+        tls->client.certificate_request.context = ptls_iovec_init(NULL, 0);+        if (ret != 0)+            goto Exit;+    }++    ret = send_finished(tls, emitter);++    memcpy(tls->traffic_protection.enc.secret, send_secret, sizeof(send_secret));+    if ((ret = setup_traffic_protection(tls, 1, NULL, 3, 0)) != 0)+        goto Exit;++    tls->state = PTLS_STATE_CLIENT_POST_HANDSHAKE;++Exit:+    ptls_clear_memory(send_secret, sizeof(send_secret));+    return ret;+}++static int client_handle_new_session_ticket(ptls_t *tls, ptls_iovec_t message)+{+    const uint8_t *src = message.base + PTLS_HANDSHAKE_HEADER_SIZE, *const end = message.base + message.len;+    ptls_iovec_t ticket_nonce;+    int ret;++    { /* verify the format */+        uint32_t ticket_lifetime, ticket_age_add, max_early_data_size;+        ptls_iovec_t ticket;+        if ((ret = decode_new_session_ticket(tls, &ticket_lifetime, &ticket_age_add, &ticket_nonce, &ticket, &max_early_data_size,+                                             src, end)) != 0)+            return ret;+    }++    /* do nothing if use of session ticket is disabled */+    if (tls->ctx->save_ticket == NULL)+        return 0;++    /* save the extension, along with the key of myself */+    ptls_buffer_t ticket_buf;+    ptls_buffer_init(&ticket_buf, "", 0);+    ptls_buffer_push64(&ticket_buf, tls->ctx->get_time->cb(tls->ctx->get_time));+    ptls_buffer_push16(&ticket_buf, tls->key_share->id);+    ptls_buffer_push16(&ticket_buf, tls->cipher_suite->id);+    ptls_buffer_push_block(&ticket_buf, 3, { ptls_buffer_pushv(&ticket_buf, src, end - src); });+    ptls_buffer_push_block(&ticket_buf, 2, {+        if ((ret = ptls_buffer_reserve(&ticket_buf, tls->key_schedule->hashes[0].algo->digest_size)) != 0)+            goto Exit;+        if ((ret = derive_resumption_secret(tls->key_schedule, ticket_buf.base + ticket_buf.off, ticket_nonce)) != 0)+            goto Exit;+        ticket_buf.off += tls->key_schedule->hashes[0].algo->digest_size;+    });++    if ((ret = tls->ctx->save_ticket->cb(tls->ctx->save_ticket, tls, ptls_iovec_init(ticket_buf.base, ticket_buf.off))) != 0)+        goto Exit;++    ret = 0;+Exit:+    ptls_buffer_dispose(&ticket_buf);+    return ret;+}++static int client_hello_decode_server_name(ptls_iovec_t *name, const uint8_t **src, const uint8_t *const end)+{+    int ret = 0;++    ptls_decode_open_block(*src, end, 2, {+        if (*src == end) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        do {+            uint8_t type = *(*src)++;+            ptls_decode_open_block(*src, end, 2, {+                switch (type) {+                case PTLS_SERVER_NAME_TYPE_HOSTNAME:+                    if (memchr(*src, '\0', end - *src) != 0) {+                        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                        goto Exit;+                    }+                    *name = ptls_iovec_init(*src, end - *src);+                    break;+                default:+                    break;+                }+                *src = end;+            });+        } while (*src != end);+    });++Exit:+    return ret;+}++static int client_hello_decrypt_esni(ptls_context_t *ctx, ptls_iovec_t *server_name, ptls_esni_secret_t **secret,+                                     struct st_ptls_client_hello_t *ch)+{+    ptls_esni_context_t **esni;+    ptls_key_exchange_context_t **key_share_ctx;+    uint8_t *decrypted = NULL;+    ptls_aead_context_t *aead = NULL;+    int ret;++    /* allocate secret */+    assert(*secret == NULL);+    if ((*secret = malloc(sizeof(**secret))) == NULL)+        return PTLS_ERROR_NO_MEMORY;+    memset(*secret, 0, sizeof(**secret));++    /* find the matching esni structure */+    for (esni = ctx->esni; *esni != NULL; ++esni) {+        size_t i;+        for (i = 0; (*esni)->cipher_suites[i].cipher_suite != NULL; ++i)+            if ((*esni)->cipher_suites[i].cipher_suite->id == ch->esni.cipher->id)+                break;+        if ((*esni)->cipher_suites[i].cipher_suite == NULL) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+        if (memcmp((*esni)->cipher_suites[i].record_digest, ch->esni.record_digest, ch->esni.cipher->hash->digest_size) == 0) {+            (*secret)->version = (*esni)->version;+            break;+        }+    }+    if (*esni == NULL) {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }++    /* find the matching private key for ESNI decryption */+    for (key_share_ctx = (*esni)->key_exchanges; *key_share_ctx != NULL; ++key_share_ctx)+        if ((*key_share_ctx)->algo->id == ch->esni.key_share->id)+            break;+    if (*key_share_ctx == NULL) {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }++    /* calculate ESNIContents */+    if ((ret = build_esni_contents_hash(ch->esni.cipher->hash, (*secret)->esni_contents_hash, ch->esni.record_digest,+                                        ch->esni.key_share->id, ch->esni.peer_key, ch->random_bytes)) != 0)+        goto Exit;+    /* derive the shared secret */+    if ((ret = (*key_share_ctx)->on_exchange(key_share_ctx, 0, &(*secret)->secret, ch->esni.peer_key)) != 0)+        goto Exit;+    /* decrypt */+    if (ch->esni.encrypted_sni.len - ch->esni.cipher->aead->tag_size != (*esni)->padded_length + PTLS_ESNI_NONCE_SIZE) {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }+    if ((decrypted = malloc((*esni)->padded_length + PTLS_ESNI_NONCE_SIZE)) == NULL) {+        ret = PTLS_ERROR_NO_MEMORY;+        goto Exit;+    }+    if ((ret = create_esni_aead(&aead, 0, ch->esni.cipher, (*secret)->secret, (*secret)->esni_contents_hash)) != 0)+        goto Exit;+    if (ptls_aead_decrypt(aead, decrypted, ch->esni.encrypted_sni.base, ch->esni.encrypted_sni.len, 0, ch->key_shares.base,+                          ch->key_shares.len) != (*esni)->padded_length + PTLS_ESNI_NONCE_SIZE) {+        ret = PTLS_ALERT_DECRYPT_ERROR;+        goto Exit;+    }+    ptls_aead_free(aead);+    aead = NULL;++    { /* decode sni */+        const uint8_t *src = decrypted, *const end = src + (*esni)->padded_length;+        ptls_iovec_t found_name;+        if (end - src < PTLS_ESNI_NONCE_SIZE) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+        memcpy((*secret)->nonce, src, PTLS_ESNI_NONCE_SIZE);+        src += PTLS_ESNI_NONCE_SIZE;+        if ((ret = client_hello_decode_server_name(&found_name, &src, end)) != 0)+            goto Exit;+        for (; src != end; ++src) {+            if (*src != '\0') {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            }+        }+        /* if successful, reuse memory allocated for padded_server_name for storing the found name (freed by the caller) */+        memmove(decrypted, found_name.base, found_name.len);+        *server_name = ptls_iovec_init(decrypted, found_name.len);+        decrypted = NULL;+    }++    ret = 0;+Exit:+    if (decrypted != NULL)+        free(decrypted);+    if (aead != NULL)+        ptls_aead_free(aead);+    if (ret != 0 && *secret != NULL)+        free_esni_secret(secret, 1);+    return ret;+}++static int select_negotiated_group(ptls_key_exchange_algorithm_t **selected, ptls_key_exchange_algorithm_t **candidates,+                                   const uint8_t *src, const uint8_t *const end)+{+    int ret;++    ptls_decode_block(src, end, 2, {+        while (src != end) {+            uint16_t group;+            if ((ret = ptls_decode16(&group, &src, end)) != 0)+                goto Exit;+            ptls_key_exchange_algorithm_t **c = candidates;+            for (; *c != NULL; ++c) {+                if ((*c)->id == group) {+                    *selected = *c;+                    return 0;+                }+            }+        }+    });++    ret = PTLS_ALERT_HANDSHAKE_FAILURE;++Exit:+    return ret;+}++static int decode_client_hello(ptls_t *tls, struct st_ptls_client_hello_t *ch, const uint8_t *src, const uint8_t *const end,+                               ptls_handshake_properties_t *properties)+{+    uint16_t exttype = 0;+    int ret;++    /* decode protocol version (do not bare to decode something older than TLS 1.0) */+    if ((ret = ptls_decode16(&ch->legacy_version, &src, end)) != 0)+        goto Exit;+    if (ch->legacy_version < 0x0301) {+        ret = PTLS_ALERT_PROTOCOL_VERSION;+        goto Exit;+    }++    /* skip random */+    if (end - src < PTLS_HELLO_RANDOM_SIZE) {+        ret = PTLS_ALERT_DECODE_ERROR;+        goto Exit;+    }+    ch->random_bytes = src;+    src += PTLS_HELLO_RANDOM_SIZE;++    /* skip legacy_session_id */+    ptls_decode_open_block(src, end, 1, {+        if (end - src > 32) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        ch->legacy_session_id = ptls_iovec_init(src, end - src);+        src = end;+    });++    /* decode and select from ciphersuites */+    ptls_decode_open_block(src, end, 2, {+        ch->cipher_suites = ptls_iovec_init(src, end - src);+        uint16_t *id = ch->client_ciphers.list;+        do {+            if ((ret = ptls_decode16(id, &src, end)) != 0)+                goto Exit;+            id++;+            ch->client_ciphers.count++;+            if (id >= ch->client_ciphers.list + MAX_CLIENT_CIPHERS) {+                src = end;+                break;+            }+        } while (src != end);+    });++    /* decode legacy_compression_methods */+    ptls_decode_open_block(src, end, 1, {+        if (src == end) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        ch->compression_methods.ids = src;+        ch->compression_methods.count = end - src;+        src = end;+    });++    /* decode extensions */+    decode_extensions(src, end, PTLS_HANDSHAKE_TYPE_CLIENT_HELLO, &exttype, {+        ch->psk.is_last_extension = 0;+        if (tls->ctx->on_extension != NULL &&+            (ret = tls->ctx->on_extension->cb(tls->ctx->on_extension, tls, PTLS_HANDSHAKE_TYPE_CLIENT_HELLO, exttype,+                                              ptls_iovec_init(src, end - src)) != 0))+            goto Exit;+        switch (exttype) {+        case PTLS_EXTENSION_TYPE_SERVER_NAME:+            if ((ret = client_hello_decode_server_name(&ch->server_name, &src, end)) != 0)+                goto Exit;+            if (src != end) {+                ret = PTLS_ALERT_DECODE_ERROR;+                goto Exit;+            }+            break;+        case PTLS_EXTENSION_TYPE_ENCRYPTED_SERVER_NAME: {+            ptls_cipher_suite_t **cipher;+            if (ch->esni.cipher != NULL) {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            }+            { /* cipher-suite */+                uint16_t csid;+                if ((ret = ptls_decode16(&csid, &src, end)) != 0)+                    goto Exit;+                for (cipher = tls->ctx->cipher_suites; *cipher != NULL; ++cipher)+                    if ((*cipher)->id == csid)+                        break;+                if (*cipher == NULL) {+                    ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                    goto Exit;+                }+            }+            /* key-share (including peer-key) */+            if ((ret = select_key_share(&ch->esni.key_share, &ch->esni.peer_key, tls->ctx->key_exchanges, &src, end, 1)) != 0)+                goto Exit;+            ptls_decode_open_block(src, end, 2, {+                size_t len = end - src;+                if (len != (*cipher)->hash->digest_size) {+                    ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                    goto Exit;+                }+                ch->esni.record_digest = src;+                src += len;+            });+            ptls_decode_block(src, end, 2, {+                size_t len = end - src;+                if (len < (*cipher)->aead->tag_size) {+                    ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                    goto Exit;+                }+                ch->esni.encrypted_sni = ptls_iovec_init(src, len);+                src += len;+            });+            ch->esni.cipher = *cipher; /* set only after successful parsing */+        } break;+        case PTLS_EXTENSION_TYPE_ALPN:+            ptls_decode_block(src, end, 2, {+                do {+                    ptls_decode_open_block(src, end, 1, {+                        /* rfc7301 3.1: empty strings MUST NOT be included */+                        if (src == end) {+                            ret = PTLS_ALERT_DECODE_ERROR;+                            goto Exit;+                        }+                        if (ch->alpn.count < PTLS_ELEMENTSOF(ch->alpn.list))+                            ch->alpn.list[ch->alpn.count++] = ptls_iovec_init(src, end - src);+                        src = end;+                    });+                } while (src != end);+            });+            break;+        case PTLS_EXTENSION_TYPE_SERVER_CERTIFICATE_TYPE:+            ptls_decode_block(src, end, 1, {+                size_t list_size = end - src;++                /* RFC7250 4.1: No empty list, no list with single x509 element */+                if (list_size == 0 || (list_size == 1 && *src == PTLS_CERTIFICATE_TYPE_X509)) {+                    ret = PTLS_ALERT_DECODE_ERROR;+                    goto Exit;+                }++                do {+                    if (ch->server_certificate_types.count < PTLS_ELEMENTSOF(ch->server_certificate_types.list))+                        ch->server_certificate_types.list[ch->server_certificate_types.count++] = *src;+                    src++;+                } while (src != end);+            });+            break;+        case PTLS_EXTENSION_TYPE_COMPRESS_CERTIFICATE:+            ptls_decode_block(src, end, 1, {+                do {+                    uint16_t id;+                    if ((ret = ptls_decode16(&id, &src, end)) != 0)+                        goto Exit;+                    if (ch->cert_compression_algos.count < PTLS_ELEMENTSOF(ch->cert_compression_algos.list))+                        ch->cert_compression_algos.list[ch->cert_compression_algos.count++] = id;+                } while (src != end);+            });+            break;+        case PTLS_EXTENSION_TYPE_SUPPORTED_GROUPS:+            ch->negotiated_groups = ptls_iovec_init(src, end - src);+            break;+        case PTLS_EXTENSION_TYPE_SIGNATURE_ALGORITHMS:+            if ((ret = decode_signature_algorithms(&ch->signature_algorithms, &src, end)) != 0)+                goto Exit;+            break;+        case PTLS_EXTENSION_TYPE_KEY_SHARE:+            ch->key_shares = ptls_iovec_init(src, end - src);+            break;+        case PTLS_EXTENSION_TYPE_SUPPORTED_VERSIONS:+            ptls_decode_block(src, end, 1, {+                size_t selected_index = PTLS_ELEMENTSOF(supported_versions);+                do {+                    size_t i;+                    uint16_t v;+                    if ((ret = ptls_decode16(&v, &src, end)) != 0)+                        goto Exit;+                    for (i = 0; i != selected_index; ++i) {+                        if (supported_versions[i] == v) {+                            selected_index = i;+                            break;+                        }+                    }+                } while (src != end);+                if (selected_index != PTLS_ELEMENTSOF(supported_versions))+                    ch->selected_version = supported_versions[selected_index];+            });+            break;+        case PTLS_EXTENSION_TYPE_COOKIE:+            if (properties == NULL || properties->server.cookie.key == NULL) {+                ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                goto Exit;+            }+            ch->cookie.all = ptls_iovec_init(src, end - src);+            ptls_decode_block(src, end, 2, {+                ch->cookie.tbs.base = (void *)src;+                ptls_decode_open_block(src, end, 2, {+                    ptls_decode_open_block(src, end, 1, {+                        ch->cookie.ch1_hash = ptls_iovec_init(src, end - src);+                        src = end;+                    });+                    if (src == end) {+                        ret = PTLS_ALERT_DECODE_ERROR;+                        goto Exit;+                    }+                    switch (*src++) {+                    case 0:+                        assert(!ch->cookie.sent_key_share);+                        break;+                    case 1:+                        ch->cookie.sent_key_share = 1;+                        break;+                    default:+                        ret = PTLS_ALERT_DECODE_ERROR;+                        goto Exit;+                    }+                });+                ch->cookie.tbs.len = src - ch->cookie.tbs.base;+                ptls_decode_block(src, end, 1, {+                    ch->cookie.signature = ptls_iovec_init(src, end - src);+                    src = end;+                });+            });+            break;+        case PTLS_EXTENSION_TYPE_PRE_SHARED_KEY: {+            size_t num_identities = 0;+            ptls_decode_open_block(src, end, 2, {+                do {+                    struct st_ptls_client_hello_psk_t psk = {{NULL}};+                    ptls_decode_open_block(src, end, 2, {+                        psk.identity = ptls_iovec_init(src, end - src);+                        src = end;+                    });+                    if ((ret = ptls_decode32(&psk.obfuscated_ticket_age, &src, end)) != 0)+                        goto Exit;+                    if (ch->psk.identities.count < PTLS_ELEMENTSOF(ch->psk.identities.list))+                        ch->psk.identities.list[ch->psk.identities.count++] = psk;+                    ++num_identities;+                } while (src != end);+            });+            ch->psk.hash_end = src;+            ptls_decode_block(src, end, 2, {+                size_t num_binders = 0;+                do {+                    ptls_decode_open_block(src, end, 1, {+                        if (num_binders < ch->psk.identities.count)+                            ch->psk.identities.list[num_binders].binder = ptls_iovec_init(src, end - src);+                        src = end;+                    });+                    ++num_binders;+                } while (src != end);+                if (num_identities != num_binders) {+                    ret = PTLS_ALERT_ILLEGAL_PARAMETER;+                    goto Exit;+                }+            });+            ch->psk.is_last_extension = 1;+        } break;+        case PTLS_EXTENSION_TYPE_PSK_KEY_EXCHANGE_MODES:+            ptls_decode_block(src, end, 1, {+                if (src == end) {+                    ret = PTLS_ALERT_DECODE_ERROR;+                    goto Exit;+                }+                for (; src != end; ++src) {+                    if (*src < sizeof(ch->psk.ke_modes) * 8)+                        ch->psk.ke_modes |= 1u << *src;+                }+            });+            break;+        case PTLS_EXTENSION_TYPE_EARLY_DATA:+            ch->psk.early_data_indication = 1;+            break;+        case PTLS_EXTENSION_TYPE_STATUS_REQUEST:+            ch->status_request = 1;+            break;+        default:+            if (should_collect_unknown_extension(tls, properties, exttype)) {+                if ((ret = collect_unknown_extension(tls, exttype, src, end, ch->unknown_extensions)) != 0)+                    goto Exit;+            }+            break;+        }+        src = end;+    });++    ret = 0;+Exit:+    return ret;+}++static int vec_is_string(ptls_iovec_t x, const char *y)+{+    return strncmp((const char *)x.base, y, x.len) == 0 && y[x.len] == '\0';+}++static int try_psk_handshake(ptls_t *tls, size_t *psk_index, int *accept_early_data, struct st_ptls_client_hello_t *ch,+                             ptls_iovec_t ch_trunc)+{+    ptls_buffer_t decbuf;+    ptls_iovec_t ticket_psk, ticket_server_name, ticket_negotiated_protocol;+    uint64_t issue_at, now = tls->ctx->get_time->cb(tls->ctx->get_time);+    uint32_t age_add;+    uint16_t ticket_key_exchange_id, ticket_csid;+    uint8_t binder_key[PTLS_MAX_DIGEST_SIZE];+    int ret;++    ptls_buffer_init(&decbuf, "", 0);++    for (*psk_index = 0; *psk_index < ch->psk.identities.count; ++*psk_index) {+        struct st_ptls_client_hello_psk_t *identity = ch->psk.identities.list + *psk_index;+        /* decrypt and decode */+        int can_accept_early_data = 1;+        decbuf.off = 0;+        switch (tls->ctx->encrypt_ticket->cb(tls->ctx->encrypt_ticket, tls, 0, &decbuf, identity->identity)) {+        case 0: /* decrypted */+            break;+        case PTLS_ERROR_REJECT_EARLY_DATA: /* decrypted, but early data is rejected */+            can_accept_early_data = 0;+            break;+        default: /* decryption failure */+            continue;+        }+        if (decode_session_identifier(&issue_at, &ticket_psk, &age_add, &ticket_server_name, &ticket_key_exchange_id, &ticket_csid,+                                      &ticket_negotiated_protocol, decbuf.base, decbuf.base + decbuf.off) != 0)+            continue;+        /* check age */+        if (now < issue_at)+            continue;+        if (now - issue_at > (uint64_t)tls->ctx->ticket_lifetime * 1000)+            continue;+        *accept_early_data = 0;+        if (ch->psk.early_data_indication && can_accept_early_data) {+            /* accept early-data if abs(diff) between the reported age and the actual age is within += 10 seconds */+            int64_t delta = (now - issue_at) - (identity->obfuscated_ticket_age - age_add);+            if (delta < 0)+                delta = -delta;+            if (tls->ctx->max_early_data_size != 0 && delta <= PTLS_EARLY_DATA_MAX_DELAY)+                *accept_early_data = 1;+        }+        /* check server-name */+        if (ticket_server_name.len != 0) {+            if (tls->server_name == NULL)+                continue;+            if (!vec_is_string(ticket_server_name, tls->server_name))+                continue;+        } else {+            if (tls->server_name != NULL)+                continue;+        }+        { /* check key-exchange */+            ptls_key_exchange_algorithm_t **a;+            for (a = tls->ctx->key_exchanges; *a != NULL && (*a)->id != ticket_key_exchange_id; ++a)+                ;+            if (*a == NULL)+                continue;+            tls->key_share = *a;+        }+        /* check cipher-suite */+        if (ticket_csid != tls->cipher_suite->id)+            continue;+        /* check negotiated-protocol */+        if (ticket_negotiated_protocol.len != 0) {+            if (tls->negotiated_protocol == NULL)+                continue;+            if (!vec_is_string(ticket_negotiated_protocol, tls->negotiated_protocol))+                continue;+        }+        /* check the length of the decrypted psk and the PSK binder */+        if (ticket_psk.len != tls->key_schedule->hashes[0].algo->digest_size)+            continue;+        if (ch->psk.identities.list[*psk_index].binder.len != tls->key_schedule->hashes[0].algo->digest_size)+            continue;++        /* found */+        goto Found;+    }++    /* not found */+    *psk_index = SIZE_MAX;+    *accept_early_data = 0;+    tls->key_share = NULL;+    ret = 0;+    goto Exit;++Found:+    if ((ret = key_schedule_extract(tls->key_schedule, ticket_psk)) != 0)+        goto Exit;+    if ((ret = derive_secret(tls->key_schedule, binder_key, "res binder")) != 0)+        goto Exit;+    ptls__key_schedule_update_hash(tls->key_schedule, ch_trunc.base, ch_trunc.len);+    if ((ret = calc_verify_data(binder_key /* to conserve space, reuse binder_key for storing verify_data */, tls->key_schedule,+                                binder_key)) != 0)+        goto Exit;+    if (!ptls_mem_equal(ch->psk.identities.list[*psk_index].binder.base, binder_key,+                        tls->key_schedule->hashes[0].algo->digest_size)) {+        ret = PTLS_ALERT_DECRYPT_ERROR;+        goto Exit;+    }+    ret = 0;++Exit:+    ptls_buffer_dispose(&decbuf);+    ptls_clear_memory(binder_key, sizeof(binder_key));+    return ret;+}++static int calc_cookie_signature(ptls_t *tls, ptls_handshake_properties_t *properties,+                                 ptls_key_exchange_algorithm_t *negotiated_group, ptls_iovec_t tbs, uint8_t *sig)+{+    ptls_hash_algorithm_t *algo = tls->ctx->cipher_suites[0]->hash;+    ptls_hash_context_t *hctx;++    if ((hctx = ptls_hmac_create(algo, properties->server.cookie.key, algo->digest_size)) == NULL)+        return PTLS_ERROR_NO_MEMORY;++#define UPDATE_BLOCK(p, _len)                                                                                                      \+    do {                                                                                                                           \+        size_t len = (_len);                                                                                                       \+        assert(len < UINT8_MAX);                                                                                                   \+        uint8_t len8 = (uint8_t)len;                                                                                               \+        hctx->update(hctx, &len8, 1);                                                                                              \+        hctx->update(hctx, (p), len);                                                                                              \+    } while (0)+#define UPDATE16(_v)                                                                                                               \+    do {                                                                                                                           \+        uint16_t v = (_v);                                                                                                         \+        uint8_t b[2] = {v >> 8, v & 0xff};                                                                                         \+        hctx->update(hctx, b, 2);                                                                                                  \+    } while (0)++    UPDATE_BLOCK(tls->client_random, sizeof(tls->client_random));+    UPDATE_BLOCK(tls->server_name, tls->server_name != NULL ? strlen(tls->server_name) : 0);+    UPDATE16(tls->cipher_suite->id);+    UPDATE16(negotiated_group->id);+    UPDATE_BLOCK(properties->server.cookie.additional_data.base, properties->server.cookie.additional_data.len);++    UPDATE_BLOCK(tbs.base, tbs.len);++#undef UPDATE_BLOCK+#undef UPDATE16++    hctx->final(hctx, sig, PTLS_HASH_FINAL_MODE_FREE);+    return 0;+}++static int certificate_type_exists(uint8_t *list, size_t count, uint8_t desired_type)+{+    /* empty type list means that we default to x509 */+    if (desired_type == PTLS_CERTIFICATE_TYPE_X509 && count == 0)+        return 1;+    for (size_t i = 0; i < count; i++) {+        if (list[i] == desired_type)+            return 1;+    }+    return 0;+}++static int server_handle_hello(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_iovec_t message,+                               ptls_handshake_properties_t *properties)+{+#define EMIT_SERVER_HELLO(sched, fill_rand, extensions)                                                                            \+    ptls_push_message(emitter, (sched), PTLS_HANDSHAKE_TYPE_SERVER_HELLO, {                                                        \+        ptls_buffer_push16(emitter->buf, 0x0303 /* legacy version */);                                                             \+        if ((ret = ptls_buffer_reserve(emitter->buf, PTLS_HELLO_RANDOM_SIZE)) != 0)                                                \+            goto Exit;                                                                                                             \+        do {                                                                                                                       \+            fill_rand                                                                                                              \+        } while (0);                                                                                                               \+        emitter->buf->off += PTLS_HELLO_RANDOM_SIZE;                                                                               \+        ptls_buffer_push_block(emitter->buf, 1,                                                                                    \+                               { ptls_buffer_pushv(emitter->buf, ch->legacy_session_id.base, ch->legacy_session_id.len); });       \+        ptls_buffer_push16(emitter->buf, tls->cipher_suite->id);                                                                   \+        ptls_buffer_push(emitter->buf, 0);                                                                                         \+        ptls_buffer_push_block(emitter->buf, 2, {                                                                                  \+            buffer_push_extension(emitter->buf, PTLS_EXTENSION_TYPE_SUPPORTED_VERSIONS,                                            \+                                  { ptls_buffer_push16(emitter->buf, ch->selected_version); });                                    \+            do {                                                                                                                   \+                extensions                                                                                                         \+            } while (0);                                                                                                           \+        });                                                                                                                        \+    });++#define EMIT_HELLO_RETRY_REQUEST(sched, negotiated_group, additional_extensions)                                                   \+    EMIT_SERVER_HELLO((sched), { memcpy(emitter->buf->base + emitter->buf->off, hello_retry_random, PTLS_HELLO_RANDOM_SIZE); },    \+                      {                                                                                                            \+                          ptls_key_exchange_algorithm_t *_negotiated_group = (negotiated_group);                                   \+                          if (_negotiated_group != NULL) {                                                                         \+                              buffer_push_extension(emitter->buf, PTLS_EXTENSION_TYPE_KEY_SHARE,                                   \+                                                    { ptls_buffer_push16(emitter->buf, _negotiated_group->id); });                 \+                          }                                                                                                        \+                          do {                                                                                                     \+                              additional_extensions                                                                                \+                          } while (0);                                                                                             \+                      })+    struct st_ptls_client_hello_t *ch;+    struct {+        ptls_key_exchange_algorithm_t *algorithm;+        ptls_iovec_t peer_key;+    } key_share = {NULL};+    enum { HANDSHAKE_MODE_FULL, HANDSHAKE_MODE_PSK, HANDSHAKE_MODE_PSK_DHE } mode;+    size_t psk_index = SIZE_MAX;+    ptls_iovec_t pubkey = {0}, ecdh_secret = {0};+    int accept_early_data = 0, is_second_flight = tls->state == PTLS_STATE_SERVER_EXPECT_SECOND_CLIENT_HELLO, ret;++    if ((ch = malloc(sizeof(*ch))) == NULL) {+        ret = PTLS_ERROR_NO_MEMORY;+        goto Exit;+    }++    *ch = (struct st_ptls_client_hello_t){0,      NULL,   {NULL},     {NULL}, 0,     {NULL},   {NULL}, {NULL}, {{0}},+                                          {NULL}, {NULL}, {{{NULL}}}, {{0}},  {{0}}, {{NULL}}, {NULL}, {{0}},  {{UINT16_MAX}}};++    /* decode ClientHello */+    if ((ret = decode_client_hello(tls, ch, message.base + PTLS_HANDSHAKE_HEADER_SIZE, message.base + message.len, properties)) !=+        0)+        goto Exit;++    /* bail out if CH cannot be handled as TLS 1.3, providing the application the raw CH and SNI, to help them fallback */+    if (!is_supported_version(ch->selected_version)) {+        if (!is_second_flight && tls->ctx->on_client_hello != NULL) {+            ptls_on_client_hello_parameters_t params = {+                .server_name = ch->server_name,+                .raw_message = message,+                .negotiated_protocols = {ch->alpn.list, ch->alpn.count},+                .incompatible_version = 1,+            };+            if ((ret = tls->ctx->on_client_hello->cb(tls->ctx->on_client_hello, tls, &params)) != 0)+                goto Exit;+        }+        ret = PTLS_ALERT_PROTOCOL_VERSION;+        goto Exit;+    }++    /* Check TLS 1.3-specific constraints. Hereafter, we might exit without calling on_client_hello. That's fine because this CH is+     * ought to be rejected. */+    if (ch->legacy_version <= 0x0300) {+        /* RFC 8446 Appendix D.5: any endpoint receiving a Hello message with legacy_version set to 0x0300 MUST abort the handshake+         * with a "protocol_version" alert. */+        ret = PTLS_ALERT_PROTOCOL_VERSION;+        goto Exit;+    }+    if (!(ch->compression_methods.count == 1 && ch->compression_methods.ids[0] == 0)) {+        ret = PTLS_ALERT_ILLEGAL_PARAMETER;+        goto Exit;+    }+    /* esni */+    if (ch->esni.cipher != NULL) {+        if (ch->key_shares.base == NULL) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+    }+    /* pre-shared key */+    if (ch->psk.hash_end != NULL) {+        /* PSK must be the last extension */+        if (!ch->psk.is_last_extension) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+    } else {+        if (ch->psk.early_data_indication) {+            ret = PTLS_ALERT_ILLEGAL_PARAMETER;+            goto Exit;+        }+    }++    if (tls->ctx->require_dhe_on_psk)+        ch->psk.ke_modes &= ~(1u << PTLS_PSK_KE_MODE_PSK);++    /* handle client_random, legacy_session_id, SNI, ESNI */+    if (!is_second_flight) {+        memcpy(tls->client_random, ch->random_bytes, sizeof(tls->client_random));+        log_client_random(tls);+        if (ch->legacy_session_id.len != 0)+            tls->send_change_cipher_spec = 1;+        ptls_iovec_t server_name = {NULL};+        int is_esni = 0;+        if (ch->esni.cipher != NULL && tls->ctx->esni != NULL) {+            if ((ret = client_hello_decrypt_esni(tls->ctx, &server_name, &tls->esni, ch)) != 0)+                goto Exit;+            if (tls->ctx->update_esni_key != NULL) {+                if ((ret = tls->ctx->update_esni_key->cb(tls->ctx->update_esni_key, tls, tls->esni->secret, ch->esni.cipher->hash,+                                                         tls->esni->esni_contents_hash)) != 0)+                    goto Exit;+            }+            is_esni = 1;+        } else if (ch->server_name.base != NULL) {+            server_name = ch->server_name;+        }+        if (tls->ctx->on_client_hello != NULL) {+            ptls_on_client_hello_parameters_t params = {server_name,+                                                        message,+                                                        {ch->alpn.list, ch->alpn.count},+                                                        {ch->signature_algorithms.list, ch->signature_algorithms.count},+                                                        {ch->cert_compression_algos.list, ch->cert_compression_algos.count},+                                                        {ch->client_ciphers.list, ch->client_ciphers.count},+                                                        {ch->server_certificate_types.list, ch->server_certificate_types.count},+                                                        is_esni};+            ret = tls->ctx->on_client_hello->cb(tls->ctx->on_client_hello, tls, &params);+        } else {+            ret = 0;+        }++        if (is_esni)+            free(server_name.base);+        if (ret != 0)+            goto Exit;++        if (!certificate_type_exists(ch->server_certificate_types.list, ch->server_certificate_types.count,+                                     tls->ctx->use_raw_public_keys ? PTLS_CERTIFICATE_TYPE_RAW_PUBLIC_KEY+                                                                   : PTLS_CERTIFICATE_TYPE_X509)) {+            ret = PTLS_ALERT_UNSUPPORTED_CERTIFICATE;+            goto Exit;+        }+    } else {+        if (ch->psk.early_data_indication) {+            ret = PTLS_ALERT_DECODE_ERROR;+            goto Exit;+        }+        /* the following check is necessary so that we would be able to track the connection in SSLKEYLOGFILE, even though it+         * might not be for the safety of the protocol */+        if (!ptls_mem_equal(tls->client_random, ch->random_bytes, sizeof(tls->client_random))) {+            ret = PTLS_ALERT_HANDSHAKE_FAILURE;+            goto Exit;+        }+        /* We compare SNI only when the value is saved by the on_client_hello callback. This should be OK because we are+         * ignoring the value unless the callback saves the server-name. */+        if (tls->server_name != NULL) {+            size_t l = strlen(tls->server_name);+            if (!(ch->server_name.len == l && memcmp(ch->server_name.base, tls->server_name, l) == 0)) {+                ret = PTLS_ALERT_HANDSHAKE_FAILURE;+                goto Exit;+            }+        }+    }++    { /* select (or check) cipher-suite, create key_schedule */+        ptls_cipher_suite_t *cs;+        if ((ret = select_cipher(&cs, tls->ctx->cipher_suites, ch->cipher_suites.base,+                                 ch->cipher_suites.base + ch->cipher_suites.len, tls->ctx->server_cipher_preference)) != 0)+            goto Exit;+        if (!is_second_flight) {+            tls->cipher_suite = cs;+            tls->key_schedule = key_schedule_new(cs, NULL, tls->ctx->hkdf_label_prefix__obsolete);+        } else {+            if (tls->cipher_suite != cs) {+                ret = PTLS_ALERT_HANDSHAKE_FAILURE;+                goto Exit;+            }+        }+    }++    /* select key_share */+    if (key_share.algorithm == NULL && ch->key_shares.base != NULL) {+        const uint8_t *src = ch->key_shares.base, *const end = src + ch->key_shares.len;+        ptls_decode_block(src, end, 2, {+            if ((ret = select_key_share(&key_share.algorithm, &key_share.peer_key, tls->ctx->key_exchanges, &src, end, 0)) != 0)+                goto Exit;+        });+    }++    if (!is_second_flight) {+        if (ch->cookie.all.len != 0 && key_share.algorithm != NULL) {++            /* use cookie to check the integrity of the handshake, and update the context */+            size_t sigsize = tls->ctx->cipher_suites[0]->hash->digest_size;+            uint8_t *sig = alloca(sigsize);+            if ((ret = calc_cookie_signature(tls, properties, key_share.algorithm, ch->cookie.tbs, sig)) != 0)+                goto Exit;+            if (!(ch->cookie.signature.len == sigsize && ptls_mem_equal(ch->cookie.signature.base, sig, sigsize))) {+                ret = PTLS_ALERT_HANDSHAKE_FAILURE;+                goto Exit;+            }+            /* integrity check passed; update states */+            key_schedule_update_ch1hash_prefix(tls->key_schedule);+            ptls__key_schedule_update_hash(tls->key_schedule, ch->cookie.ch1_hash.base, ch->cookie.ch1_hash.len);+            key_schedule_extract(tls->key_schedule, ptls_iovec_init(NULL, 0));+            /* ... reusing sendbuf to rebuild HRR for hash calculation */+            size_t hrr_start = emitter->buf->off;+            EMIT_HELLO_RETRY_REQUEST(tls->key_schedule, ch->cookie.sent_key_share ? key_share.algorithm : NULL, {+                buffer_push_extension(emitter->buf, PTLS_EXTENSION_TYPE_COOKIE,+                                      { ptls_buffer_pushv(emitter->buf, ch->cookie.all.base, ch->cookie.all.len); });+            });+            emitter->buf->off = hrr_start;+            is_second_flight = 1;++        } else if (key_share.algorithm == NULL || (properties != NULL && properties->server.enforce_retry)) {++            /* send HelloRetryRequest  */+            if (ch->negotiated_groups.base == NULL) {+                ret = PTLS_ALERT_MISSING_EXTENSION;+                goto Exit;+            }+            ptls_key_exchange_algorithm_t *negotiated_group;+            if ((ret = select_negotiated_group(&negotiated_group, tls->ctx->key_exchanges, ch->negotiated_groups.base,+                                               ch->negotiated_groups.base + ch->negotiated_groups.len)) != 0)+                goto Exit;+            ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);+            assert(tls->key_schedule->generation == 0);+            if (properties != NULL && properties->server.retry_uses_cookie) {+                /* emit HRR with cookie (note: we MUST omit KeyShare if the client has specified the correct one; see 46554f0)+                 */+                EMIT_HELLO_RETRY_REQUEST(NULL, key_share.algorithm != NULL ? NULL : negotiated_group, {+                    ptls_buffer_t *sendbuf = emitter->buf;+                    buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_COOKIE, {+                        ptls_buffer_push_block(sendbuf, 2, {+                            /* push to-be-signed data */+                            size_t tbs_start = sendbuf->off;+                            ptls_buffer_push_block(sendbuf, 2, {+                                /* first block of the cookie data is the hash(ch1) */+                                ptls_buffer_push_block(sendbuf, 1, {+                                    size_t sz = tls->cipher_suite->hash->digest_size;+                                    if ((ret = ptls_buffer_reserve(sendbuf, sz)) != 0)+                                        goto Exit;+                                    key_schedule_extract_ch1hash(tls->key_schedule, sendbuf->base + sendbuf->off);+                                    sendbuf->off += sz;+                                });+                                /* second is if we have sent key_share extension */+                                ptls_buffer_push(sendbuf, key_share.algorithm == NULL);+                                /* we can add more data here */+                            });+                            size_t tbs_len = sendbuf->off - tbs_start;+                            /* push the signature */+                            ptls_buffer_push_block(sendbuf, 1, {+                                size_t sz = tls->ctx->cipher_suites[0]->hash->digest_size;+                                if ((ret = ptls_buffer_reserve(sendbuf, sz)) != 0)+                                    goto Exit;+                                if ((ret = calc_cookie_signature(tls, properties, negotiated_group,+                                                                 ptls_iovec_init(sendbuf->base + tbs_start, tbs_len),+                                                                 sendbuf->base + sendbuf->off)) != 0)+                                    goto Exit;+                                sendbuf->off += sz;+                            });+                        });+                    });+                });+                if ((ret = push_change_cipher_spec(tls, emitter)) != 0)+                    goto Exit;+                ret = PTLS_ERROR_STATELESS_RETRY;+            } else {+                /* invoking stateful retry; roll the key schedule and emit HRR */+                key_schedule_transform_post_ch1hash(tls->key_schedule);+                key_schedule_extract(tls->key_schedule, ptls_iovec_init(NULL, 0));+                EMIT_HELLO_RETRY_REQUEST(tls->key_schedule, key_share.algorithm != NULL ? NULL : negotiated_group, {});+                if ((ret = push_change_cipher_spec(tls, emitter)) != 0)+                    goto Exit;+                tls->state = PTLS_STATE_SERVER_EXPECT_SECOND_CLIENT_HELLO;+                if (ch->psk.early_data_indication)+                    tls->server.early_data_skipped_bytes = 0;+                ret = PTLS_ERROR_IN_PROGRESS;+            }+            goto Exit;+        }+    }++    /* handle unknown extensions */+    if ((ret = report_unknown_extensions(tls, properties, ch->unknown_extensions)) != 0)+        goto Exit;++    /* try psk handshake */+    if (!is_second_flight && ch->psk.hash_end != 0 &&+        (ch->psk.ke_modes & ((1u << PTLS_PSK_KE_MODE_PSK) | (1u << PTLS_PSK_KE_MODE_PSK_DHE))) != 0 &&+        tls->ctx->encrypt_ticket != NULL && !tls->ctx->require_client_authentication) {+        if ((ret = try_psk_handshake(tls, &psk_index, &accept_early_data, ch,+                                     ptls_iovec_init(message.base, ch->psk.hash_end - message.base))) != 0) {+            goto Exit;+        }+    }++    /* If client authentication is enabled, we always force a full handshake.+     * TODO: Check for `post_handshake_auth` extension and if that is present, do not force full handshake!+     *       Remove also the check `!require_client_authentication` above.+     *+     * adjust key_schedule, determine handshake mode+     */+    if (psk_index == SIZE_MAX || tls->ctx->require_client_authentication) {+        ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);+        if (!is_second_flight) {+            assert(tls->key_schedule->generation == 0);+            key_schedule_extract(tls->key_schedule, ptls_iovec_init(NULL, 0));+        }+        mode = HANDSHAKE_MODE_FULL;+        if (properties != NULL)+            properties->server.selected_psk_binder.len = 0;+    } else {+        ptls__key_schedule_update_hash(tls->key_schedule, ch->psk.hash_end, message.base + message.len - ch->psk.hash_end);+        if ((ch->psk.ke_modes & (1u << PTLS_PSK_KE_MODE_PSK)) != 0) {+            mode = HANDSHAKE_MODE_PSK;+        } else {+            assert((ch->psk.ke_modes & (1u << PTLS_PSK_KE_MODE_PSK_DHE)) != 0);+            mode = HANDSHAKE_MODE_PSK_DHE;+        }+        tls->is_psk_handshake = 1;+        if (properties != NULL) {+            ptls_iovec_t *selected = &ch->psk.identities.list[psk_index].binder;+            memcpy(properties->server.selected_psk_binder.base, selected->base, selected->len);+            properties->server.selected_psk_binder.len = selected->len;+        }+    }++    if (accept_early_data && tls->ctx->max_early_data_size != 0 && psk_index == 0) {+        if ((tls->pending_handshake_secret = malloc(PTLS_MAX_DIGEST_SIZE)) == NULL) {+            ret = PTLS_ERROR_NO_MEMORY;+            goto Exit;+        }+        if ((ret = derive_exporter_secret(tls, 1)) != 0)+            goto Exit;+        if ((ret = setup_traffic_protection(tls, 0, "c e traffic", 1, 0)) != 0)+            goto Exit;+    }++    /* run key-exchange, to obtain pubkey and secret */+    if (mode != HANDSHAKE_MODE_PSK) {+        if (key_share.algorithm == NULL) {+            ret = ch->key_shares.base != NULL ? PTLS_ALERT_HANDSHAKE_FAILURE : PTLS_ALERT_MISSING_EXTENSION;+            goto Exit;+        }+        if ((ret = key_share.algorithm->exchange(key_share.algorithm, &pubkey, &ecdh_secret, key_share.peer_key)) != 0)+            goto Exit;+        tls->key_share = key_share.algorithm;+    }++    /* send ServerHello */+    EMIT_SERVER_HELLO(+        tls->key_schedule, { tls->ctx->random_bytes(emitter->buf->base + emitter->buf->off, PTLS_HELLO_RANDOM_SIZE); },+        {+            ptls_buffer_t *sendbuf = emitter->buf;+            if (mode != HANDSHAKE_MODE_PSK) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_KEY_SHARE, {+                    ptls_buffer_push16(sendbuf, key_share.algorithm->id);+                    ptls_buffer_push_block(sendbuf, 2, { ptls_buffer_pushv(sendbuf, pubkey.base, pubkey.len); });+                });+            }+            if (mode != HANDSHAKE_MODE_FULL) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_PRE_SHARED_KEY,+                                      { ptls_buffer_push16(sendbuf, (uint16_t)psk_index); });+            }+        });+    if ((ret = push_change_cipher_spec(tls, emitter)) != 0)+        goto Exit;++    /* create protection contexts for the handshake */+    assert(tls->key_schedule->generation == 1);+    key_schedule_extract(tls->key_schedule, ecdh_secret);+    if ((ret = setup_traffic_protection(tls, 1, "s hs traffic", 2, 0)) != 0)+        goto Exit;+    if (tls->pending_handshake_secret != NULL) {+        if ((ret = derive_secret(tls->key_schedule, tls->pending_handshake_secret, "c hs traffic")) != 0)+            goto Exit;+        if (tls->ctx->update_traffic_key != NULL &&+            (ret = tls->ctx->update_traffic_key->cb(tls->ctx->update_traffic_key, tls, 0, 2, tls->pending_handshake_secret)) != 0)+            goto Exit;+    } else {+        if ((ret = setup_traffic_protection(tls, 0, "c hs traffic", 2, 0)) != 0)+            goto Exit;+        if (ch->psk.early_data_indication)+            tls->server.early_data_skipped_bytes = 0;+    }++    /* send EncryptedExtensions */+    ptls_push_message(emitter, tls->key_schedule, PTLS_HANDSHAKE_TYPE_ENCRYPTED_EXTENSIONS, {+        ptls_buffer_t *sendbuf = emitter->buf;+        ptls_buffer_push_block(sendbuf, 2, {+            if (tls->esni != NULL) {+                /* the extension is sent even if the application does not handle server name, because otherwise the handshake+                 * would fail (FIXME ch->esni.nonce will be zero on HRR) */+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_ENCRYPTED_SERVER_NAME, {+                    uint8_t response_type = PTLS_ESNI_RESPONSE_TYPE_ACCEPT;+                    ptls_buffer_pushv(sendbuf, &response_type, 1);+                    ptls_buffer_pushv(sendbuf, tls->esni->nonce, PTLS_ESNI_NONCE_SIZE);+                });+                free_esni_secret(&tls->esni, 1);+            } else if (tls->server_name != NULL) {+                /* In this event, the server SHALL include an extension of type "server_name" in the (extended) server hello.+                 * The "extension_data" field of this extension SHALL be empty. (RFC 6066 section 3) */+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SERVER_NAME, {});+            }+            if (tls->ctx->use_raw_public_keys) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SERVER_CERTIFICATE_TYPE,+                                      { ptls_buffer_push(sendbuf, PTLS_CERTIFICATE_TYPE_RAW_PUBLIC_KEY); });+            }+            if (tls->negotiated_protocol != NULL) {+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_ALPN, {+                    ptls_buffer_push_block(sendbuf, 2, {+                        ptls_buffer_push_block(sendbuf, 1, {+                            ptls_buffer_pushv(sendbuf, tls->negotiated_protocol, strlen(tls->negotiated_protocol));+                        });+                    });+                });+            }+            if (tls->pending_handshake_secret != NULL)+                buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_EARLY_DATA, {});+            if ((ret = push_additional_extensions(properties, sendbuf)) != 0)+                goto Exit;+        });+    });++    if (mode == HANDSHAKE_MODE_FULL) {+        /* send certificate request if client authentication is activated */+        if (tls->ctx->require_client_authentication) {+            ptls_push_message(emitter, tls->key_schedule, PTLS_HANDSHAKE_TYPE_CERTIFICATE_REQUEST, {+                /* certificate_request_context, this field SHALL be zero length, unless the certificate+                 * request is used for post-handshake authentication.+                 */+                ptls_buffer_t *sendbuf = emitter->buf;+                ptls_buffer_push(sendbuf, 0);+                /* extensions */+                ptls_buffer_push_block(sendbuf, 2, {+                    buffer_push_extension(sendbuf, PTLS_EXTENSION_TYPE_SIGNATURE_ALGORITHMS, {+                        if ((ret = push_signature_algorithms(tls->ctx->verify_certificate, sendbuf)) != 0)+                            goto Exit;+                    });+                });+            });++            if (ret != 0) {+                goto Exit;+            }+        }++        ret = send_certificate_and_certificate_verify(tls, emitter, &ch->signature_algorithms, ptls_iovec_init(NULL, 0),+                                                      PTLS_SERVER_CERTIFICATE_VERIFY_CONTEXT_STRING, ch->status_request,+                                                      ch->cert_compression_algos.list, ch->cert_compression_algos.count);++        if (ret != 0) {+            goto Exit;+        }+    }++    if ((ret = send_finished(tls, emitter)) != 0)+        goto Exit;++    assert(tls->key_schedule->generation == 2);+    if ((ret = key_schedule_extract(tls->key_schedule, ptls_iovec_init(NULL, 0))) != 0)+        goto Exit;+    if ((ret = setup_traffic_protection(tls, 1, "s ap traffic", 3, 0)) != 0)+        goto Exit;+    if ((ret = derive_secret(tls->key_schedule, tls->server.pending_traffic_secret, "c ap traffic")) != 0)+        goto Exit;+    if ((ret = derive_exporter_secret(tls, 0)) != 0)+        goto Exit;++    if (tls->pending_handshake_secret != NULL) {+        if (tls->ctx->omit_end_of_early_data) {+            if ((ret = commission_handshake_secret(tls)) != 0)+                goto Exit;+            tls->state = PTLS_STATE_SERVER_EXPECT_FINISHED;+        } else {+            tls->state = PTLS_STATE_SERVER_EXPECT_END_OF_EARLY_DATA;+        }+    } else if (tls->ctx->require_client_authentication) {+        tls->state = PTLS_STATE_SERVER_EXPECT_CERTIFICATE;+    } else {+        tls->state = PTLS_STATE_SERVER_EXPECT_FINISHED;+    }++    /* send session ticket if necessary */+    if (ch->psk.ke_modes != 0 && tls->ctx->ticket_lifetime != 0) {+        if ((ret = send_session_ticket(tls, emitter)) != 0)+            goto Exit;+    }++    if (tls->ctx->require_client_authentication) {+        ret = PTLS_ERROR_IN_PROGRESS;+    } else {+        ret = 0;+    }++Exit:+    free(pubkey.base);+    if (ecdh_secret.base != NULL) {+        ptls_clear_memory(ecdh_secret.base, ecdh_secret.len);+        free(ecdh_secret.base);+    }+    free(ch);+    return ret;++#undef EMIT_SERVER_HELLO+#undef EMIT_HELLO_RETRY_REQUEST+}++static int server_handle_end_of_early_data(ptls_t *tls, ptls_iovec_t message)+{+    int ret;++    if ((ret = commission_handshake_secret(tls)) != 0)+        goto Exit;++    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);+    tls->state = PTLS_STATE_SERVER_EXPECT_FINISHED;+    ret = PTLS_ERROR_IN_PROGRESS;++Exit:+    return ret;+}++static int server_handle_finished(ptls_t *tls, ptls_iovec_t message)+{+    int ret;++    if ((ret = verify_finished(tls, message)) != 0)+        return ret;++    memcpy(tls->traffic_protection.dec.secret, tls->server.pending_traffic_secret, sizeof(tls->server.pending_traffic_secret));+    ptls_clear_memory(tls->server.pending_traffic_secret, sizeof(tls->server.pending_traffic_secret));+    if ((ret = setup_traffic_protection(tls, 0, NULL, 3, 0)) != 0)+        return ret;++    ptls__key_schedule_update_hash(tls->key_schedule, message.base, message.len);++    tls->state = PTLS_STATE_SERVER_POST_HANDSHAKE;+    return 0;+}++static int update_traffic_key(ptls_t *tls, int is_enc)+{+    struct st_ptls_traffic_protection_t *tp = is_enc ? &tls->traffic_protection.enc : &tls->traffic_protection.dec;+    uint8_t secret[PTLS_MAX_DIGEST_SIZE];+    int ret;++    ptls_hash_algorithm_t *hash = tls->key_schedule->hashes[0].algo;+    if ((ret = hkdf_expand_label(hash, secret, hash->digest_size, ptls_iovec_init(tp->secret, hash->digest_size), "traffic upd",+                                 ptls_iovec_init(NULL, 0), tls->key_schedule->hkdf_label_prefix)) != 0)+        goto Exit;+    memcpy(tp->secret, secret, sizeof(secret));+    ret = setup_traffic_protection(tls, is_enc, NULL, 3, 1);++Exit:+    ptls_clear_memory(secret, sizeof(secret));+    return ret;+}++static int handle_key_update(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_iovec_t message)+{+    const uint8_t *src = message.base + PTLS_HANDSHAKE_HEADER_SIZE, *const end = message.base + message.len;+    int ret;++    /* validate */+    if (end - src != 1 || *src > 1)+        return PTLS_ALERT_DECODE_ERROR;++    /* update receive key */+    if ((ret = update_traffic_key(tls, 0)) != 0)+        return ret;++    if (*src) {+        if (tls->ctx->update_traffic_key != NULL)+            return PTLS_ALERT_UNEXPECTED_MESSAGE;+        tls->needs_key_update = 1;+    }++    return 0;+}++static int parse_record_header(struct st_ptls_record_t *rec, const uint8_t *src)+{+    rec->type = src[0];+    rec->version = ntoh16(src + 1);+    rec->length = ntoh16(src + 3);++    if (rec->length >+        (size_t)(rec->type == PTLS_CONTENT_TYPE_APPDATA ? PTLS_MAX_ENCRYPTED_RECORD_SIZE : PTLS_MAX_PLAINTEXT_RECORD_SIZE))+        return PTLS_ALERT_DECODE_ERROR;++    return 0;+}++static int parse_record(ptls_t *tls, struct st_ptls_record_t *rec, const uint8_t *src, size_t *len)+{+    int ret;++    if (tls->recvbuf.rec.base == NULL && *len >= 5) {+        /* fast path */+        if ((ret = parse_record_header(rec, src)) != 0)+            return ret;+        if (5 + rec->length <= *len) {+            rec->fragment = src + 5;+            *len = rec->length + 5;+            return 0;+        }+    }++    /* slow path */+    const uint8_t *const end = src + *len;+    *rec = (struct st_ptls_record_t){0};++    if (tls->recvbuf.rec.base == NULL) {+        ptls_buffer_init(&tls->recvbuf.rec, "", 0);+        if ((ret = ptls_buffer_reserve(&tls->recvbuf.rec, 5)) != 0)+            return ret;+    }++    /* fill and parse the header */+    while (tls->recvbuf.rec.off < 5) {+        if (src == end)+            return PTLS_ERROR_IN_PROGRESS;+        tls->recvbuf.rec.base[tls->recvbuf.rec.off++] = *src++;+    }+    if ((ret = parse_record_header(rec, tls->recvbuf.rec.base)) != 0)+        return ret;++    /* fill the fragment */+    size_t addlen = rec->length + 5 - tls->recvbuf.rec.off;+    if (addlen != 0) {+        if ((ret = ptls_buffer_reserve(&tls->recvbuf.rec, addlen)) != 0)+            return ret;+        if (addlen > (size_t)(end - src))+            addlen = end - src;+        if (addlen != 0) {+            memcpy(tls->recvbuf.rec.base + tls->recvbuf.rec.off, src, addlen);+            tls->recvbuf.rec.off += addlen;+            src += addlen;+        }+    }++    /* set rec->fragment if a complete record has been parsed */+    if (tls->recvbuf.rec.off == rec->length + 5) {+        rec->fragment = tls->recvbuf.rec.base + 5;+        ret = 0;+    } else {+        ret = PTLS_ERROR_IN_PROGRESS;+    }++    *len -= end - src;+    return ret;+}++static void update_open_count(ptls_context_t *ctx, ssize_t delta)+{+    if (ctx->update_open_count != NULL)+        ctx->update_open_count->cb(ctx->update_open_count, delta);+}++static ptls_t *new_instance(ptls_context_t *ctx, int is_server)+{+    ptls_t *tls;++    assert(ctx->get_time != NULL && "please set ctx->get_time to `&ptls_get_time`; see #92");++    if ((tls = malloc(sizeof(*tls))) == NULL)+        return NULL;++    update_open_count(ctx, 1);+    *tls = (ptls_t){ctx};+    tls->is_server = is_server;+    tls->send_change_cipher_spec = ctx->send_change_cipher_spec;+    tls->skip_tracing = ptls_default_skip_tracing;+    return tls;+}++ptls_t *ptls_client_new(ptls_context_t *ctx)+{+    ptls_t *tls = new_instance(ctx, 0);+    tls->state = PTLS_STATE_CLIENT_HANDSHAKE_START;+    tls->ctx->random_bytes(tls->client_random, sizeof(tls->client_random));+    log_client_random(tls);+    if (tls->send_change_cipher_spec) {+        tls->client.legacy_session_id =+            ptls_iovec_init(tls->client.legacy_session_id_buf, sizeof(tls->client.legacy_session_id_buf));+        tls->ctx->random_bytes(tls->client.legacy_session_id.base, tls->client.legacy_session_id.len);+    }++    PTLS_PROBE(NEW, tls, 0);+    return tls;+}++ptls_t *ptls_server_new(ptls_context_t *ctx)+{+    ptls_t *tls = new_instance(ctx, 1);+    tls->state = PTLS_STATE_SERVER_EXPECT_CLIENT_HELLO;+    tls->server.early_data_skipped_bytes = UINT32_MAX;++    PTLS_PROBE(NEW, tls, 1);+    return tls;+}++void ptls_free(ptls_t *tls)+{+    PTLS_PROBE0(FREE, tls);+    ptls_buffer_dispose(&tls->recvbuf.rec);+    ptls_buffer_dispose(&tls->recvbuf.mess);+    free_exporter_master_secret(tls, 1);+    free_exporter_master_secret(tls, 0);+    if (tls->esni != NULL)+        free_esni_secret(&tls->esni, tls->is_server);+    if (tls->key_schedule != NULL)+        key_schedule_free(tls->key_schedule);+    if (tls->traffic_protection.dec.aead != NULL)+        ptls_aead_free(tls->traffic_protection.dec.aead);+    if (tls->traffic_protection.enc.aead != NULL)+        ptls_aead_free(tls->traffic_protection.enc.aead);+    free(tls->server_name);+    free(tls->negotiated_protocol);+    if (tls->is_server) {+        /* nothing to do */+    } else {+        if (tls->client.key_share_ctx != NULL)+            tls->client.key_share_ctx->on_exchange(&tls->client.key_share_ctx, 1, NULL, ptls_iovec_init(NULL, 0));+        if (tls->client.certificate_request.context.base != NULL)+            free(tls->client.certificate_request.context.base);+    }+    if (tls->certificate_verify.cb != NULL) {+        tls->certificate_verify.cb(tls->certificate_verify.verify_ctx, 0, ptls_iovec_init(NULL, 0), ptls_iovec_init(NULL, 0));+    }+    if (tls->pending_handshake_secret != NULL) {+        ptls_clear_memory(tls->pending_handshake_secret, PTLS_MAX_DIGEST_SIZE);+        free(tls->pending_handshake_secret);+    }+    update_open_count(tls->ctx, -1);+    ptls_clear_memory(tls, sizeof(*tls));+    free(tls);+}++ptls_context_t *ptls_get_context(ptls_t *tls)+{+    return tls->ctx;+}++void ptls_set_context(ptls_t *tls, ptls_context_t *ctx)+{+    update_open_count(ctx, 1);+    update_open_count(tls->ctx, -1);+    tls->ctx = ctx;+}++ptls_iovec_t ptls_get_client_random(ptls_t *tls)+{+    return ptls_iovec_init(tls->client_random, PTLS_HELLO_RANDOM_SIZE);+}++ptls_cipher_suite_t *ptls_get_cipher(ptls_t *tls)+{+    return tls->cipher_suite;+}++const char *ptls_get_server_name(ptls_t *tls)+{+    return tls->server_name;+}++int ptls_set_server_name(ptls_t *tls, const char *server_name, size_t server_name_len)+{+    char *duped = NULL;++    if (server_name != NULL) {+        if (server_name_len == 0)+            server_name_len = strlen(server_name);+        if ((duped = malloc(server_name_len + 1)) == NULL)+            return PTLS_ERROR_NO_MEMORY;+        memcpy(duped, server_name, server_name_len);+        duped[server_name_len] = '\0';+    }++    free(tls->server_name);+    tls->server_name = duped;++    return 0;+}++const char *ptls_get_negotiated_protocol(ptls_t *tls)+{+    return tls->negotiated_protocol;+}++int ptls_set_negotiated_protocol(ptls_t *tls, const char *protocol, size_t protocol_len)+{+    char *duped = NULL;++    if (protocol != NULL) {+        if (protocol_len == 0)+            protocol_len = strlen(protocol);+        if ((duped = malloc(protocol_len + 1)) == NULL)+            return PTLS_ERROR_NO_MEMORY;+        memcpy(duped, protocol, protocol_len);+        duped[protocol_len] = '\0';+    }++    free(tls->negotiated_protocol);+    tls->negotiated_protocol = duped;++    return 0;+}++int ptls_handshake_is_complete(ptls_t *tls)+{+    return tls->state >= PTLS_STATE_POST_HANDSHAKE_MIN;+}++int ptls_is_psk_handshake(ptls_t *tls)+{+    return tls->is_psk_handshake;+}++void **ptls_get_data_ptr(ptls_t *tls)+{+    return &tls->data_ptr;+}++int ptls_skip_tracing(ptls_t *tls)+{+    return tls->skip_tracing;+}++void ptls_set_skip_tracing(ptls_t *tls, int skip_tracing)+{+    tls->skip_tracing = skip_tracing;+}++static int handle_client_handshake_message(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_iovec_t message, int is_end_of_record,+                                           ptls_handshake_properties_t *properties)+{+    uint8_t type = message.base[0];+    int ret;++    switch (tls->state) {+    case PTLS_STATE_CLIENT_EXPECT_SERVER_HELLO:+    case PTLS_STATE_CLIENT_EXPECT_SECOND_SERVER_HELLO:+        if (type == PTLS_HANDSHAKE_TYPE_SERVER_HELLO && is_end_of_record) {+            ret = client_handle_hello(tls, emitter, message, properties);+        } else {+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        }+        break;+    case PTLS_STATE_CLIENT_EXPECT_ENCRYPTED_EXTENSIONS:+        if (type == PTLS_HANDSHAKE_TYPE_ENCRYPTED_EXTENSIONS) {+            ret = client_handle_encrypted_extensions(tls, message, properties);+        } else {+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        }+        break;+    case PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_REQUEST_OR_CERTIFICATE:+        if (type == PTLS_HANDSHAKE_TYPE_CERTIFICATE_REQUEST) {+            ret = client_handle_certificate_request(tls, message, properties);+            break;+        }+    /* fall through */+    case PTLS_STATE_CLIENT_EXPECT_CERTIFICATE:+        switch (type) {+        case PTLS_HANDSHAKE_TYPE_CERTIFICATE:+            ret = client_handle_certificate(tls, message);+            break;+        case PTLS_HANDSHAKE_TYPE_COMPRESSED_CERTIFICATE:+            ret = client_handle_compressed_certificate(tls, message);+            break;+        default:+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+            break;+        }+        break;+    case PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_VERIFY:+        if (type == PTLS_HANDSHAKE_TYPE_CERTIFICATE_VERIFY) {+            ret = client_handle_certificate_verify(tls, message);+        } else {+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        }+        break;+    case PTLS_STATE_CLIENT_EXPECT_FINISHED:+        if (type == PTLS_HANDSHAKE_TYPE_FINISHED && is_end_of_record) {+            ret = client_handle_finished(tls, emitter, message);+        } else {+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        }+        break;+    case PTLS_STATE_CLIENT_POST_HANDSHAKE:+        switch (type) {+        case PTLS_HANDSHAKE_TYPE_NEW_SESSION_TICKET:+            ret = client_handle_new_session_ticket(tls, message);+            break;+        case PTLS_HANDSHAKE_TYPE_KEY_UPDATE:+            ret = handle_key_update(tls, emitter, message);+            break;+        default:+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+            break;+        }+        break;+    default:+        assert(!"unexpected state");+        ret = PTLS_ALERT_INTERNAL_ERROR;+        break;+    }++    PTLS_PROBE(RECEIVE_MESSAGE, tls, message.base[0], message.base + PTLS_HANDSHAKE_HEADER_SIZE,+               message.len - PTLS_HANDSHAKE_HEADER_SIZE, ret);++    return ret;+}++static int handle_server_handshake_message(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_iovec_t message, int is_end_of_record,+                                           ptls_handshake_properties_t *properties)+{+    uint8_t type = message.base[0];+    int ret;++    switch (tls->state) {+    case PTLS_STATE_SERVER_EXPECT_CLIENT_HELLO:+    case PTLS_STATE_SERVER_EXPECT_SECOND_CLIENT_HELLO:+        if (type == PTLS_HANDSHAKE_TYPE_CLIENT_HELLO && is_end_of_record) {+            ret = server_handle_hello(tls, emitter, message, properties);+        } else {+            ret = PTLS_ALERT_HANDSHAKE_FAILURE;+        }+        break;+    case PTLS_STATE_SERVER_EXPECT_CERTIFICATE:+        if (type == PTLS_HANDSHAKE_TYPE_CERTIFICATE) {+            ret = server_handle_certificate(tls, message);+        } else {+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        }+        break;+    case PTLS_STATE_SERVER_EXPECT_CERTIFICATE_VERIFY:+        if (type == PTLS_HANDSHAKE_TYPE_CERTIFICATE_VERIFY) {+            ret = server_handle_certificate_verify(tls, message);+        } else {+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        }+        break;+    case PTLS_STATE_SERVER_EXPECT_END_OF_EARLY_DATA:+        assert(!tls->ctx->omit_end_of_early_data);+        if (type == PTLS_HANDSHAKE_TYPE_END_OF_EARLY_DATA) {+            ret = server_handle_end_of_early_data(tls, message);+        } else {+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+        }+        break;+    case PTLS_STATE_SERVER_EXPECT_FINISHED:+        if (type == PTLS_HANDSHAKE_TYPE_FINISHED && is_end_of_record) {+            ret = server_handle_finished(tls, message);+        } else {+            ret = PTLS_ALERT_HANDSHAKE_FAILURE;+        }+        break;+    case PTLS_STATE_SERVER_POST_HANDSHAKE:+        switch (type) {+        case PTLS_HANDSHAKE_TYPE_KEY_UPDATE:+            ret = handle_key_update(tls, emitter, message);+            break;+        default:+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+            break;+        }+        break;+    default:+        assert(!"unexpected state");+        ret = PTLS_ALERT_INTERNAL_ERROR;+        break;+    }++    PTLS_PROBE(RECEIVE_MESSAGE, tls, message.base[0], message.base + PTLS_HANDSHAKE_HEADER_SIZE,+               message.len - PTLS_HANDSHAKE_HEADER_SIZE, ret);++    return ret;+}++static int handle_alert(ptls_t *tls, const uint8_t *src, size_t len)+{+    if (len != 2)+        return PTLS_ALERT_DECODE_ERROR;++    uint8_t desc = src[1];++    /* all fatal alerts and USER_CANCELLED warning tears down the connection immediately, regardless of the transmitted level */+    return PTLS_ALERT_TO_PEER_ERROR(desc);+}++static int message_buffer_is_overflow(ptls_context_t *ctx, size_t size)+{+    if (ctx->max_buffer_size == 0)+        return 0;+    if (size <= ctx->max_buffer_size)+        return 0;+    return 1;+}++static int handle_handshake_record(ptls_t *tls,+                                   int (*cb)(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_iovec_t message,+                                             int is_end_of_record, ptls_handshake_properties_t *properties),+                                   ptls_message_emitter_t *emitter, struct st_ptls_record_t *rec,+                                   ptls_handshake_properties_t *properties)+{+    int ret;++    /* handshake */+    if (rec->type != PTLS_CONTENT_TYPE_HANDSHAKE)+        return PTLS_ALERT_DECODE_ERROR;++    /* flatten the unhandled messages */+    const uint8_t *src, *src_end;+    if (tls->recvbuf.mess.base == NULL) {+        src = rec->fragment;+        src_end = src + rec->length;+    } else {+        if (message_buffer_is_overflow(tls->ctx, tls->recvbuf.mess.off + rec->length))+            return PTLS_ALERT_HANDSHAKE_FAILURE;+        if ((ret = ptls_buffer_reserve(&tls->recvbuf.mess, rec->length)) != 0)+            return ret;+        memcpy(tls->recvbuf.mess.base + tls->recvbuf.mess.off, rec->fragment, rec->length);+        tls->recvbuf.mess.off += rec->length;+        src = tls->recvbuf.mess.base;+        src_end = src + tls->recvbuf.mess.off;+    }++    /* handle the messages */+    ret = PTLS_ERROR_IN_PROGRESS;+    while (src_end - src >= 4) {+        size_t mess_len = 4 + ntoh24(src + 1);+        if (src_end - src < (int)mess_len)+            break;+        ret = cb(tls, emitter, ptls_iovec_init(src, mess_len), src_end - src == mess_len, properties);+        switch (ret) {+        case 0:+        case PTLS_ERROR_IN_PROGRESS:+            break;+        default:+            ptls_buffer_dispose(&tls->recvbuf.mess);+            return ret;+        }+        src += mess_len;+    }++    /* keep last partial message in buffer */+    if (src != src_end) {+        size_t new_size = src_end - src;+        if (message_buffer_is_overflow(tls->ctx, new_size))+            return PTLS_ALERT_HANDSHAKE_FAILURE;+        if (tls->recvbuf.mess.base == NULL) {+            ptls_buffer_init(&tls->recvbuf.mess, "", 0);+            if ((ret = ptls_buffer_reserve(&tls->recvbuf.mess, new_size)) != 0)+                return ret;+            memcpy(tls->recvbuf.mess.base, src, new_size);+        } else {+            memmove(tls->recvbuf.mess.base, src, new_size);+        }+        tls->recvbuf.mess.off = new_size;+        ret = PTLS_ERROR_IN_PROGRESS;+    } else {+        ptls_buffer_dispose(&tls->recvbuf.mess);+    }++    return ret;+}++static int handle_input(ptls_t *tls, ptls_message_emitter_t *emitter, ptls_buffer_t *decryptbuf, const void *input, size_t *inlen,+                        ptls_handshake_properties_t *properties)+{+    struct st_ptls_record_t rec;+    int ret;++    /* extract the record */+    if ((ret = parse_record(tls, &rec, input, inlen)) != 0)+        return ret;+    assert(rec.fragment != NULL);++    /* decrypt the record */+    if (rec.type == PTLS_CONTENT_TYPE_CHANGE_CIPHER_SPEC) {+        if (tls->state < PTLS_STATE_POST_HANDSHAKE_MIN) {+            if (!(rec.length == 1 && rec.fragment[0] == 0x01))+                return PTLS_ALERT_ILLEGAL_PARAMETER;+        } else {+            return PTLS_ALERT_HANDSHAKE_FAILURE;+        }+        ret = PTLS_ERROR_IN_PROGRESS;+        goto NextRecord;+    }+    if (tls->traffic_protection.dec.aead != NULL && rec.type != PTLS_CONTENT_TYPE_ALERT) {+        size_t decrypted_length;+        if (rec.type != PTLS_CONTENT_TYPE_APPDATA)+            return PTLS_ALERT_HANDSHAKE_FAILURE;+        if ((ret = ptls_buffer_reserve(decryptbuf, 5 + rec.length)) != 0)+            return ret;+        if ((ret = aead_decrypt(&tls->traffic_protection.dec, decryptbuf->base + decryptbuf->off, &decrypted_length, rec.fragment,+                                rec.length)) != 0) {+            if (tls->is_server && tls->server.early_data_skipped_bytes != UINT32_MAX)+                goto ServerSkipEarlyData;+            return ret;+        }+        rec.length = decrypted_length;+        rec.fragment = decryptbuf->base + decryptbuf->off;+        /* skip padding */+        for (; rec.length != 0; --rec.length)+            if (rec.fragment[rec.length - 1] != 0)+                break;+        if (rec.length == 0)+            return PTLS_ALERT_UNEXPECTED_MESSAGE;+        rec.type = rec.fragment[--rec.length];+    } else if (rec.type == PTLS_CONTENT_TYPE_APPDATA && tls->is_server && tls->server.early_data_skipped_bytes != UINT32_MAX) {+        goto ServerSkipEarlyData;+    }++    if (tls->recvbuf.mess.base != NULL || rec.type == PTLS_CONTENT_TYPE_HANDSHAKE) {+        /* handshake record */+        ret = handle_handshake_record(tls, tls->is_server ? handle_server_handshake_message : handle_client_handshake_message,+                                      emitter, &rec, properties);+    } else {+        /* handling of an alert or an application record */+        switch (rec.type) {+        case PTLS_CONTENT_TYPE_APPDATA:+            if (tls->state >= PTLS_STATE_POST_HANDSHAKE_MIN) {+                decryptbuf->off += rec.length;+                ret = 0;+            } else if (tls->state == PTLS_STATE_SERVER_EXPECT_END_OF_EARLY_DATA) {+                if (tls->traffic_protection.dec.aead != NULL)+                    decryptbuf->off += rec.length;+                ret = 0;+            } else {+                ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+            }+            break;+        case PTLS_CONTENT_TYPE_ALERT:+            ret = handle_alert(tls, rec.fragment, rec.length);+            break;+        default:+            ret = PTLS_ALERT_UNEXPECTED_MESSAGE;+            break;+        }+    }++NextRecord:+    ptls_buffer_dispose(&tls->recvbuf.rec);+    return ret;++ServerSkipEarlyData:+    tls->server.early_data_skipped_bytes += (uint32_t)rec.length;+    if (tls->server.early_data_skipped_bytes > PTLS_MAX_EARLY_DATA_SKIP_SIZE)+        return PTLS_ALERT_HANDSHAKE_FAILURE;+    ret = PTLS_ERROR_IN_PROGRESS;+    goto NextRecord;+}++static void init_record_message_emitter(ptls_t *tls, struct st_ptls_record_message_emitter_t *emitter, ptls_buffer_t *sendbuf)+{+    *emitter = (struct st_ptls_record_message_emitter_t){+        {sendbuf, &tls->traffic_protection.enc, 5, begin_record_message, commit_record_message}};+}++int ptls_handshake(ptls_t *tls, ptls_buffer_t *_sendbuf, const void *input, size_t *inlen, ptls_handshake_properties_t *properties)+{+    struct st_ptls_record_message_emitter_t emitter;+    int ret;++    assert(tls->state < PTLS_STATE_POST_HANDSHAKE_MIN);++    init_record_message_emitter(tls, &emitter, _sendbuf);+    size_t sendbuf_orig_off = emitter.super.buf->off;++    /* special handlings */+    switch (tls->state) {+    case PTLS_STATE_CLIENT_HANDSHAKE_START: {+        assert(input == NULL || *inlen == 0);+        assert(tls->ctx->key_exchanges[0] != NULL);+        return send_client_hello(tls, &emitter.super, properties, NULL);+    }+    default:+        break;+    }++    const uint8_t *src = input, *const src_end = src + *inlen;+    ptls_buffer_t decryptbuf;++    ptls_buffer_init(&decryptbuf, "", 0);++    /* perform handhake until completion or until all the input has been swallowed */+    ret = PTLS_ERROR_IN_PROGRESS;+    while (ret == PTLS_ERROR_IN_PROGRESS && src != src_end) {+        size_t consumed = src_end - src;+        ret = handle_input(tls, &emitter.super, &decryptbuf, src, &consumed, properties);+        src += consumed;+        assert(decryptbuf.off == 0);+    }++    ptls_buffer_dispose(&decryptbuf);++    switch (ret) {+    case 0:+    case PTLS_ERROR_IN_PROGRESS:+    case PTLS_ERROR_STATELESS_RETRY:+        break;+    default:+        /* flush partially written response */+        ptls_clear_memory(emitter.super.buf->base + sendbuf_orig_off, emitter.super.buf->off - sendbuf_orig_off);+        emitter.super.buf->off = sendbuf_orig_off;+        /* send alert immediately */+        if (PTLS_ERROR_GET_CLASS(ret) != PTLS_ERROR_CLASS_PEER_ALERT)+            if (ptls_send_alert(tls, emitter.super.buf, PTLS_ALERT_LEVEL_FATAL,+                                PTLS_ERROR_GET_CLASS(ret) == PTLS_ERROR_CLASS_SELF_ALERT ? ret : PTLS_ALERT_INTERNAL_ERROR) != 0)+                emitter.super.buf->off = sendbuf_orig_off;+        break;+    }++    *inlen -= src_end - src;+    return ret;+}++int ptls_receive(ptls_t *tls, ptls_buffer_t *decryptbuf, const void *_input, size_t *inlen)+{+    const uint8_t *input = (const uint8_t *)_input, *const end = input + *inlen;+    size_t decryptbuf_orig_size = decryptbuf->off;+    int ret = 0;++    assert(tls->state >= PTLS_STATE_SERVER_EXPECT_END_OF_EARLY_DATA);++    /* loop until we decrypt some application data (or an error) */+    while (ret == 0 && input != end && decryptbuf_orig_size == decryptbuf->off) {+        size_t consumed = end - input;+        ret = handle_input(tls, NULL, decryptbuf, input, &consumed, NULL);+        input += consumed;++        switch (ret) {+        case 0:+            break;+        case PTLS_ERROR_IN_PROGRESS:+            ret = 0;+            break;+        case PTLS_ERROR_CLASS_PEER_ALERT + PTLS_ALERT_CLOSE_NOTIFY:+            /* TODO send close alert */+            break;+        default:+            if (PTLS_ERROR_GET_CLASS(ret) == PTLS_ERROR_CLASS_SELF_ALERT) {+                /* TODO send alert */+            }+            break;+        }+    }++    *inlen -= end - input;++    return ret;+}++static int update_send_key(ptls_t *tls, ptls_buffer_t *_sendbuf, int request_update)+{+    struct st_ptls_record_message_emitter_t emitter;+    int ret;++    init_record_message_emitter(tls, &emitter, _sendbuf);+    size_t sendbuf_orig_off = emitter.super.buf->off;++    ptls_push_message(&emitter.super, NULL, PTLS_HANDSHAKE_TYPE_KEY_UPDATE,+                      { ptls_buffer_push(emitter.super.buf, !!request_update); });+    if ((ret = update_traffic_key(tls, 1)) != 0)+        goto Exit;+    ret = 0;++Exit:+    if (ret != 0)+        emitter.super.buf->off = sendbuf_orig_off;+    return ret;+}++int ptls_send(ptls_t *tls, ptls_buffer_t *sendbuf, const void *input, size_t inlen)+{+    assert(tls->traffic_protection.enc.aead != NULL);++    /* "For AES-GCM, up to 2^24.5 full-size records (about 24 million) may be encrypted on a given connection while keeping a+     * safety margin of approximately 2^-57 for Authenticated Encryption (AE) security." (RFC 8446 section 5.5)+     */+    if (tls->traffic_protection.enc.seq >= 16777216)+        tls->needs_key_update = 1;++    if (tls->needs_key_update) {+        int ret;+        if ((ret = update_send_key(tls, sendbuf, tls->key_update_send_request)) != 0)+            return ret;+        tls->needs_key_update = 0;+        tls->key_update_send_request = 0;+    }++    return buffer_push_encrypted_records(sendbuf, PTLS_CONTENT_TYPE_APPDATA, input, inlen, &tls->traffic_protection.enc);+}++int ptls_update_key(ptls_t *tls, int request_update)+{+    assert(tls->ctx->update_traffic_key == NULL);+    tls->needs_key_update = 1;+    tls->key_update_send_request = request_update;+    return 0;+}++size_t ptls_get_record_overhead(ptls_t *tls)+{+    return 6 + tls->traffic_protection.enc.aead->algo->tag_size;+}++int ptls_send_alert(ptls_t *tls, ptls_buffer_t *sendbuf, uint8_t level, uint8_t description)+{+    size_t rec_start = sendbuf->off;+    int ret = 0;++    buffer_push_record(sendbuf, PTLS_CONTENT_TYPE_ALERT, { ptls_buffer_push(sendbuf, level, description); });+    /* encrypt the alert if we have the encryption keys, unless when it is the early data key */+    if (tls->traffic_protection.enc.aead != NULL && !(tls->state <= PTLS_STATE_CLIENT_EXPECT_FINISHED)) {+        if ((ret = buffer_encrypt_record(sendbuf, rec_start, &tls->traffic_protection.enc)) != 0)+            goto Exit;+    }++Exit:+    return ret;+}++int ptls_export_secret(ptls_t *tls, void *output, size_t outlen, const char *label, ptls_iovec_t context_value, int is_early)+{+    ptls_hash_algorithm_t *algo = tls->key_schedule->hashes[0].algo;+    uint8_t *master_secret = is_early ? tls->exporter_master_secret.early : tls->exporter_master_secret.one_rtt,+            derived_secret[PTLS_MAX_DIGEST_SIZE], context_value_hash[PTLS_MAX_DIGEST_SIZE];+    int ret;++    if (master_secret == NULL) {+        if (is_early) {+            switch (tls->state) {+            case PTLS_STATE_CLIENT_HANDSHAKE_START:+            case PTLS_STATE_SERVER_EXPECT_CLIENT_HELLO:+                ret = PTLS_ERROR_IN_PROGRESS;+                break;+            default:+                ret = PTLS_ERROR_NOT_AVAILABLE;+                break;+            }+        } else {+            ret = PTLS_ERROR_IN_PROGRESS;+        }+        return ret;+    }++    if ((ret = ptls_calc_hash(algo, context_value_hash, context_value.base, context_value.len)) != 0)+        return ret;++    if ((ret = hkdf_expand_label(algo, derived_secret, algo->digest_size, ptls_iovec_init(master_secret, algo->digest_size), label,+                                 ptls_iovec_init(algo->empty_digest, algo->digest_size), tls->key_schedule->hkdf_label_prefix)) !=+        0)+        goto Exit;+    ret = hkdf_expand_label(algo, output, outlen, ptls_iovec_init(derived_secret, algo->digest_size), "exporter",+                            ptls_iovec_init(context_value_hash, algo->digest_size), tls->key_schedule->hkdf_label_prefix);++Exit:+    ptls_clear_memory(derived_secret, sizeof(derived_secret));+    ptls_clear_memory(context_value_hash, sizeof(context_value_hash));+    return ret;+}++struct st_picotls_hmac_context_t {+    ptls_hash_context_t super;+    ptls_hash_algorithm_t *algo;+    ptls_hash_context_t *hash;+    uint8_t key[1];+};++static void hmac_update(ptls_hash_context_t *_ctx, const void *src, size_t len)+{+    struct st_picotls_hmac_context_t *ctx = (struct st_picotls_hmac_context_t *)_ctx;+    ctx->hash->update(ctx->hash, src, len);+}++static void hmac_apply_key(struct st_picotls_hmac_context_t *ctx, uint8_t pad)+{+    size_t i;++    for (i = 0; i != ctx->algo->block_size; ++i)+        ctx->key[i] ^= pad;+    ctx->hash->update(ctx->hash, ctx->key, ctx->algo->block_size);+    for (i = 0; i != ctx->algo->block_size; ++i)+        ctx->key[i] ^= pad;+}++static void hmac_final(ptls_hash_context_t *_ctx, void *md, ptls_hash_final_mode_t mode)+{+    struct st_picotls_hmac_context_t *ctx = (struct st_picotls_hmac_context_t *)_ctx;++    assert(mode != PTLS_HASH_FINAL_MODE_SNAPSHOT || !"not supported");++    if (md != NULL) {+        ctx->hash->final(ctx->hash, md, PTLS_HASH_FINAL_MODE_RESET);+        hmac_apply_key(ctx, 0x5c);+        ctx->hash->update(ctx->hash, md, ctx->algo->digest_size);+    }+    ctx->hash->final(ctx->hash, md, mode);++    switch (mode) {+    case PTLS_HASH_FINAL_MODE_FREE:+        ptls_clear_memory(ctx->key, ctx->algo->block_size);+        free(ctx);+        break;+    case PTLS_HASH_FINAL_MODE_RESET:+        hmac_apply_key(ctx, 0x36);+        break;+    default:+        assert(!"FIXME");+        break;+    }+}++int ptls_calc_hash(ptls_hash_algorithm_t *algo, void *output, const void *src, size_t len)+{+    ptls_hash_context_t *ctx;++    if ((ctx = algo->create()) == NULL)+        return PTLS_ERROR_NO_MEMORY;+    ctx->update(ctx, src, len);+    ctx->final(ctx, output, PTLS_HASH_FINAL_MODE_FREE);+    return 0;+}++ptls_hash_context_t *ptls_hmac_create(ptls_hash_algorithm_t *algo, const void *key, size_t key_size)+{+    struct st_picotls_hmac_context_t *ctx;++    assert(key_size <= algo->block_size);++    if ((ctx = malloc(offsetof(struct st_picotls_hmac_context_t, key) + algo->block_size)) == NULL)+        return NULL;++    *ctx = (struct st_picotls_hmac_context_t){{hmac_update, hmac_final}, algo};+    if ((ctx->hash = algo->create()) == NULL) {+        free(ctx);+        return NULL;+    }+    memset(ctx->key, 0, algo->block_size);+    memcpy(ctx->key, key, key_size);++    hmac_apply_key(ctx, 0x36);++    return &ctx->super;+}++int ptls_hkdf_extract(ptls_hash_algorithm_t *algo, void *output, ptls_iovec_t salt, ptls_iovec_t ikm)+{+    ptls_hash_context_t *hash;++    if (salt.len == 0)+        salt = ptls_iovec_init(zeroes_of_max_digest_size, algo->digest_size);++    if ((hash = ptls_hmac_create(algo, salt.base, salt.len)) == NULL)+        return PTLS_ERROR_NO_MEMORY;+    hash->update(hash, ikm.base, ikm.len);+    hash->final(hash, output, PTLS_HASH_FINAL_MODE_FREE);+    return 0;+}++int ptls_hkdf_expand(ptls_hash_algorithm_t *algo, void *output, size_t outlen, ptls_iovec_t prk, ptls_iovec_t info)+{+    ptls_hash_context_t *hmac = NULL;+    size_t i;+    uint8_t digest[PTLS_MAX_DIGEST_SIZE];++    for (i = 0; (i * algo->digest_size) < outlen; ++i) {+        if (hmac == NULL) {+            if ((hmac = ptls_hmac_create(algo, prk.base, prk.len)) == NULL)+                return PTLS_ERROR_NO_MEMORY;+        } else {+            hmac->update(hmac, digest, algo->digest_size);+        }+        hmac->update(hmac, info.base, info.len);+        uint8_t gen = (uint8_t)(i + 1);+        hmac->update(hmac, &gen, 1);+        hmac->final(hmac, digest, 1);++        size_t off_start = i * algo->digest_size, off_end = off_start + algo->digest_size;+        if (off_end > outlen)+            off_end = outlen;+        memcpy((uint8_t *)output + off_start, digest, off_end - off_start);+    }++    if (hmac != NULL)+        hmac->final(hmac, NULL, PTLS_HASH_FINAL_MODE_FREE);++    ptls_clear_memory(digest, algo->digest_size);++    return 0;+}++int hkdf_expand_label(ptls_hash_algorithm_t *algo, void *output, size_t outlen, ptls_iovec_t secret, const char *label,+                      ptls_iovec_t hash_value, const char *label_prefix)+{+    ptls_buffer_t hkdf_label;+    uint8_t hkdf_label_buf[80];+    int ret;++    assert(label_prefix != NULL);++    ptls_buffer_init(&hkdf_label, hkdf_label_buf, sizeof(hkdf_label_buf));++    ptls_buffer_push16(&hkdf_label, (uint16_t)outlen);+    ptls_buffer_push_block(&hkdf_label, 1, {+        ptls_buffer_pushv(&hkdf_label, label_prefix, strlen(label_prefix));+        ptls_buffer_pushv(&hkdf_label, label, strlen(label));+    });+    ptls_buffer_push_block(&hkdf_label, 1, { ptls_buffer_pushv(&hkdf_label, hash_value.base, hash_value.len); });++    ret = ptls_hkdf_expand(algo, output, outlen, secret, ptls_iovec_init(hkdf_label.base, hkdf_label.off));++Exit:+    ptls_buffer_dispose(&hkdf_label);+    return ret;+}++int ptls_hkdf_expand_label(ptls_hash_algorithm_t *algo, void *output, size_t outlen, ptls_iovec_t secret, const char *label,+                           ptls_iovec_t hash_value, const char *label_prefix)+{+    /* the handshake layer should call hkdf_expand_label directly, always setting key_schedule->hkdf_label_prefix as the+     * argument */+    if (label_prefix == NULL)+        label_prefix = PTLS_HKDF_EXPAND_LABEL_PREFIX;+    return hkdf_expand_label(algo, output, outlen, secret, label, hash_value, label_prefix);+}++ptls_cipher_context_t *ptls_cipher_new(ptls_cipher_algorithm_t *algo, int is_enc, const void *key)+{+    ptls_cipher_context_t *ctx;++    if ((ctx = (ptls_cipher_context_t *)malloc(algo->context_size)) == NULL)+        return NULL;+    *ctx = (ptls_cipher_context_t){algo};+    if (algo->setup_crypto(ctx, is_enc, key) != 0) {+        free(ctx);+        ctx = NULL;+    }+    return ctx;+}++void ptls_cipher_free(ptls_cipher_context_t *ctx)+{+    ctx->do_dispose(ctx);+    free(ctx);+}++ptls_aead_context_t *new_aead(ptls_aead_algorithm_t *aead, ptls_hash_algorithm_t *hash, int is_enc, const void *secret,+                              ptls_iovec_t hash_value, const char *label_prefix)+{+    ptls_aead_context_t *ctx = NULL;+    uint8_t key_iv[PTLS_MAX_SECRET_SIZE + PTLS_MAX_IV_SIZE];+    int ret;++    if ((ret = get_traffic_key(hash, key_iv, aead->key_size, 0, secret, hash_value, label_prefix)) != 0)+        goto Exit;+    if ((ret = get_traffic_key(hash, key_iv + aead->key_size, aead->iv_size, 1, secret, hash_value, label_prefix)) != 0)+        goto Exit;+    ctx = ptls_aead_new_direct(aead, is_enc, key_iv, key_iv + aead->key_size);++Exit:+    ptls_clear_memory(key_iv, sizeof(key_iv));+    return ctx;+}++ptls_aead_context_t *ptls_aead_new(ptls_aead_algorithm_t *aead, ptls_hash_algorithm_t *hash, int is_enc, const void *secret,+                                   const char *label_prefix)+{+    return new_aead(aead, hash, is_enc, secret, ptls_iovec_init(NULL, 0), label_prefix);+}++ptls_aead_context_t *ptls_aead_new_direct(ptls_aead_algorithm_t *aead, int is_enc, const void *key, const void *iv)+{+    ptls_aead_context_t *ctx;++    if ((ctx = (ptls_aead_context_t *)malloc(aead->context_size)) == NULL)+        return NULL;++    *ctx = (ptls_aead_context_t){aead};++    if (aead->setup_crypto(ctx, is_enc, key, iv) != 0) {+        free(ctx);+        return NULL;+    }++    return ctx;+}++void ptls_aead_free(ptls_aead_context_t *ctx)+{+    ctx->dispose_crypto(ctx);+    free(ctx);+}++void ptls_aead__build_iv(ptls_aead_algorithm_t *algo, uint8_t *iv, const uint8_t *static_iv, uint64_t seq)+{+    size_t iv_size = algo->iv_size, i;+    const uint8_t *s = static_iv;+    uint8_t *d = iv;++    /* build iv */+    for (i = iv_size - 8; i != 0; --i)+        *d++ = *s++;+    i = 64;+    do {+        i -= 8;+        *d++ = *s++ ^ (uint8_t)(seq >> i);+    } while (i != 0);+}++static void clear_memory(void *p, size_t len)+{+    if (len != 0)+        memset(p, 0, len);+}++void (*volatile ptls_clear_memory)(void *p, size_t len) = clear_memory;++static int mem_equal(const void *_x, const void *_y, size_t len)+{+    const volatile uint8_t *x = _x, *y = _y;+    uint8_t t = 0;++    for (; len != 0; --len)+        t |= *x++ ^ *y++;++    return t == 0;+}++int (*volatile ptls_mem_equal)(const void *x, const void *y, size_t len) = mem_equal;++static uint64_t get_time(ptls_get_time_t *self)+{+    struct timeval tv;+    gettimeofday(&tv, NULL);+    return (uint64_t)tv.tv_sec * 1000 + tv.tv_usec / 1000;+}++ptls_get_time_t ptls_get_time = {get_time};+#if PICOTLS_USE_DTRACE+PTLS_THREADLOCAL unsigned ptls_default_skip_tracing = 0;+#endif++int ptls_is_server(ptls_t *tls)+{+    return tls->is_server;+}++struct st_ptls_raw_message_emitter_t {+    ptls_message_emitter_t super;+    size_t start_off;+    size_t *epoch_offsets;+};++static int begin_raw_message(ptls_message_emitter_t *_self)+{+    struct st_ptls_raw_message_emitter_t *self = (void *)_self;++    self->start_off = self->super.buf->off;+    return 0;+}++static int commit_raw_message(ptls_message_emitter_t *_self)+{+    struct st_ptls_raw_message_emitter_t *self = (void *)_self;+    size_t epoch;++    /* epoch is the key epoch, with the only exception being 2nd CH generated after 0-RTT key */+    epoch = self->super.enc->epoch;+    if (epoch == 1 && self->super.buf->base[self->start_off] == PTLS_HANDSHAKE_TYPE_CLIENT_HELLO)+        epoch = 0;++    for (++epoch; epoch < 5; ++epoch) {+        assert(self->epoch_offsets[epoch] == self->start_off);+        self->epoch_offsets[epoch] = self->super.buf->off;+    }++    self->start_off = SIZE_MAX;++    return 0;+}++size_t ptls_get_read_epoch(ptls_t *tls)+{+    switch (tls->state) {+    case PTLS_STATE_CLIENT_HANDSHAKE_START:+    case PTLS_STATE_CLIENT_EXPECT_SERVER_HELLO:+    case PTLS_STATE_CLIENT_EXPECT_SECOND_SERVER_HELLO:+    case PTLS_STATE_SERVER_EXPECT_CLIENT_HELLO:+    case PTLS_STATE_SERVER_EXPECT_SECOND_CLIENT_HELLO:+        return 0; /* plaintext */+    case PTLS_STATE_SERVER_EXPECT_END_OF_EARLY_DATA:+        assert(!tls->ctx->omit_end_of_early_data);+        return 1; /* 0-rtt */+    case PTLS_STATE_CLIENT_EXPECT_ENCRYPTED_EXTENSIONS:+    case PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_REQUEST_OR_CERTIFICATE:+    case PTLS_STATE_CLIENT_EXPECT_CERTIFICATE:+    case PTLS_STATE_CLIENT_EXPECT_CERTIFICATE_VERIFY:+    case PTLS_STATE_CLIENT_EXPECT_FINISHED:+    case PTLS_STATE_SERVER_EXPECT_CERTIFICATE:+    case PTLS_STATE_SERVER_EXPECT_CERTIFICATE_VERIFY:+    case PTLS_STATE_SERVER_EXPECT_FINISHED:+        return 2; /* handshake */+    case PTLS_STATE_CLIENT_POST_HANDSHAKE:+    case PTLS_STATE_SERVER_POST_HANDSHAKE:+        return 3; /* 1-rtt */+    default:+        assert(!"invalid state");+        return SIZE_MAX;+    }+}++int ptls_handle_message(ptls_t *tls, ptls_buffer_t *sendbuf, size_t epoch_offsets[5], size_t in_epoch, const void *input,+                        size_t inlen, ptls_handshake_properties_t *properties)+{+    return tls->is_server ? ptls_server_handle_message(tls, sendbuf, epoch_offsets, in_epoch, input, inlen, properties)+                          : ptls_client_handle_message(tls, sendbuf, epoch_offsets, in_epoch, input, inlen, properties);+}++int ptls_client_handle_message(ptls_t *tls, ptls_buffer_t *sendbuf, size_t epoch_offsets[5], size_t in_epoch, const void *input,+                               size_t inlen, ptls_handshake_properties_t *properties)+{+    assert(!tls->is_server);++    struct st_ptls_raw_message_emitter_t emitter = {+        {sendbuf, &tls->traffic_protection.enc, 0, begin_raw_message, commit_raw_message}, SIZE_MAX, epoch_offsets};+    struct st_ptls_record_t rec = {PTLS_CONTENT_TYPE_HANDSHAKE, 0, inlen, input};++    if (input == NULL)+        return send_client_hello(tls, &emitter.super, properties, NULL);++    if (ptls_get_read_epoch(tls) != in_epoch)+        return PTLS_ALERT_UNEXPECTED_MESSAGE;++    return handle_handshake_record(tls, handle_client_handshake_message, &emitter.super, &rec, properties);+}++int ptls_server_handle_message(ptls_t *tls, ptls_buffer_t *sendbuf, size_t epoch_offsets[5], size_t in_epoch, const void *input,+                               size_t inlen, ptls_handshake_properties_t *properties)+{+    assert(tls->is_server);++    struct st_ptls_raw_message_emitter_t emitter = {+        {sendbuf, &tls->traffic_protection.enc, 0, begin_raw_message, commit_raw_message}, SIZE_MAX, epoch_offsets};+    struct st_ptls_record_t rec = {PTLS_CONTENT_TYPE_HANDSHAKE, 0, inlen, input};++    assert(input);++    if (ptls_get_read_epoch(tls) != in_epoch)+        return PTLS_ALERT_UNEXPECTED_MESSAGE;++    return handle_handshake_record(tls, handle_server_handshake_message, &emitter.super, &rec, properties);+}++int ptls_esni_init_context(ptls_context_t *ctx, ptls_esni_context_t *esni, ptls_iovec_t esni_keys,+                           ptls_key_exchange_context_t **key_exchanges)+{+    const uint8_t *src = esni_keys.base, *const end = src + esni_keys.len;+    size_t num_key_exchanges, num_cipher_suites = 0;+    int ret;++    for (num_key_exchanges = 0; key_exchanges[num_key_exchanges] != NULL; ++num_key_exchanges)+        ;++    memset(esni, 0, sizeof(*esni));+    if ((esni->key_exchanges = malloc(sizeof(*esni->key_exchanges) * (num_key_exchanges + 1))) == NULL) {+        ret = PTLS_ERROR_NO_MEMORY;+        goto Exit;+    }+    memcpy(esni->key_exchanges, key_exchanges, sizeof(*esni->key_exchanges) * (num_key_exchanges + 1));++    /* ESNIKeys */+    if ((ret = ptls_decode16(&esni->version, &src, end)) != 0)+        goto Exit;+    /* Skip checksum fields */+    if (end - src < 4) {+        ret = PTLS_ALERT_DECRYPT_ERROR;+        goto Exit;+    }+    src += 4;+    /* Published SNI field */+    ptls_decode_open_block(src, end, 2, { src = end; });++    /* Process the list of KeyShareEntries, verify for each of them that the ciphersuite is supported. */+    ptls_decode_open_block(src, end, 2, {+        do {+            /* parse */+            uint16_t id;+            if ((ret = ptls_decode16(&id, &src, end)) != 0)+                goto Exit;+            ptls_decode_open_block(src, end, 2, { src = end; });+            /* check that matching key-share exists */+            ptls_key_exchange_context_t **found;+            for (found = key_exchanges; *found != NULL; ++found)+                if ((*found)->algo->id == id)+                    break;+            if (found == NULL) {+                ret = PTLS_ERROR_INCOMPATIBLE_KEY;+                goto Exit;+            }+        } while (src != end);+    });+    /* Process the list of cipher_suites. If they are supported, store in esni context  */+    ptls_decode_open_block(src, end, 2, {+        void *newp;+        do {+            uint16_t id;+            if ((ret = ptls_decode16(&id, &src, end)) != 0)+                goto Exit;+            size_t i;+            for (i = 0; ctx->cipher_suites[i] != NULL; ++i)+                if (ctx->cipher_suites[i]->id == id)+                    break;+            if (ctx->cipher_suites[i] != NULL) {+                if ((newp = realloc(esni->cipher_suites, sizeof(*esni->cipher_suites) * (num_cipher_suites + 1))) == NULL) {+                    ret = PTLS_ERROR_NO_MEMORY;+                    goto Exit;+                }+                esni->cipher_suites = newp;+                esni->cipher_suites[num_cipher_suites++].cipher_suite = ctx->cipher_suites[i];+            }+        } while (src != end);+        if ((newp = realloc(esni->cipher_suites, sizeof(*esni->cipher_suites) * (num_cipher_suites + 1))) == NULL) {+            ret = PTLS_ERROR_NO_MEMORY;+            goto Exit;+        }+        esni->cipher_suites = newp;+        esni->cipher_suites[num_cipher_suites].cipher_suite = NULL;+    });+    /* Parse the padded length, not before, not after parameters */+    if ((ret = ptls_decode16(&esni->padded_length, &src, end)) != 0)+        goto Exit;+    if ((ret = ptls_decode64(&esni->not_before, &src, end)) != 0)+        goto Exit;+    if ((ret = ptls_decode64(&esni->not_after, &src, end)) != 0)+        goto Exit;+    /* Skip the extension fields */+    ptls_decode_block(src, end, 2, {+        while (src != end) {+            uint16_t ext_type;+            if ((ret = ptls_decode16(&ext_type, &src, end)) != 0)+                goto Exit;+            ptls_decode_open_block(src, end, 2, { src = end; });+        }+    });++    { /* calculate digests for every cipher-suite */+        size_t i;+        for (i = 0; esni->cipher_suites[i].cipher_suite != NULL; ++i) {+            if ((ret = ptls_calc_hash(esni->cipher_suites[i].cipher_suite->hash, esni->cipher_suites[i].record_digest,+                                      esni_keys.base, esni_keys.len)) != 0)+                goto Exit;+        }+    }++    ret = 0;+Exit:+    if (ret != 0)+        ptls_esni_dispose_context(esni);+    return ret;+}++void ptls_esni_dispose_context(ptls_esni_context_t *esni)+{+    size_t i;++    if (esni->key_exchanges != NULL) {+        for (i = 0; esni->key_exchanges[i] != NULL; ++i)+            esni->key_exchanges[i]->on_exchange(esni->key_exchanges + i, 1, NULL, ptls_iovec_init(NULL, 0));+        free(esni->key_exchanges);+    }+    free(esni->cipher_suites);+}++/**+ * Obtain the ESNI secrets negotiated during the handshake.+ */+ptls_esni_secret_t *ptls_get_esni_secret(ptls_t *ctx)+{+    return ctx->esni;+}++/**+ * checks if given name looks like an IP address+ */+int ptls_server_name_is_ipaddr(const char *name)+{+#ifdef AF_INET+    struct sockaddr_in sin;+    if (inet_pton(AF_INET, name, &sin) == 1)+        return 1;+#endif+#ifdef AF_INET6+    struct sockaddr_in6 sin6;+    if (inet_pton(AF_INET6, name, &sin6) == 1)+        return 1;+#endif+    return 0;+}++char *ptls_hexdump(char *buf, const void *_src, size_t len)+{+    char *dst = buf;+    const uint8_t *src = _src;+    size_t i;++    for (i = 0; i != len; ++i) {+        *dst++ = "0123456789abcdef"[src[i] >> 4];+        *dst++ = "0123456789abcdef"[src[i] & 0xf];+    }+    *dst++ = '\0';+    return buf;+}
+ cbits/picotls.h view
@@ -0,0 +1,1593 @@+/*+ * Copyright (c) 2016 DeNA Co., Ltd., Kazuho Oku+ *+ * Permission is hereby granted, free of charge, to any person obtaining a copy+ * of this software and associated documentation files (the "Software"), to+ * deal in the Software without restriction, including without limitation the+ * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+ * sell copies of the Software, and to permit persons to whom the Software is+ * furnished to do so, subject to the following conditions:+ *+ * The above copyright notice and this permission notice shall be included in+ * all copies or substantial portions of the Software.+ *+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+ * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+ * IN THE SOFTWARE.+ */+#ifndef picotls_h+#define picotls_h++#ifdef __cplusplus+extern "C" {+#endif++#ifdef _WINDOWS+#include "wincompat.h"+#endif++#include <assert.h>+#include <inttypes.h>+#include <string.h>+#include <sys/types.h>++#if __GNUC__ >= 3+#define PTLS_LIKELY(x) __builtin_expect(!!(x), 1)+#define PTLS_UNLIKELY(x) __builtin_expect(!!(x), 0)+#define PTLS_BUILD_ASSERT_EXPR(cond) (sizeof(char[2 * !!(!__builtin_constant_p(cond) || (cond)) - 1]) != 0)+#define PTLS_BUILD_ASSERT(cond) ((void)PTLS_BUILD_ASSERT_EXPR(cond))+#else+#define PTLS_LIKELY(x) (x)+#define PTLS_UNLIKELY(x) (x)+#define PTLS_BUILD_ASSERT(cond) 1+#endif++/* __builtin_types_compatible_p yields incorrect results when older versions of GCC is used; see #303.+ * Clang with Xcode 9.4 or prior is known to not work correctly when a pointer is const-qualified; see+ * https://github.com/h2o/quicly/pull/306#issuecomment-626037269. Older versions of clang upstream works fine, but we do not need+ * best coverage. This macro is for preventing misuse going into the master branch, having it work one of the compilers supported in+ * our CI is enough.+ */+#if ((defined(__clang__) && __clang_major__ >= 10) || __GNUC__ >= 6) && !defined(__cplusplus)+#define PTLS_ASSERT_IS_ARRAY_EXPR(a) PTLS_BUILD_ASSERT_EXPR(__builtin_types_compatible_p(__typeof__(a[0])[], __typeof__(a)))+#else+#define PTLS_ASSERT_IS_ARRAY_EXPR(a) 1+#endif++#define PTLS_ELEMENTSOF(x) (PTLS_ASSERT_IS_ARRAY_EXPR(x) * sizeof(x) / sizeof((x)[0]))++#ifdef _WINDOWS+#define PTLS_THREADLOCAL __declspec(thread)+#else+#define PTLS_THREADLOCAL __thread+#endif++#ifndef PTLS_FUZZ_HANDSHAKE+#define PTLS_FUZZ_HANDSHAKE 0+#endif++#define PTLS_HELLO_RANDOM_SIZE 32++#define PTLS_AES128_KEY_SIZE 16+#define PTLS_AES256_KEY_SIZE 32+#define PTLS_AES_BLOCK_SIZE 16+#define PTLS_AES_IV_SIZE 16+#define PTLS_AESGCM_IV_SIZE 12+#define PTLS_AESGCM_TAG_SIZE 16+#define PTLS_AESGCM_CONFIDENTIALITY_LIMIT 0x2000000            /* 2^25 */+#define PTLS_AESGCM_INTEGRITY_LIMIT UINT64_C(0x40000000000000) /* 2^54 */+#define PTLS_AESCCM_CONFIDENTIALITY_LIMIT 0xB504F3             /* 2^23.5 */+#define PTLS_AESCCM_INTEGRITY_LIMIT 0xB504F3                   /* 2^23.5 */++#define PTLS_CHACHA20_KEY_SIZE 32+#define PTLS_CHACHA20_IV_SIZE 16+#define PTLS_CHACHA20POLY1305_IV_SIZE 12+#define PTLS_CHACHA20POLY1305_TAG_SIZE 16+#define PTLS_CHACHA20POLY1305_CONFIDENTIALITY_LIMIT UINT64_MAX       /* at least 2^64 */+#define PTLS_CHACHA20POLY1305_INTEGRITY_LIMIT UINT64_C(0x1000000000) /* 2^36 */++#define PTLS_BLOWFISH_KEY_SIZE 16+#define PTLS_BLOWFISH_BLOCK_SIZE 8++#define PTLS_SHA256_BLOCK_SIZE 64+#define PTLS_SHA256_DIGEST_SIZE 32++#define PTLS_SHA384_BLOCK_SIZE 128+#define PTLS_SHA384_DIGEST_SIZE 48++#define PTLS_MAX_SECRET_SIZE 32+#define PTLS_MAX_IV_SIZE 16+#define PTLS_MAX_DIGEST_SIZE 64++/* cipher-suites */+#define PTLS_CIPHER_SUITE_AES_128_GCM_SHA256 0x1301+#define PTLS_CIPHER_SUITE_NAME_AES_128_GCM_SHA256 "TLS_AES_128_GCM_SHA256"+#define PTLS_CIPHER_SUITE_AES_256_GCM_SHA384 0x1302+#define PTLS_CIPHER_SUITE_NAME_AES_256_GCM_SHA384 "TLS_AES_256_GCM_SHA384"+#define PTLS_CIPHER_SUITE_CHACHA20_POLY1305_SHA256 0x1303+#define PTLS_CIPHER_SUITE_NAME_CHACHA20_POLY1305_SHA256 "TLS_CHACHA20_POLY1305_SHA256"++/* negotiated_groups */+#define PTLS_GROUP_SECP256R1 23+#define PTLS_GROUP_NAME_SECP256R1 "scep256r1"+#define PTLS_GROUP_SECP384R1 24+#define PTLS_GROUP_NAME_SECP384R1 "secp384r1"+#define PTLS_GROUP_SECP521R1 25+#define PTLS_GROUP_NAME_SECP521R1 "secp521r1"+#define PTLS_GROUP_X25519 29+#define PTLS_GROUP_NAME_X25519 "x25519"+#define PTLS_GROUP_X448 30+#define PTLS_GROUP_NAME_X448 "x448"++/* signature algorithms */+#define PTLS_SIGNATURE_RSA_PKCS1_SHA1 0x0201+#define PTLS_SIGNATURE_RSA_PKCS1_SHA256 0x0401+#define PTLS_SIGNATURE_ECDSA_SECP256R1_SHA256 0x0403+#define PTLS_SIGNATURE_ECDSA_SECP384R1_SHA384 0x0503+#define PTLS_SIGNATURE_ECDSA_SECP521R1_SHA512 0x0603+#define PTLS_SIGNATURE_RSA_PSS_RSAE_SHA256 0x0804+#define PTLS_SIGNATURE_RSA_PSS_RSAE_SHA384 0x0805+#define PTLS_SIGNATURE_RSA_PSS_RSAE_SHA512 0x0806+#define PTLS_SIGNATURE_ED25519 0x0807++/* ESNI */+#define PTLS_ESNI_VERSION_DRAFT03 0xff02++#define PTLS_ESNI_RESPONSE_TYPE_ACCEPT 0+#define PTLS_ESNI_RESPONSE_TYPE_RETRY_REQUEST 1++/* error classes and macros */+#define PTLS_ERROR_CLASS_SELF_ALERT 0+#define PTLS_ERROR_CLASS_PEER_ALERT 0x100+#define PTLS_ERROR_CLASS_INTERNAL 0x200++#define PTLS_ERROR_GET_CLASS(e) ((e) & ~0xff)+#define PTLS_ALERT_TO_SELF_ERROR(e) ((e) + PTLS_ERROR_CLASS_SELF_ALERT)+#define PTLS_ALERT_TO_PEER_ERROR(e) ((e) + PTLS_ERROR_CLASS_PEER_ALERT)+#define PTLS_ERROR_TO_ALERT(e) ((e)&0xff)++/* the HKDF prefix */+#define PTLS_HKDF_EXPAND_LABEL_PREFIX "tls13 "++/* alerts */+#define PTLS_ALERT_LEVEL_WARNING 1+#define PTLS_ALERT_LEVEL_FATAL 2++#define PTLS_ALERT_CLOSE_NOTIFY 0+#define PTLS_ALERT_UNEXPECTED_MESSAGE 10+#define PTLS_ALERT_BAD_RECORD_MAC 20+#define PTLS_ALERT_HANDSHAKE_FAILURE 40+#define PTLS_ALERT_BAD_CERTIFICATE 42+#define PTLS_ALERT_UNSUPPORTED_CERTIFICATE 43+#define PTLS_ALERT_CERTIFICATE_REVOKED 44+#define PTLS_ALERT_CERTIFICATE_EXPIRED 45+#define PTLS_ALERT_CERTIFICATE_UNKNOWN 46+#define PTLS_ALERT_ILLEGAL_PARAMETER 47+#define PTLS_ALERT_UNKNOWN_CA 48+#define PTLS_ALERT_DECODE_ERROR 50+#define PTLS_ALERT_DECRYPT_ERROR 51+#define PTLS_ALERT_PROTOCOL_VERSION 70+#define PTLS_ALERT_INTERNAL_ERROR 80+#define PTLS_ALERT_USER_CANCELED 90+#define PTLS_ALERT_MISSING_EXTENSION 109+#define PTLS_ALERT_UNRECOGNIZED_NAME 112+#define PTLS_ALERT_CERTIFICATE_REQUIRED 116+#define PTLS_ALERT_NO_APPLICATION_PROTOCOL 120++/* internal errors */+#define PTLS_ERROR_NO_MEMORY (PTLS_ERROR_CLASS_INTERNAL + 1)+#define PTLS_ERROR_IN_PROGRESS (PTLS_ERROR_CLASS_INTERNAL + 2)+#define PTLS_ERROR_LIBRARY (PTLS_ERROR_CLASS_INTERNAL + 3)+#define PTLS_ERROR_INCOMPATIBLE_KEY (PTLS_ERROR_CLASS_INTERNAL + 4)+#define PTLS_ERROR_SESSION_NOT_FOUND (PTLS_ERROR_CLASS_INTERNAL + 5)+#define PTLS_ERROR_STATELESS_RETRY (PTLS_ERROR_CLASS_INTERNAL + 6)+#define PTLS_ERROR_NOT_AVAILABLE (PTLS_ERROR_CLASS_INTERNAL + 7)+#define PTLS_ERROR_COMPRESSION_FAILURE (PTLS_ERROR_CLASS_INTERNAL + 8)+#define PTLS_ERROR_ESNI_RETRY (PTLS_ERROR_CLASS_INTERNAL + 8)+#define PTLS_ERROR_REJECT_EARLY_DATA (PTLS_ERROR_CLASS_INTERNAL + 9)+#define PTLS_ERROR_DELEGATE (PTLS_ERROR_CLASS_INTERNAL + 10)++#define PTLS_ERROR_INCORRECT_BASE64 (PTLS_ERROR_CLASS_INTERNAL + 50)+#define PTLS_ERROR_PEM_LABEL_NOT_FOUND (PTLS_ERROR_CLASS_INTERNAL + 51)+#define PTLS_ERROR_BER_INCORRECT_ENCODING (PTLS_ERROR_CLASS_INTERNAL + 52)+#define PTLS_ERROR_BER_MALFORMED_TYPE (PTLS_ERROR_CLASS_INTERNAL + 53)+#define PTLS_ERROR_BER_MALFORMED_LENGTH (PTLS_ERROR_CLASS_INTERNAL + 54)+#define PTLS_ERROR_BER_EXCESSIVE_LENGTH (PTLS_ERROR_CLASS_INTERNAL + 55)+#define PTLS_ERROR_BER_ELEMENT_TOO_SHORT (PTLS_ERROR_CLASS_INTERNAL + 56)+#define PTLS_ERROR_BER_UNEXPECTED_EOC (PTLS_ERROR_CLASS_INTERNAL + 57)+#define PTLS_ERROR_DER_INDEFINITE_LENGTH (PTLS_ERROR_CLASS_INTERNAL + 58)+#define PTLS_ERROR_INCORRECT_ASN1_SYNTAX (PTLS_ERROR_CLASS_INTERNAL + 59)+#define PTLS_ERROR_INCORRECT_PEM_KEY_VERSION (PTLS_ERROR_CLASS_INTERNAL + 60)+#define PTLS_ERROR_INCORRECT_PEM_ECDSA_KEY_VERSION (PTLS_ERROR_CLASS_INTERNAL + 61)+#define PTLS_ERROR_INCORRECT_PEM_ECDSA_CURVE (PTLS_ERROR_CLASS_INTERNAL + 62)+#define PTLS_ERROR_INCORRECT_PEM_ECDSA_KEYSIZE (PTLS_ERROR_CLASS_INTERNAL + 63)+#define PTLS_ERROR_INCORRECT_ASN1_ECDSA_KEY_SYNTAX (PTLS_ERROR_CLASS_INTERNAL + 64)++#define PTLS_HANDSHAKE_TYPE_CLIENT_HELLO 1+#define PTLS_HANDSHAKE_TYPE_SERVER_HELLO 2+#define PTLS_HANDSHAKE_TYPE_NEW_SESSION_TICKET 4+#define PTLS_HANDSHAKE_TYPE_END_OF_EARLY_DATA 5+#define PTLS_HANDSHAKE_TYPE_ENCRYPTED_EXTENSIONS 8+#define PTLS_HANDSHAKE_TYPE_CERTIFICATE 11+#define PTLS_HANDSHAKE_TYPE_CERTIFICATE_REQUEST 13+#define PTLS_HANDSHAKE_TYPE_CERTIFICATE_VERIFY 15+#define PTLS_HANDSHAKE_TYPE_FINISHED 20+#define PTLS_HANDSHAKE_TYPE_KEY_UPDATE 24+#define PTLS_HANDSHAKE_TYPE_COMPRESSED_CERTIFICATE 25+#define PTLS_HANDSHAKE_TYPE_MESSAGE_HASH 254++#define PTLS_CERTIFICATE_TYPE_X509 0+#define PTLS_CERTIFICATE_TYPE_RAW_PUBLIC_KEY 2++#define PTLS_ZERO_DIGEST_SHA256                                                                                                    \+    {                                                                                                                              \+        0xe3, 0xb0, 0xc4, 0x42, 0x98, 0xfc, 0x1c, 0x14, 0x9a, 0xfb, 0xf4, 0xc8, 0x99, 0x6f, 0xb9, 0x24, 0x27, 0xae, 0x41, 0xe4,    \+            0x64, 0x9b, 0x93, 0x4c, 0xa4, 0x95, 0x99, 0x1b, 0x78, 0x52, 0xb8, 0x55                                                 \+    }++#define PTLS_ZERO_DIGEST_SHA384                                                                                                    \+    {                                                                                                                              \+        0x38, 0xb0, 0x60, 0xa7, 0x51, 0xac, 0x96, 0x38, 0x4c, 0xd9, 0x32, 0x7e, 0xb1, 0xb1, 0xe3, 0x6a, 0x21, 0xfd, 0xb7, 0x11,    \+            0x14, 0xbe, 0x07, 0x43, 0x4c, 0x0c, 0xc7, 0xbf, 0x63, 0xf6, 0xe1, 0xda, 0x27, 0x4e, 0xde, 0xbf, 0xe7, 0x6f, 0x65,      \+            0xfb, 0xd5, 0x1a, 0xd2, 0xf1, 0x48, 0x98, 0xb9, 0x5b                                                                   \+    }++typedef struct st_ptls_t ptls_t;+typedef struct st_ptls_context_t ptls_context_t;+typedef struct st_ptls_key_schedule_t ptls_key_schedule_t;++/**+ * represents a sequence of octets+ */+typedef struct st_ptls_iovec_t {+    uint8_t *base;+    size_t len;+} ptls_iovec_t;++/**+ * used for storing output+ */+typedef struct st_ptls_buffer_t {+    uint8_t *base;+    size_t capacity;+    size_t off;+    int is_allocated;+} ptls_buffer_t;++/**+ * key exchange context built by ptls_key_exchange_algorithm::create.+ */+typedef struct st_ptls_key_exchange_context_t {+    /**+     * the underlying algorithm+     */+    const struct st_ptls_key_exchange_algorithm_t *algo;+    /**+     * the public key+     */+    ptls_iovec_t pubkey;+    /**+     * If `release` is set, the callee frees resources allocated to the context and set *keyex to NULL+     */+    int (*on_exchange)(struct st_ptls_key_exchange_context_t **keyex, int release, ptls_iovec_t *secret, ptls_iovec_t peerkey);+} ptls_key_exchange_context_t;++/**+ * A key exchange algorithm.+ */+typedef const struct st_ptls_key_exchange_algorithm_t {+    /**+     * ID defined by the TLS specification+     */+    uint16_t id;+    /**+     * creates a context for asynchronous key exchange. The function is called when ClientHello is generated. The on_exchange+     * callback of the created context is called when the client receives ServerHello.+     */+    int (*create)(const struct st_ptls_key_exchange_algorithm_t *algo, ptls_key_exchange_context_t **ctx);+    /**+     * implements synchronous key exchange. Called when receiving a ServerHello.+     */+    int (*exchange)(const struct st_ptls_key_exchange_algorithm_t *algo, ptls_iovec_t *pubkey, ptls_iovec_t *secret,+                    ptls_iovec_t peerkey);+    /**+     * crypto-specific data+     */+    intptr_t data;+    /**+     * Description as defined in the IANA TLS registry+     */+    const char *name;+} ptls_key_exchange_algorithm_t;++/**+ * context of a symmetric cipher+ */+typedef struct st_ptls_cipher_context_t {+    const struct st_ptls_cipher_algorithm_t *algo;+    /* field above this line must not be altered by the crypto binding */+    void (*do_dispose)(struct st_ptls_cipher_context_t *ctx);+    void (*do_init)(struct st_ptls_cipher_context_t *ctx, const void *iv);+    void (*do_transform)(struct st_ptls_cipher_context_t *ctx, void *output, const void *input, size_t len);+} ptls_cipher_context_t;++/**+ * a symmetric cipher+ */+typedef const struct st_ptls_cipher_algorithm_t {+    const char *name;+    size_t key_size;+    size_t block_size;+    size_t iv_size;+    size_t context_size;+    int (*setup_crypto)(ptls_cipher_context_t *ctx, int is_enc, const void *key);+} ptls_cipher_algorithm_t;++typedef struct st_ptls_aead_supplementary_encryption_t {+    ptls_cipher_context_t *ctx;+    const void *input;+    uint8_t output[16];+} ptls_aead_supplementary_encryption_t;++/**+ * AEAD context. AEAD implementations are allowed to stuff data at the end of the struct. The size of the memory allocated for the+ * struct is governed by ptls_aead_algorithm_t::context_size.+ */+typedef struct st_ptls_aead_context_t {+    const struct st_ptls_aead_algorithm_t *algo;+    /* field above this line must not be altered by the crypto binding */+    void (*dispose_crypto)(struct st_ptls_aead_context_t *ctx);+    void (*do_xor_iv)(struct st_ptls_aead_context_t *ctx, const void *bytes, size_t len);+    void (*do_encrypt_init)(struct st_ptls_aead_context_t *ctx, uint64_t seq, const void *aad, size_t aadlen);+    size_t (*do_encrypt_update)(struct st_ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen);+    size_t (*do_encrypt_final)(struct st_ptls_aead_context_t *ctx, void *output);+    void (*do_encrypt)(struct st_ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                       const void *aad, size_t aadlen, ptls_aead_supplementary_encryption_t *supp);+    size_t (*do_decrypt)(struct st_ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                         const void *aad, size_t aadlen);+} ptls_aead_context_t;++/**+ * An AEAD cipher.+ */+typedef const struct st_ptls_aead_algorithm_t {+    /**+     * name (following the convention of `openssl ciphers -v ALL`)+     */+    const char *name;+    /**+     * confidentiality_limit (max records / packets sent before re-key)+     */+    const uint64_t confidentiality_limit;+    /**+     * integrity_limit (max decryption failure records / packets before re-key)+     */+    const uint64_t integrity_limit;+    /**+     * the underlying key stream+     */+    ptls_cipher_algorithm_t *ctr_cipher;+    /**+     * the underlying ecb cipher (might not be available)+     */+    ptls_cipher_algorithm_t *ecb_cipher;+    /**+     * key size+     */+    size_t key_size;+    /**+     * size of the IV+     */+    size_t iv_size;+    /**+     * size of the tag+     */+    size_t tag_size;+    /**+     * size of memory allocated for ptls_aead_context_t. AEAD implementations can set this value to something greater than+     * sizeof(ptls_aead_context_t) and stuff additional data at the bottom of the struct.+     */+    size_t context_size;+    /**+     * callback that sets up the crypto+     */+    int (*setup_crypto)(ptls_aead_context_t *ctx, int is_enc, const void *key, const void *iv);+} ptls_aead_algorithm_t;++/**+ *+ */+typedef enum en_ptls_hash_final_mode_t {+    /**+     * obtains the digest and frees the context+     */+    PTLS_HASH_FINAL_MODE_FREE = 0,+    /**+     * obtains the digest and reset the context to initial state+     */+    PTLS_HASH_FINAL_MODE_RESET = 1,+    /**+     * obtains the digest while leaving the context as-is+     */+    PTLS_HASH_FINAL_MODE_SNAPSHOT = 2+} ptls_hash_final_mode_t;++/**+ * A hash context.+ */+typedef struct st_ptls_hash_context_t {+    /**+     * feeds additional data into the hash context+     */+    void (*update)(struct st_ptls_hash_context_t *ctx, const void *src, size_t len);+    /**+     * returns the digest and performs necessary operation specified by mode+     */+    void (*final)(struct st_ptls_hash_context_t *ctx, void *md, ptls_hash_final_mode_t mode);+    /**+     * creates a copy of the hash context+     */+    struct st_ptls_hash_context_t *(*clone_)(struct st_ptls_hash_context_t *src);+} ptls_hash_context_t;++/**+ * A hash algorithm and its properties.+ */+typedef const struct st_ptls_hash_algorithm_t {+    /**+     * block size+     */+    size_t block_size;+    /**+     * digest size+     */+    size_t digest_size;+    /**+     * constructor that creates the hash context+     */+    ptls_hash_context_t *(*create)(void);+    /**+     * digest of zero-length octets+     */+    uint8_t empty_digest[PTLS_MAX_DIGEST_SIZE];+} ptls_hash_algorithm_t;++typedef const struct st_ptls_cipher_suite_t {+    /**+     * ID as defined by the TLS Cipher Suites registry+     */+    uint16_t id;+    /**+     * underlying AEAD algorithm+     */+    ptls_aead_algorithm_t *aead;+    /**+     * underlying hash algorithm+     */+    ptls_hash_algorithm_t *hash;+    /**+     * value of the "Description" field of the TLS Cipher Suites registry+     */+    const char *name;+} ptls_cipher_suite_t;++struct st_ptls_traffic_protection_t;++typedef struct st_ptls_message_emitter_t {+    ptls_buffer_t *buf;+    struct st_ptls_traffic_protection_t *enc;+    size_t record_header_length;+    int (*begin_message)(struct st_ptls_message_emitter_t *self);+    int (*commit_message)(struct st_ptls_message_emitter_t *self);+} ptls_message_emitter_t;++/**+ * holds ESNIKeys and the private key (instantiated by ptls_esni_parse, freed using ptls_esni_dispose)+ */+typedef struct st_ptls_esni_context_t {+    ptls_key_exchange_context_t **key_exchanges;+    struct {+        ptls_cipher_suite_t *cipher_suite;+        uint8_t record_digest[PTLS_MAX_DIGEST_SIZE];+    } * cipher_suites;+    uint16_t padded_length;+    uint64_t not_before;+    uint64_t not_after;+    uint16_t version;+} ptls_esni_context_t;++/**+ * holds the ESNI secret, as exchanged during the handshake+ */++#define PTLS_ESNI_NONCE_SIZE 16++typedef struct st_ptls_esni_secret_t {+    ptls_iovec_t secret;+    uint8_t nonce[PTLS_ESNI_NONCE_SIZE];+    uint8_t esni_contents_hash[PTLS_MAX_DIGEST_SIZE];+    struct {+        ptls_key_exchange_algorithm_t *key_share;+        ptls_cipher_suite_t *cipher;+        ptls_iovec_t pubkey;+        uint8_t record_digest[PTLS_MAX_DIGEST_SIZE];+        uint16_t padded_length;+    } client;+    uint16_t version;+} ptls_esni_secret_t;++#define PTLS_CALLBACK_TYPE0(ret, name)                                                                                             \+    typedef struct st_ptls_##name##_t {                                                                                            \+        ret (*cb)(struct st_ptls_##name##_t * self);                                                                               \+    } ptls_##name##_t++#define PTLS_CALLBACK_TYPE(ret, name, ...)                                                                                         \+    typedef struct st_ptls_##name##_t {                                                                                            \+        ret (*cb)(struct st_ptls_##name##_t * self, __VA_ARGS__);                                                                  \+    } ptls_##name##_t++/**+ * arguments passsed to the on_client_hello callback+ */+typedef struct st_ptls_on_client_hello_parameters_t {+    /**+     * SNI value received from the client. The value is {NULL, 0} if the extension was absent.+     */+    ptls_iovec_t server_name;+    /**+     * Raw value of the client_hello message.+     */+    ptls_iovec_t raw_message;+    /**+     *+     */+    struct {+        ptls_iovec_t *list;+        size_t count;+    } negotiated_protocols;+    struct {+        const uint16_t *list;+        size_t count;+    } signature_algorithms;+    struct {+        const uint16_t *list;+        size_t count;+    } certificate_compression_algorithms;+    struct {+        const uint16_t *list;+        size_t count;+    } cipher_suites;+    struct {+        const uint8_t *list;+        size_t count;+    } server_certificate_types;+    /**+     * if ESNI was used+     */+    unsigned esni : 1;+    /**+     * set to 1 if ClientHello is too old (or too new) to be handled by picotls+     */+    unsigned incompatible_version : 1;+} ptls_on_client_hello_parameters_t;++/**+ * returns current time in milliseconds (ptls_get_time can be used to return the physical time)+ */+PTLS_CALLBACK_TYPE0(uint64_t, get_time);+/**+ * after receiving ClientHello, the core calls the optional callback to give a chance to the swap the context depending on the input+ * values. The callback is required to call `ptls_set_server_name` if an SNI extension needs to be sent to the client.+ */+PTLS_CALLBACK_TYPE(int, on_client_hello, ptls_t *tls, ptls_on_client_hello_parameters_t *params);+/**+ * callback to generate the certificate message. `ptls_context::certificates` are set when the callback is set to NULL.+ */+PTLS_CALLBACK_TYPE(int, emit_certificate, ptls_t *tls, ptls_message_emitter_t *emitter, ptls_key_schedule_t *key_sched,+                   ptls_iovec_t context, int push_status_request, const uint16_t *compress_algos, size_t num_compress_algos);+/**+ * when gerenating CertificateVerify, the core calls the callback to sign the handshake context using the certificate.+ */+PTLS_CALLBACK_TYPE(int, sign_certificate, ptls_t *tls, uint16_t *selected_algorithm, ptls_buffer_t *output, ptls_iovec_t input,+                   const uint16_t *algorithms, size_t num_algorithms);+/**+ * after receiving Certificate, the core calls the callback to verify the certificate chain and to obtain a pointer to a+ * callback that should be used for verifying CertificateVerify. If an error occurs between a successful return from this+ * callback to the invocation of the verify_sign callback, verify_sign is called with both data and sign set to an empty buffer.+ * The implementor of the callback should use that as the opportunity to free any temporary data allocated for the verify_sign+ * callback.+ */+typedef struct st_ptls_verify_certificate_t {+    int (*cb)(struct st_ptls_verify_certificate_t *self, ptls_t *tls,+              int (**verify_sign)(void *verify_ctx, uint16_t algo, ptls_iovec_t data, ptls_iovec_t sign), void **verify_data,+              ptls_iovec_t *certs, size_t num_certs);+    /**+     * list of signature algorithms being supported, terminated by UINT16_MAX+     */+    const uint16_t *algos;+} ptls_verify_certificate_t;+/**+ * Encrypt-and-signs (or verify-and-decrypts) a ticket (server-only).+ * When used for encryption (i.e., is_encrypt being set), the function should return 0 if successful, or else a non-zero value.+ * When used for decryption, the function should return 0 (successful), PTLS_ERROR_REJECT_EARLY_DATA (successful, but 0-RTT is+ * forbidden), or any other value to indicate failure.+ */+PTLS_CALLBACK_TYPE(int, encrypt_ticket, ptls_t *tls, int is_encrypt, ptls_buffer_t *dst, ptls_iovec_t src);+/**+ * saves a ticket (client-only)+ */+PTLS_CALLBACK_TYPE(int, save_ticket, ptls_t *tls, ptls_iovec_t input);+/**+ * event logging (incl. secret logging)+ */+typedef struct st_ptls_log_event_t {+    void (*cb)(struct st_ptls_log_event_t *self, ptls_t *tls, const char *type, const char *fmt, ...)+        __attribute__((format(printf, 4, 5)));+} ptls_log_event_t;+/**+ * reference counting+ */+PTLS_CALLBACK_TYPE(void, update_open_count, ssize_t delta);+/**+ * applications that have their own record layer can set this function to derive their own traffic keys from the traffic secret.+ * The cipher-suite that is being associated to the connection can be obtained by calling the ptls_get_cipher function.+ */+PTLS_CALLBACK_TYPE(int, update_traffic_key, ptls_t *tls, int is_enc, size_t epoch, const void *secret);+/**+ * callback for every extension detected during decoding+ */+PTLS_CALLBACK_TYPE(int, on_extension, ptls_t *tls, uint8_t hstype, uint16_t exttype, ptls_iovec_t extdata);+/**+ *+ */+typedef struct st_ptls_decompress_certificate_t {+    /**+     * list of supported algorithms terminated by UINT16_MAX+     */+    const uint16_t *supported_algorithms;+    /**+     * callback that decompresses the message+     */+    int (*cb)(struct st_ptls_decompress_certificate_t *self, ptls_t *tls, uint16_t algorithm, ptls_iovec_t output,+              ptls_iovec_t input);+} ptls_decompress_certificate_t;+/**+ * provides access to the ESNI shared secret (Zx).  API is subject to change.+ */+PTLS_CALLBACK_TYPE(int, update_esni_key, ptls_t *tls, ptls_iovec_t secret, ptls_hash_algorithm_t *hash,+                   const void *hashed_esni_contents);++/**+ * the configuration+ */+struct st_ptls_context_t {+    /**+     * PRNG to be used+     */+    void (*random_bytes)(void *buf, size_t len);+    /**+     *+     */+    ptls_get_time_t *get_time;+    /**+     * list of supported key-exchange algorithms terminated by NULL+     */+    ptls_key_exchange_algorithm_t **key_exchanges;+    /**+     * list of supported cipher-suites terminated by NULL+     */+    ptls_cipher_suite_t **cipher_suites;+    /**+     * list of certificates+     */+    struct {+        ptls_iovec_t *list;+        size_t count;+    } certificates;+    /**+     * list of ESNI data terminated by NULL+     */+    ptls_esni_context_t **esni;+    /**+     *+     */+    ptls_on_client_hello_t *on_client_hello;+    /**+     *+     */+    ptls_emit_certificate_t *emit_certificate;+    /**+     *+     */+    ptls_sign_certificate_t *sign_certificate;+    /**+     *+     */+    ptls_verify_certificate_t *verify_certificate;+    /**+     * lifetime of a session ticket (server-only)+     */+    uint32_t ticket_lifetime;+    /**+     * maximum permitted size of early data (server-only)+     */+    uint32_t max_early_data_size;+    /**+     * maximum size of the message buffer (default: 0 = unlimited = 3 + 2^24 bytes)+     */+    size_t max_buffer_size;+    /**+     * the field is obsolete; should be set to NULL for QUIC draft-17.  Note also that even though everybody did, it was incorrect+     * to set the value to "quic " in the earlier versions of the draft.+     */+    const char *hkdf_label_prefix__obsolete;+    /**+     * if set, psk handshakes use (ec)dhe+     */+    unsigned require_dhe_on_psk : 1;+    /**+     * if exporter master secrets should be recorded+     */+    unsigned use_exporter : 1;+    /**+     * if ChangeCipherSpec record should be sent during handshake. If the client sends CCS, the server sends one in response+     * regardless of the value of this flag. See RFC 8446 Appendix D.3.+     */+    unsigned send_change_cipher_spec : 1;+    /**+     * if set, the server requests client certificates+     * to authenticate the client.+     */+    unsigned require_client_authentication : 1;+    /**+     * if set, EOED will not be emitted or accepted+     */+    unsigned omit_end_of_early_data : 1;+    /**+     * This option turns on support for Raw Public Keys (RFC 7250).+     *+     * When running as a client, this option instructs the client to request the server to send raw public keys in place of X.509+     * certificate chain. The client should set its `certificate_verify` callback to one that is capable of validating the raw+     * public key that will be sent by the server.+     *+     * When running as a server, this option instructs the server to only handle clients requesting the use of raw public keys. If+     * the client does not, the handshake is rejected. Note however that the rejection happens only after the `on_client_hello`+     * callback is being called. Therefore, applications can support both X.509 and raw public keys by swapping `ptls_context_t` to+     * the correct one when that callback is being called (like handling swapping the contexts based on the value of SNI).+     */+    unsigned use_raw_public_keys : 1;+    /**+     * boolean indicating if the cipher-suite should be chosen based on server's preference+     */+    unsigned server_cipher_preference : 1;+    /**+     *+     */+    ptls_encrypt_ticket_t *encrypt_ticket;+    /**+     *+     */+    ptls_save_ticket_t *save_ticket;+    /**+     *+     */+    ptls_log_event_t *log_event;+    /**+     *+     */+    ptls_update_open_count_t *update_open_count;+    /**+     *+     */+    ptls_update_traffic_key_t *update_traffic_key;+    /**+     *+     */+    ptls_decompress_certificate_t *decompress_certificate;+    /**+     *+     */+    ptls_update_esni_key_t *update_esni_key;+    /**+     *+     */+    ptls_on_extension_t *on_extension;+};++typedef struct st_ptls_raw_extension_t {+    uint16_t type;+    ptls_iovec_t data;+} ptls_raw_extension_t;++typedef enum en_ptls_early_data_acceptance_t {+    PTLS_EARLY_DATA_ACCEPTANCE_UNKNOWN = 0,+    PTLS_EARLY_DATA_REJECTED,+    PTLS_EARLY_DATA_ACCEPTED+} ptls_early_data_acceptance_t;++/**+ * optional arguments to client-driven handshake+ */+#ifdef _WINDOWS+/* suppress warning C4201: nonstandard extension used: nameless struct/union */+#pragma warning(push)+#pragma warning(disable : 4201)+#endif+typedef struct st_ptls_handshake_properties_t {+    union {+        struct {+            /**+             * list of protocols offered through ALPN+             */+            struct {+                const ptls_iovec_t *list;+                size_t count;+            } negotiated_protocols;+            /**+             * session ticket sent to the application via save_ticket callback+             */+            ptls_iovec_t session_ticket;+            /**+             * pointer to store the maximum size of early-data that can be sent immediately. If set to non-NULL, the first call to+             * ptls_handshake (or ptls_handle_message) will set `*max_early_data` to the value obtained from the session ticket, or+             * to zero if early-data cannot be sent. If NULL, early data will not be used.+             */+            size_t *max_early_data_size;+            /**+             * If early-data has been accepted by peer, or if the state is still unknown. The state changes anytime after handshake+             * keys become available. Applications can peek the tri-state variable every time it calls `ptls_hanshake` or+             * `ptls_handle_message` to determine the result at the earliest moment. This is an output parameter.+             */+            ptls_early_data_acceptance_t early_data_acceptance;+            /**+             * negotiate the key exchange method before sending key_share+             */+            unsigned negotiate_before_key_exchange : 1;+            /**+             * ESNIKeys (the value of the TXT record, after being base64-"decoded")+             */+            ptls_iovec_t esni_keys;+        } client;+        struct {+            /**+             * psk binder being selected (len is set to zero if none)+             */+            struct {+                uint8_t base[PTLS_MAX_DIGEST_SIZE];+                size_t len;+            } selected_psk_binder;+            /**+             * parameters related to use of the Cookie extension+             */+            struct {+                /**+                 * HMAC key to protect the integrity of the cookie. The key should be as long as the digest size of the first+                 * ciphersuite specified in ptls_context_t (i.e. the hash algorithm of the best ciphersuite that can be chosen).+                 */+                const void *key;+                /**+                 * additional data to be used for verifying the cookie+                 */+                ptls_iovec_t additional_data;+            } cookie;+            /**+             * if HRR should always be sent+             */+            unsigned enforce_retry : 1;+            /**+             * if retry should be stateless (cookie.key MUST be set when this option is used)+             */+            unsigned retry_uses_cookie : 1;+        } server;+    };+    /**+     * an optional list of additional extensions to send either in CH or EE, terminated by type == UINT16_MAX+     */+    ptls_raw_extension_t *additional_extensions;+    /**+     * an optional callback that returns a boolean value indicating if a particular extension should be collected+     */+    int (*collect_extension)(ptls_t *tls, struct st_ptls_handshake_properties_t *properties, uint16_t type);+    /**+     * an optional callback that reports the extensions being collected+     */+    int (*collected_extensions)(ptls_t *tls, struct st_ptls_handshake_properties_t *properties, ptls_raw_extension_t *extensions);+} ptls_handshake_properties_t;+#ifdef _WINDOWS+#pragma warning(pop)+#endif+#ifdef _WINDOWS+/* suppress warning C4293: >> shift count negative or too big */+#pragma warning(disable : 4293)+#endif+/**+ * builds a new ptls_iovec_t instance using the supplied parameters+ */+static ptls_iovec_t ptls_iovec_init(const void *p, size_t len);+/**+ * initializes a buffer, setting the default destination to the small buffer provided as the argument.+ */+static void ptls_buffer_init(ptls_buffer_t *buf, void *smallbuf, size_t smallbuf_size);+/**+ * disposes a buffer, freeing resources allocated by the buffer itself (if any)+ */+static void ptls_buffer_dispose(ptls_buffer_t *buf);+/**+ * internal+ */+void ptls_buffer__release_memory(ptls_buffer_t *buf);+/**+ * reserves space for additional amount of memory+ */+int ptls_buffer_reserve(ptls_buffer_t *buf, size_t delta);+/**+ * internal+ */+int ptls_buffer__do_pushv(ptls_buffer_t *buf, const void *src, size_t len);+/**+ * internal+ */+int ptls_buffer__adjust_quic_blocksize(ptls_buffer_t *buf, size_t body_size);+/**+ * internal+ */+int ptls_buffer__adjust_asn1_blocksize(ptls_buffer_t *buf, size_t body_size);+/**+ * pushes an unsigned bigint+ */+int ptls_buffer_push_asn1_ubigint(ptls_buffer_t *buf, const void *bignum, size_t size);+/**+ * encodes a quic varint (maximum length is PTLS_ENCODE_QUICINT_CAPACITY)+ */+static uint8_t *ptls_encode_quicint(uint8_t *p, uint64_t v);+#define PTLS_ENCODE_QUICINT_CAPACITY 8++#define ptls_buffer_pushv(buf, src, len)                                                                                           \+    do {                                                                                                                           \+        if ((ret = ptls_buffer__do_pushv((buf), (src), (len))) != 0)                                                               \+            goto Exit;                                                                                                             \+    } while (0)++#define ptls_buffer_push(buf, ...)                                                                                                 \+    do {                                                                                                                           \+        if ((ret = ptls_buffer__do_pushv((buf), (uint8_t[]){__VA_ARGS__}, sizeof((uint8_t[]){__VA_ARGS__}))) != 0)                 \+            goto Exit;                                                                                                             \+    } while (0)++#define ptls_buffer_push16(buf, v)                                                                                                 \+    do {                                                                                                                           \+        uint16_t _v = (v);                                                                                                         \+        ptls_buffer_push(buf, (uint8_t)(_v >> 8), (uint8_t)_v);                                                                    \+    } while (0)++#define ptls_buffer_push24(buf, v)                                                                                                 \+    do {                                                                                                                           \+        uint32_t _v = (v);                                                                                                         \+        ptls_buffer_push(buf, (uint8_t)(_v >> 16), (uint8_t)(_v >> 8), (uint8_t)_v);                                               \+    } while (0)++#define ptls_buffer_push32(buf, v)                                                                                                 \+    do {                                                                                                                           \+        uint32_t _v = (v);                                                                                                         \+        ptls_buffer_push(buf, (uint8_t)(_v >> 24), (uint8_t)(_v >> 16), (uint8_t)(_v >> 8), (uint8_t)_v);                          \+    } while (0)++#define ptls_buffer_push64(buf, v)                                                                                                 \+    do {                                                                                                                           \+        uint64_t _v = (v);                                                                                                         \+        ptls_buffer_push(buf, (uint8_t)(_v >> 56), (uint8_t)(_v >> 48), (uint8_t)(_v >> 40), (uint8_t)(_v >> 32),                  \+                         (uint8_t)(_v >> 24), (uint8_t)(_v >> 16), (uint8_t)(_v >> 8), (uint8_t)_v);                               \+    } while (0)++#define ptls_buffer_push_quicint(buf, v)                                                                                           \+    do {                                                                                                                           \+        if ((ret = ptls_buffer_reserve((buf), PTLS_ENCODE_QUICINT_CAPACITY)) != 0)                                                 \+            goto Exit;                                                                                                             \+        uint8_t *d = ptls_encode_quicint((buf)->base + (buf)->off, (v));                                                           \+        (buf)->off = d - (buf)->base;                                                                                              \+    } while (0)++#define ptls_buffer_push_block(buf, _capacity, block)                                                                              \+    do {                                                                                                                           \+        size_t capacity = (_capacity);                                                                                             \+        ptls_buffer_pushv((buf), (uint8_t *)"\0\0\0\0\0\0\0", capacity != -1 ? capacity : 1);                                      \+        size_t body_start = (buf)->off;                                                                                            \+        do {                                                                                                                       \+            block                                                                                                                  \+        } while (0);                                                                                                               \+        size_t body_size = (buf)->off - body_start;                                                                                \+        if (capacity != -1) {                                                                                                      \+            for (; capacity != 0; --capacity)                                                                                      \+                (buf)->base[body_start - capacity] = (uint8_t)(body_size >> (8 * (capacity - 1)));                                 \+        } else {                                                                                                                   \+            if ((ret = ptls_buffer__adjust_quic_blocksize((buf), body_size)) != 0)                                                 \+                goto Exit;                                                                                                         \+        }                                                                                                                          \+    } while (0)++#define ptls_buffer_push_asn1_block(buf, block)                                                                                    \+    do {                                                                                                                           \+        ptls_buffer_push((buf), 0xff); /* dummy */                                                                                 \+        size_t body_start = (buf)->off;                                                                                            \+        do {                                                                                                                       \+            block                                                                                                                  \+        } while (0);                                                                                                               \+        size_t body_size = (buf)->off - body_start;                                                                                \+        if (body_size < 128) {                                                                                                     \+            (buf)->base[body_start - 1] = (uint8_t)body_size;                                                                      \+        } else {                                                                                                                   \+            if ((ret = ptls_buffer__adjust_asn1_blocksize((buf), body_size)) != 0)                                                 \+                goto Exit;                                                                                                         \+        }                                                                                                                          \+    } while (0)++#define ptls_buffer_push_asn1_sequence(buf, block)                                                                                 \+    do {                                                                                                                           \+        ptls_buffer_push((buf), 0x30);                                                                                             \+        ptls_buffer_push_asn1_block((buf), block);                                                                                 \+    } while (0)++#define ptls_buffer_push_message_body(buf, key_sched, type, block)                                                                 \+    do {                                                                                                                           \+        ptls_buffer_t *_buf = (buf);                                                                                               \+        ptls_key_schedule_t *_key_sched = (key_sched);                                                                             \+        size_t mess_start = _buf->off;                                                                                             \+        ptls_buffer_push(_buf, (type));                                                                                            \+        ptls_buffer_push_block(_buf, 3, block);                                                                                    \+        if (_key_sched != NULL)                                                                                                    \+            ptls__key_schedule_update_hash(_key_sched, _buf->base + mess_start, _buf->off - mess_start);                           \+    } while (0)++#define ptls_push_message(emitter, key_sched, type, block)                                                                         \+    do {                                                                                                                           \+        ptls_message_emitter_t *_emitter = (emitter);                                                                              \+        if ((ret = _emitter->begin_message(_emitter)) != 0)                                                                        \+            goto Exit;                                                                                                             \+        ptls_buffer_push_message_body(_emitter->buf, (key_sched), (type), block);                                                  \+        if ((ret = _emitter->commit_message(_emitter)) != 0)                                                                       \+            goto Exit;                                                                                                             \+    } while (0)++int ptls_decode16(uint16_t *value, const uint8_t **src, const uint8_t *end);+int ptls_decode24(uint32_t *value, const uint8_t **src, const uint8_t *end);+int ptls_decode32(uint32_t *value, const uint8_t **src, const uint8_t *end);+int ptls_decode64(uint64_t *value, const uint8_t **src, const uint8_t *end);+uint64_t ptls_decode_quicint(const uint8_t **src, const uint8_t *end);++#define ptls_decode_open_block(src, end, capacity, block)                                                                          \+    do {                                                                                                                           \+        size_t _capacity = (capacity);                                                                                             \+        size_t _block_size;                                                                                                        \+        if (_capacity == -1) {                                                                                                     \+            uint64_t _block_size64;                                                                                                \+            const uint8_t *_src = (src);                                                                                           \+            if ((_block_size64 = ptls_decode_quicint(&_src, end)) == UINT64_MAX ||                                                 \+                (sizeof(size_t) < 8 && (_block_size64 >> (8 * sizeof(size_t))) != 0)) {                                            \+                ret = PTLS_ALERT_DECODE_ERROR;                                                                                     \+                goto Exit;                                                                                                         \+            }                                                                                                                      \+            (src) = _src;                                                                                                          \+            _block_size = (size_t)_block_size64;                                                                                   \+        } else {                                                                                                                   \+            if (_capacity > (size_t)(end - (src))) {                                                                               \+                ret = PTLS_ALERT_DECODE_ERROR;                                                                                     \+                goto Exit;                                                                                                         \+            }                                                                                                                      \+            _block_size = 0;                                                                                                       \+            do {                                                                                                                   \+                _block_size = _block_size << 8 | *(src)++;                                                                         \+            } while (--_capacity != 0);                                                                                            \+        }                                                                                                                          \+        if (_block_size > (size_t)(end - (src))) {                                                                                 \+            ret = PTLS_ALERT_DECODE_ERROR;                                                                                         \+            goto Exit;                                                                                                             \+        }                                                                                                                          \+        do {                                                                                                                       \+            const uint8_t *const end = (src) + _block_size;                                                                        \+            do {                                                                                                                   \+                block                                                                                                              \+            } while (0);                                                                                                           \+            if ((src) != end) {                                                                                                    \+                ret = PTLS_ALERT_DECODE_ERROR;                                                                                     \+                goto Exit;                                                                                                         \+            }                                                                                                                      \+        } while (0);                                                                                                               \+    } while (0)++#define ptls_decode_assert_block_close(src, end)                                                                                   \+    do {                                                                                                                           \+        if ((src) != end) {                                                                                                        \+            ret = PTLS_ALERT_DECODE_ERROR;                                                                                         \+            goto Exit;                                                                                                             \+        }                                                                                                                          \+    } while (0);++#define ptls_decode_block(src, end, capacity, block)                                                                               \+    do {                                                                                                                           \+        ptls_decode_open_block((src), end, capacity, block);                                                                       \+        ptls_decode_assert_block_close((src), end);                                                                                \+    } while (0)++/**+ * create a client object to handle new TLS connection+ */+ptls_t *ptls_client_new(ptls_context_t *ctx);+/**+ * create a server object to handle new TLS connection+ */+ptls_t *ptls_server_new(ptls_context_t *ctx);+/**+ * creates a object handle new TLS connection+ */+static ptls_t *ptls_new(ptls_context_t *ctx, int is_server);+/**+ * releases all resources associated to the object+ */+void ptls_free(ptls_t *tls);+/**+ * returns address of the crypto callbacks that the connection is using+ */+ptls_context_t *ptls_get_context(ptls_t *tls);+/**+ * updates the context of a connection. Can be called from `on_client_hello` callback.+ */+void ptls_set_context(ptls_t *tls, ptls_context_t *ctx);+/**+ * returns the client-random+ */+ptls_iovec_t ptls_get_client_random(ptls_t *tls);+/**+ * returns the cipher-suite being used+ */+ptls_cipher_suite_t *ptls_get_cipher(ptls_t *tls);+/**+ * returns the server-name (NULL if SNI is not used or failed to negotiate)+ */+const char *ptls_get_server_name(ptls_t *tls);+/**+ * sets the server-name associated to the TLS connection. If server_name_len is zero, then strlen(server_name) is called to+ * determine the length of the name.+ * On the client-side, the value is used for certificate validation. The value will be also sent as an SNI extension, if it looks+ * like a DNS name.+ * On the server-side, it can be called from on_client_hello to indicate the acceptance of the SNI extension to the client.+ */+int ptls_set_server_name(ptls_t *tls, const char *server_name, size_t server_name_len);+/**+ * returns the negotiated protocol (or NULL)+ */+const char *ptls_get_negotiated_protocol(ptls_t *tls);+/**+ * sets the negotiated protocol. If protocol_len is zero, strlen(protocol) is called to determine the length of the protocol name.+ */+int ptls_set_negotiated_protocol(ptls_t *tls, const char *protocol, size_t protocol_len);+/**+ * returns if the handshake has been completed+ */+int ptls_handshake_is_complete(ptls_t *tls);+/**+ * returns if a PSK (or PSK-DHE) handshake was performed+ */+int ptls_is_psk_handshake(ptls_t *tls);+/**+ * returns a pointer to user data pointer (client is reponsible for freeing the associated data prior to calling ptls_free)+ */+void **ptls_get_data_ptr(ptls_t *tls);+/**+ *+ */+int ptls_skip_tracing(ptls_t *tls);+/**+ *+ */+void ptls_set_skip_tracing(ptls_t *tls, int skip_tracing);+/**+ * proceeds with the handshake, optionally taking some input from peer. The function returns zero in case the handshake completed+ * successfully. PTLS_ERROR_IN_PROGRESS is returned in case the handshake is incomplete. Otherwise, an error value is returned. The+ * contents of sendbuf should be sent to the client, regardless of whether if an error is returned. inlen is an argument used for+ * both input and output. As an input, the arguments takes the size of the data available as input. Upon return the value is updated+ * to the number of bytes consumed by the handshake. In case the returned value is PTLS_ERROR_IN_PROGRESS there is a guarantee that+ * all the input are consumed (i.e. the value of inlen does not change).+ */+int ptls_handshake(ptls_t *tls, ptls_buffer_t *sendbuf, const void *input, size_t *inlen, ptls_handshake_properties_t *args);+/**+ * decrypts the first record within given buffer+ */+int ptls_receive(ptls_t *tls, ptls_buffer_t *plaintextbuf, const void *input, size_t *len);+/**+ * encrypts given buffer into multiple TLS records+ */+int ptls_send(ptls_t *tls, ptls_buffer_t *sendbuf, const void *input, size_t inlen);+/**+ * updates the send traffic key (as well as asks the peer to update)+ */+int ptls_update_key(ptls_t *tls, int request_update);+/**+ * Returns if the context is a server context.+ */+int ptls_is_server(ptls_t *tls);+/**+ * returns per-record overhead+ */+size_t ptls_get_record_overhead(ptls_t *tls);+/**+ * sends an alert+ */+int ptls_send_alert(ptls_t *tls, ptls_buffer_t *sendbuf, uint8_t level, uint8_t description);+/**+ *+ */+int ptls_export_secret(ptls_t *tls, void *output, size_t outlen, const char *label, ptls_iovec_t context_value, int is_early);+/**+ * build the body of a Certificate message. Can be called with tls set to NULL in order to create a precompressed message.+ */+int ptls_build_certificate_message(ptls_buffer_t *buf, ptls_iovec_t request_context, ptls_iovec_t *certificates,+                                   size_t num_certificates, ptls_iovec_t ocsp_status);+/**+ *+ */+int ptls_calc_hash(ptls_hash_algorithm_t *algo, void *output, const void *src, size_t len);+/**+ *+ */+ptls_hash_context_t *ptls_hmac_create(ptls_hash_algorithm_t *algo, const void *key, size_t key_size);+/**+ *+ */+int ptls_hkdf_extract(ptls_hash_algorithm_t *hash, void *output, ptls_iovec_t salt, ptls_iovec_t ikm);+/**+ *+ */+int ptls_hkdf_expand(ptls_hash_algorithm_t *hash, void *output, size_t outlen, ptls_iovec_t prk, ptls_iovec_t info);+/**+ *+ */+int ptls_hkdf_expand_label(ptls_hash_algorithm_t *algo, void *output, size_t outlen, ptls_iovec_t secret, const char *label,+                           ptls_iovec_t hash_value, const char *label_prefix);+/**+ * instantiates a symmetric cipher+ */+ptls_cipher_context_t *ptls_cipher_new(ptls_cipher_algorithm_t *algo, int is_enc, const void *key);+/**+ * destroys a symmetric cipher+ */+void ptls_cipher_free(ptls_cipher_context_t *ctx);+/**+ * initializes the IV; this function must be called prior to calling ptls_cipher_encrypt+ */+static void ptls_cipher_init(ptls_cipher_context_t *ctx, const void *iv);+/**+ * Encrypts given text. The function must be used in a way that the output length would be equal to the input length. For example,+ * when using a block cipher in ECB mode, `len` must be a multiple of the block size when using a block cipher. The length can be+ * of any value when using a stream cipher or a block cipher in CTR mode.+ */+static void ptls_cipher_encrypt(ptls_cipher_context_t *ctx, void *output, const void *input, size_t len);+/**+ * instantiates an AEAD cipher given a secret, which is expanded using hkdf to a set of key and iv+ * @param aead+ * @param hash+ * @param is_enc 1 if creating a context for encryption, 0 if creating a context for decryption+ * @param secret the secret. The size must be the digest length of the hash algorithm+ * @return pointer to an AEAD context if successful, otherwise NULL+ */+ptls_aead_context_t *ptls_aead_new(ptls_aead_algorithm_t *aead, ptls_hash_algorithm_t *hash, int is_enc, const void *secret,+                                   const char *label_prefix);+/**+ * instantiates an AEAD cipher given key and iv+ * @param aead+ * @param is_enc 1 if creating a context for encryption, 0 if creating a context for decryption+ * @return pointer to an AEAD context if successful, otherwise NULL+ */+ptls_aead_context_t *ptls_aead_new_direct(ptls_aead_algorithm_t *aead, int is_enc, const void *key, const void *iv);+/**+ * destroys an AEAD cipher context+ */+void ptls_aead_free(ptls_aead_context_t *ctx);+/**+ * Permutes the static IV by applying given bytes using bit-wise XOR. This API can be used for supplying nonces longer than 64-+ * bits.+ */+static void ptls_aead_xor_iv(ptls_aead_context_t *ctx, const void *bytes, size_t len);+/**+ *+ */+static size_t ptls_aead_encrypt(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                                const void *aad, size_t aadlen);+static void ptls_aead_encrypt_s(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                                const void *aad, size_t aadlen, ptls_aead_supplementary_encryption_t *supp);+/**+ * initializes the internal state of the encryptor+ */+static void ptls_aead_encrypt_init(ptls_aead_context_t *ctx, uint64_t seq, const void *aad, size_t aadlen);+/**+ * encrypts the input and updates the GCM state+ * @return number of bytes emitted to output+ */+static size_t ptls_aead_encrypt_update(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen);+/**+ * emits buffered data (if any) and the GCM tag+ * @return number of bytes emitted to output+ */+static size_t ptls_aead_encrypt_final(ptls_aead_context_t *ctx, void *output);+/**+ * decrypts an AEAD record+ * @return number of bytes emitted to output if successful, or SIZE_MAX if the input is invalid (e.g. broken MAC)+ */+static size_t ptls_aead_decrypt(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                                const void *aad, size_t aadlen);+/**+ * Return the current read epoch.+ */+size_t ptls_get_read_epoch(ptls_t *tls);+/**+ * Runs the handshake by dealing directly with handshake messages. Callers MUST delay supplying input to this function until the+ * epoch of the input becomes equal to the value returned by `ptls_get_read_epoch()`.+ * @param tls            the TLS context+ * @param sendbuf        buffer to which the output will be written+ * @param epoch_offsets  start and end offset of the messages in each epoch. For example, when the server emits ServerHello between+ *                       offset 0 and 38, the following handshake messages between offset 39 and 348, and a post-handshake message+ *                       between 349 and 451, epoch_offsets will be {0,39,39,349,452} and the length of the sendbuf will be 452.+ *                       This argument is an I/O argument. Applications can either reset sendbuf to empty and epoch_offsets and to+ *                       all zero every time they invoke the function, or retain the values until the handshake completes so that+ *                       data will be appended to sendbuf and epoch_offsets will be adjusted.+ * @param in_epoch       epoch of the input+ * @param input          input bytes (must be NULL when starting the handshake on the client side)+ * @param inlen          length of the input+ * @param properties     properties specific to the running handshake+ * @return same as `ptls_handshake`+ */+int ptls_handle_message(ptls_t *tls, ptls_buffer_t *sendbuf, size_t epoch_offsets[5], size_t in_epoch, const void *input,+                        size_t inlen, ptls_handshake_properties_t *properties);+int ptls_client_handle_message(ptls_t *tls, ptls_buffer_t *sendbuf, size_t epoch_offsets[5], size_t in_epoch, const void *input,+                               size_t inlen, ptls_handshake_properties_t *properties);+int ptls_server_handle_message(ptls_t *tls, ptls_buffer_t *sendbuf, size_t epoch_offsets[5], size_t in_epoch, const void *input,+                               size_t inlen, ptls_handshake_properties_t *properties);+/**+ * internal+ */+void ptls_aead__build_iv(ptls_aead_algorithm_t *algo, uint8_t *iv, const uint8_t *static_iv, uint64_t seq);+/**+ *+ */+static void ptls_aead__do_encrypt(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                                  const void *aad, size_t aadlen, ptls_aead_supplementary_encryption_t *supp);+/**+ * internal+ */+void ptls__key_schedule_update_hash(ptls_key_schedule_t *sched, const uint8_t *msg, size_t msglen);+/**+ * clears memory+ */+extern void (*volatile ptls_clear_memory)(void *p, size_t len);+/**+ * constant-time memcmp+ */+extern int (*volatile ptls_mem_equal)(const void *x, const void *y, size_t len);+/**+ *+ */+static ptls_iovec_t ptls_iovec_init(const void *p, size_t len);+/**+ * checks if a server name is an IP address.+ */+int ptls_server_name_is_ipaddr(const char *name);+/**+ * loads a certificate chain to ptls_context_t::certificates. `certificate.list` and each element of the list is allocated by+ * malloc.  It is the responsibility of the user to free them when discarding the TLS context.+ */+int ptls_load_certificates(ptls_context_t *ctx, char const *cert_pem_file);+/**+ *+ */+int ptls_esni_init_context(ptls_context_t *ctx, ptls_esni_context_t *esni, ptls_iovec_t esni_keys,+                           ptls_key_exchange_context_t **key_exchanges);+/**+ *+ */+void ptls_esni_dispose_context(ptls_esni_context_t *esni);+/**+ * Obtain the ESNI secrets negotiated during the handshake.+ */+ptls_esni_secret_t *ptls_get_esni_secret(ptls_t *ctx);+/**+ *+ */+char *ptls_hexdump(char *dst, const void *src, size_t len);+/**+ * the default get_time callback+ */+extern ptls_get_time_t ptls_get_time;+#if PICOTLS_USE_DTRACE+/**+ *+ */+extern PTLS_THREADLOCAL unsigned ptls_default_skip_tracing;+#else+#define ptls_default_skip_tracing 0+#endif++/* inline functions */++inline ptls_t *ptls_new(ptls_context_t *ctx, int is_server)+{+    return is_server ? ptls_server_new(ctx) : ptls_client_new(ctx);+}++inline ptls_iovec_t ptls_iovec_init(const void *p, size_t len)+{+    /* avoid the "return (ptls_iovec_t){(uint8_t *)p, len};" construct because it requires C99+     * and triggers a warning "C4204: nonstandard extension used: non-constant aggregate initializer"+     * in Visual Studio */+    ptls_iovec_t r;+    r.base = (uint8_t *)p;+    r.len = len;+    return r;+}++inline void ptls_buffer_init(ptls_buffer_t *buf, void *smallbuf, size_t smallbuf_size)+{+    assert(smallbuf != NULL);+    buf->base = (uint8_t *)smallbuf;+    buf->off = 0;+    buf->capacity = smallbuf_size;+    buf->is_allocated = 0;+}++inline void ptls_buffer_dispose(ptls_buffer_t *buf)+{+    ptls_buffer__release_memory(buf);+    *buf = (ptls_buffer_t){NULL};+}++inline uint8_t *ptls_encode_quicint(uint8_t *p, uint64_t v)+{+    if (PTLS_UNLIKELY(v > 63)) {+        if (PTLS_UNLIKELY(v > 16383)) {+            unsigned sb;+            if (PTLS_UNLIKELY(v > 1073741823)) {+                assert(v <= 4611686018427387903);+                *p++ = 0xc0 | (uint8_t)(v >> 56);+                sb = 6 * 8;+            } else {+                *p++ = 0x80 | (uint8_t)(v >> 24);+                sb = 2 * 8;+            }+            do {+                *p++ = (uint8_t)(v >> sb);+            } while ((sb -= 8) != 0);+        } else {+            *p++ = 0x40 | (uint8_t)((uint16_t)v >> 8);+        }+    }+    *p++ = (uint8_t)v;+    return p;+}++inline void ptls_cipher_init(ptls_cipher_context_t *ctx, const void *iv)+{+    ctx->do_init(ctx, iv);+}++inline void ptls_cipher_encrypt(ptls_cipher_context_t *ctx, void *output, const void *input, size_t len)+{+    ctx->do_transform(ctx, output, input, len);+}++inline void ptls_aead_xor_iv(ptls_aead_context_t *ctx, const void *bytes, size_t len)+{+    ctx->do_xor_iv(ctx, bytes, len);+}++inline size_t ptls_aead_encrypt(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                                const void *aad, size_t aadlen)+{+    ctx->do_encrypt(ctx, output, input, inlen, seq, aad, aadlen, NULL);+    return inlen + ctx->algo->tag_size;+}++inline void ptls_aead_encrypt_s(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                                const void *aad, size_t aadlen, ptls_aead_supplementary_encryption_t *supp)+{+    ctx->do_encrypt(ctx, output, input, inlen, seq, aad, aadlen, supp);+}++inline void ptls_aead_encrypt_init(ptls_aead_context_t *ctx, uint64_t seq, const void *aad, size_t aadlen)+{+    ctx->do_encrypt_init(ctx, seq, aad, aadlen);+}++inline size_t ptls_aead_encrypt_update(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen)+{+    return ctx->do_encrypt_update(ctx, output, input, inlen);+}++inline size_t ptls_aead_encrypt_final(ptls_aead_context_t *ctx, void *output)+{+    return ctx->do_encrypt_final(ctx, output);+}++inline void ptls_aead__do_encrypt(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                                  const void *aad, size_t aadlen, ptls_aead_supplementary_encryption_t *supp)+{+    ctx->do_encrypt_init(ctx, seq, aad, aadlen);+    ctx->do_encrypt_update(ctx, output, input, inlen);+    ctx->do_encrypt_final(ctx, (uint8_t *)output + inlen);++    if (supp != NULL) {+        ptls_cipher_init(supp->ctx, supp->input);+        memset(supp->output, 0, sizeof(supp->output));+        ptls_cipher_encrypt(supp->ctx, supp->output, supp->output, sizeof(supp->output));+    }+}++inline size_t ptls_aead_decrypt(ptls_aead_context_t *ctx, void *output, const void *input, size_t inlen, uint64_t seq,+                                const void *aad, size_t aadlen)+{+    return ctx->do_decrypt(ctx, output, input, inlen, seq, aad, aadlen);+}++#define ptls_define_hash(name, ctx_type, init_func, update_func, final_func)                                                       \+                                                                                                                                   \+    struct name##_context_t {                                                                                                      \+        ptls_hash_context_t super;                                                                                                 \+        ctx_type ctx;                                                                                                              \+    };                                                                                                                             \+                                                                                                                                   \+    static void name##_update(ptls_hash_context_t *_ctx, const void *src, size_t len)                                              \+    {                                                                                                                              \+        struct name##_context_t *ctx = (struct name##_context_t *)_ctx;                                                            \+        update_func(&ctx->ctx, src, len);                                                                                          \+    }                                                                                                                              \+                                                                                                                                   \+    static void name##_final(ptls_hash_context_t *_ctx, void *md, ptls_hash_final_mode_t mode)                                     \+    {                                                                                                                              \+        struct name##_context_t *ctx = (struct name##_context_t *)_ctx;                                                            \+        if (mode == PTLS_HASH_FINAL_MODE_SNAPSHOT) {                                                                               \+            ctx_type copy = ctx->ctx;                                                                                              \+            final_func(&copy, md);                                                                                                 \+            ptls_clear_memory(&copy, sizeof(copy));                                                                                \+            return;                                                                                                                \+        }                                                                                                                          \+        if (md != NULL)                                                                                                            \+            final_func(&ctx->ctx, md);                                                                                             \+        switch (mode) {                                                                                                            \+        case PTLS_HASH_FINAL_MODE_FREE:                                                                                            \+            ptls_clear_memory(&ctx->ctx, sizeof(ctx->ctx));                                                                        \+            free(ctx);                                                                                                             \+            break;                                                                                                                 \+        case PTLS_HASH_FINAL_MODE_RESET:                                                                                           \+            init_func(&ctx->ctx);                                                                                                  \+            break;                                                                                                                 \+        default:                                                                                                                   \+            assert(!"FIXME");                                                                                                      \+            break;                                                                                                                 \+        }                                                                                                                          \+    }                                                                                                                              \+                                                                                                                                   \+    static ptls_hash_context_t *name##_clone(ptls_hash_context_t *_src)                                                            \+    {                                                                                                                              \+        struct name##_context_t *dst, *src = (struct name##_context_t *)_src;                                                      \+        if ((dst = malloc(sizeof(*dst))) == NULL)                                                                                  \+            return NULL;                                                                                                           \+        *dst = *src;                                                                                                               \+        return &dst->super;                                                                                                        \+    }                                                                                                                              \+                                                                                                                                   \+    static ptls_hash_context_t *name##_create(void)                                                                                \+    {                                                                                                                              \+        struct name##_context_t *ctx;                                                                                              \+        if ((ctx = malloc(sizeof(*ctx))) == NULL)                                                                                  \+            return NULL;                                                                                                           \+        ctx->super = (ptls_hash_context_t){name##_update, name##_final, name##_clone};                                             \+        init_func(&ctx->ctx);                                                                                                      \+        return &ctx->super;                                                                                                        \+    }++#ifdef __cplusplus+}+#endif++#endif
+ cbits/picotls/fusion.h view
@@ -0,0 +1,99 @@+/*+ * Copyright (c) 2020 Fastly, Kazuho Oku+ *+ * Permission is hereby granted, free of charge, to any person obtaining a copy+ * of this software and associated documentation files (the "Software"), to+ * deal in the Software without restriction, including without limitation the+ * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or+ * sell copies of the Software, and to permit persons to whom the Software is+ * furnished to do so, subject to the following conditions:+ *+ * The above copyright notice and this permission notice shall be included in+ * all copies or substantial portions of the Software.+ *+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+ * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+ * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+ * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS+ * IN THE SOFTWARE.+ */+#ifndef picotls_fusion_h+#define picotls_fusion_h++#ifdef __cplusplus+extern "C" {+#endif++#include <stddef.h>+#include <emmintrin.h>+#include "../picotls.h"++#define PTLS_FUSION_AES128_ROUNDS 10+#define PTLS_FUSION_AES256_ROUNDS 14++typedef struct ptls_fusion_aesecb_context {+    __m128i keys[PTLS_FUSION_AES256_ROUNDS + 1];+    unsigned rounds;+} ptls_fusion_aesecb_context_t;++typedef struct ptls_fusion_aesgcm_context ptls_fusion_aesgcm_context_t;++void ptls_fusion_aesecb_init(ptls_fusion_aesecb_context_t *ctx, int is_enc, const void *key, size_t key_size);+void ptls_fusion_aesecb_dispose(ptls_fusion_aesecb_context_t *ctx);+void ptls_fusion_aesecb_encrypt(ptls_fusion_aesecb_context_t *ctx, void *dst, const void *src);++/**+ * Creates an AES-GCM context.+ * @param key       the AES key (128 bits)+ * @param capacity  maximum size of AEAD record (i.e. AAD + encrypted payload)+ */+ptls_fusion_aesgcm_context_t *ptls_fusion_aesgcm_new(const void *key, size_t key_size, size_t capacity);+/**+ * Updates the capacity.+ */+ptls_fusion_aesgcm_context_t *ptls_fusion_aesgcm_set_capacity(ptls_fusion_aesgcm_context_t *ctx, size_t capacity);+/**+ * Destroys an AES-GCM context.+ */+void ptls_fusion_aesgcm_free(ptls_fusion_aesgcm_context_t *ctx);+/**+ * Encrypts an AEAD block, and in parallel, optionally encrypts one block using AES-ECB.+ * @param ctx      context+ * @param output   output buffer+ * @param input    payload to be encrypted+ * @param inlen    size of the payload to be encrypted+ * @param counter+ * @param aad      AAD+ * @param aadlen   size of AAD+ * @param supp     (optional) supplementary encryption context+ */+void ptls_fusion_aesgcm_encrypt(ptls_fusion_aesgcm_context_t *ctx, void *output, const void *input, size_t inlen, __m128i ctr,+                                const void *aad, size_t aadlen, ptls_aead_supplementary_encryption_t *supp);+/**+ * Decrypts an AEAD block, an in parallel, optionally encrypts one block using AES-ECB. Returns if decryption was successful.+ * @param iv       initialization vector of 12 bytes+ * @param output   output buffer+ * @param input    payload to be decrypted+ * @param inlen    size of the payload to be decrypted+ * @param aad      AAD+ * @param aadlen   size of AAD+ * @param tag      the AEAD tag being received from peer+ */+int ptls_fusion_aesgcm_decrypt(ptls_fusion_aesgcm_context_t *ctx, void *output, const void *input, size_t inlen, __m128i ctr,+                               const void *aad, size_t aadlen, const void *tag);++extern ptls_cipher_algorithm_t ptls_fusion_aes128ctr, ptls_fusion_aes256ctr;+extern ptls_aead_algorithm_t ptls_fusion_aes128gcm, ptls_fusion_aes256gcm;++/**+ * Returns a boolean indicating if fusion can be used.+ */+int ptls_fusion_is_supported_by_cpu(void);++#ifdef __cplusplus+}+#endif++#endif
+ quic.cabal view
@@ -0,0 +1,236 @@+name:                quic+version:             0.0.0+synopsis:            QUIC+description:         Library for QUIC: A UDP-Based Multiplexed and Secure Transport+license:             BSD3+license-file:        LICENSE+author:              Kazu Yamamoto+maintainer:          kazu@iij.ad.jp+-- copyright:+category:            Web+build-type:          Simple+-- extra-source-files:  ChangeLog.md+cabal-version:       >= 1.10+extra-source-files:  cbits/*.h+extra-source-files:  cbits/picotls/*.h+extra-source-files:  test/servercert.pem+extra-source-files:  test/serverkey.pem++----------------------------------------------------------------++Source-Repository head+  Type:                 git+  Location:             git://github.com/kazu-yamamoto/quic++Flag devel+  Description:          Development commands+  Default:              False++----------------------------------------------------------------++library+  exposed-modules:     Network.QUIC+                       Network.QUIC.Client+                       Network.QUIC.Internal+                       Network.QUIC.Server+  other-modules:+                       Network.QUIC.Client.Reader+                       Network.QUIC.Client.Run+                       Network.QUIC.Closer+                       Network.QUIC.Common+                       Network.QUIC.Config+                       Network.QUIC.Connection+                       Network.QUIC.Connection.Crypto+                       Network.QUIC.Connection.Migration+                       Network.QUIC.Connection.Misc+                       Network.QUIC.Connection.PacketNumber+                       Network.QUIC.Connection.Queue+                       Network.QUIC.Connection.Role+                       Network.QUIC.Connection.State+                       Network.QUIC.Connection.Stream+                       Network.QUIC.Connection.StreamTable+                       Network.QUIC.Connection.Timeout+                       Network.QUIC.Connection.Types+                       Network.QUIC.Connector+                       Network.QUIC.Crypto+                       Network.QUIC.CryptoFusion+                       Network.QUIC.Exception+                       Network.QUIC.Handshake+                       Network.QUIC.IO+                       Network.QUIC.Imports+                       Network.QUIC.Info+                       Network.QUIC.Logger+                       Network.QUIC.Packet+                       Network.QUIC.Packet.Decode+                       Network.QUIC.Packet.Decrypt+                       Network.QUIC.Packet.Encode+                       Network.QUIC.Packet.Frame+                       Network.QUIC.Packet.Header+                       Network.QUIC.Packet.Number+                       Network.QUIC.Packet.Token+                       Network.QUIC.Parameters+                       Network.QUIC.QLogger+                       Network.QUIC.Qlog+                       Network.QUIC.Receiver+                       Network.QUIC.Recovery+                       Network.QUIC.Recovery.Constants+                       Network.QUIC.Recovery.Detect+                       Network.QUIC.Recovery.Interface+                       Network.QUIC.Recovery.LossRecovery+                       Network.QUIC.Recovery.Metrics+                       Network.QUIC.Recovery.Misc+                       Network.QUIC.Recovery.PeerPacketNumbers+                       Network.QUIC.Recovery.Persistent+                       Network.QUIC.Recovery.Release+                       Network.QUIC.Recovery.Timer+                       Network.QUIC.Recovery.Types+                       Network.QUIC.Recovery.Utils+                       Network.QUIC.Sender+                       Network.QUIC.Server.Reader+                       Network.QUIC.Server.Run+                       Network.QUIC.Socket+                       Network.QUIC.Stream+                       Network.QUIC.Stream.Frag+                       Network.QUIC.Stream.Misc+                       Network.QUIC.Stream.Queue+                       Network.QUIC.Stream.Reass+                       Network.QUIC.Stream.Skew+                       Network.QUIC.Stream.Table+                       Network.QUIC.Stream.Types+                       Network.QUIC.TLS+                       Network.QUIC.Types+                       Network.QUIC.Types.Ack+                       Network.QUIC.Types.CID+                       Network.QUIC.Types.Constants+                       Network.QUIC.Types.Error+                       Network.QUIC.Types.Exception+                       Network.QUIC.Types.Frame+                       Network.QUIC.Types.Integer+                       Network.QUIC.Types.Packet+                       Network.QUIC.Types.Queue+                       Network.QUIC.Types.Resumption+                       Network.QUIC.Types.Time+                       Network.QUIC.Utils+  -- other-extensions:+  build-depends:       base >= 4.9 && < 5+                     , array+                     , base16-bytestring >= 1.0+                     , bytestring+                     , containers+                     , crypto-token+                     , cryptonite+                     , data-default-class+                     , fast-logger >= 3.0.4+                     , filepath+                     , iproute >= 1.7.8+                     , memory+                     , network >= 3.1.2+                     , network-byte-order >= 0.1.5+                     , psqueues+                     , random >= 1.2+                     , stm+                     , tls+                     , unix-time+                     , unliftio >= 0.2.18+                     , unliftio-core+                     , x509+  -- hs-source-dirs:+  default-language:    Haskell2010+  ghc-options:         -Wall -Wcompat+  default-extensions:  Strict StrictData+  if arch(x86_64) || arch(aarch64)+    cc-options:        -mavx2 -maes -mpclmul+    c-sources:         cbits/fusion.c cbits/picotls.c++test-suite spec+  Type:                 exitcode-stdio-1.0+  default-language:     Haskell2010+  hs-source-dirs:       test+  ghc-options:          -Wall -threaded+  main-is:              Spec.hs+  other-modules:        Config+                        ErrorSpec+                        FrameSpec+                        HandshakeSpec+                        IOSpec+                        PacketSpec+                        RecoverySpec+                        TLSSpec+                        TransportError+                        TypesSpec+  build-depends:        base >= 4.9 && < 5+                      , QuickCheck+                      , async+                      , base16-bytestring >= 1.0+                      , bytestring+                      , containers+                      , cryptonite+                      , hspec+                      , network >= 3.1.2+                      , quic+                      , tls+                      , unix-time+                      , unliftio+  default-extensions:  Strict StrictData+  build-tool-depends: hspec-discover:hspec-discover+++test-suite doctests+  type:                 exitcode-stdio-1.0+  default-language:     Haskell2010+  hs-source-dirs:       test+  main-is:              doctests.hs++  build-depends:        base >= 4.9 && < 5+                      , doctest >= 0.10.1++  ghc-options: -Wall+  default-extensions:  Strict StrictData++executable server+  if flag(devel)+    buildable:          True+  else+    buildable:          False+  default-language:     Haskell2010+  hs-source-dirs:       util+  main-is:              server.hs+  other-modules:        H3+                        Common+                        ServerX+  ghc-options:          -Wall -threaded -rtsopts+  build-depends:        base >= 4.9 && < 5+                      , base16-bytestring+                      , bytestring+                      , filepath+                      , http2+                      , network-byte-order+                      , quic+                      , tls+                      , tls-session-manager+                      , unliftio+  default-extensions:  Strict StrictData++executable client+  if flag(devel)+    buildable:          True+  else+    buildable:          False+  default-language:     Haskell2010+  hs-source-dirs:       util+  main-is:              client.hs+  other-modules:        H3+                        ClientX+                        Common+  ghc-options:          -Wall -threaded -rtsopts+  build-depends:        base >= 4.9 && < 5+                      , base16-bytestring+                      , bytestring+                      , filepath+                      , http2+                      , network-byte-order+                      , quic+                      , tls+                      , unix-time+                      , unliftio+  default-extensions:  Strict StrictData
+ test/Config.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedStrings #-}++module Config (+    makeTestServerConfig+  , makeTestServerConfigR+  , testClientConfig+  , testClientConfigR+  , setServerQlog+  , setClientQlog+  , withPipe+  , Scenario(..)+  , newSessionManager+  ) where++import Control.Concurrent+import Control.Monad+import Data.ByteString (ByteString)+import Data.IORef+import qualified Data.List as L+import Network.Socket+import Network.Socket.ByteString+import Network.TLS (Credentials(..), credentialLoadX509, SessionManager(..), SessionData, SessionID)+import qualified UnliftIO.Exception as E++import Network.QUIC.Client+import Network.QUIC.Internal++makeTestServerConfig :: IO ServerConfig+makeTestServerConfig = do+    cred <- either error id <$> credentialLoadX509 "test/servercert.pem" "test/serverkey.pem"+    let credentials = Credentials [cred]+    return testServerConfig {+        scCredentials = credentials+      , scALPN = Just chooseALPN+      }++testServerConfig :: ServerConfig+testServerConfig = defaultServerConfig {+    scAddresses = [("127.0.0.1",8003)]+  }++makeTestServerConfigR :: IO ServerConfig+makeTestServerConfigR = do+    cred <- either error id <$> credentialLoadX509 "test/servercert.pem" "test/serverkey.pem"+    let credentials = Credentials [cred]+    return testServerConfigR {+        scCredentials = credentials+      , scALPN = Just chooseALPN+      }++testServerConfigR :: ServerConfig+testServerConfigR = defaultServerConfig {+    scAddresses = [("127.0.0.1",8003)]+  }++testClientConfig :: ClientConfig+testClientConfig = defaultClientConfig {+    ccPortName = "8003"+  , ccValidate = False+  }++testClientConfigR :: ClientConfig+testClientConfigR = defaultClientConfig {+    ccPortName = "8002"+  , ccValidate = False+  , ccDebugLog = True+  }++setServerQlog :: ServerConfig -> ServerConfig+setServerQlog sc = sc++setClientQlog :: ClientConfig -> ClientConfig+setClientQlog cc = cc++data Scenario = Randomly Int+              | DropClientPacket [Int]+              | DropServerPacket [Int]++withPipe :: Scenario -> IO () -> IO ()+withPipe scenario body = do+    addrC <- resolve "8002"+    let saC = addrAddress addrC+    addrS <- resolve "8003"+    let saS = addrAddress addrS+    irefC <- newIORef 0+    irefS <- newIORef 0+    E.bracket (openSocket addrC) close $ \sockC ->+      E.bracket (openSocket addrS) close $ \sockS -> do+        setSocketOption sockC ReuseAddr 1+        setSocketOption sockS ReuseAddr 1+        bind sockC saC+        connect sockS saS+        -- from client+        tid0 <- forkIO $ do+            (bs,saO) <- recvFrom sockC 2048+            connect sockC saO+            n0 <- atomicModifyIORef' irefC $ \x -> (x + 1, x)+            dropPacket0 <- shouldDrop scenario True n0+            unless dropPacket0 $ void $ send sockS bs+            forever $ do+                bs1 <- recv sockC 2048+                n <- atomicModifyIORef' irefC $ \x -> (x + 1, x)+                dropPacket <- shouldDrop scenario True n+                unless dropPacket $ void $ send sockS bs1+        -- from server+        tid1 <- forkIO $ forever $ do+            bs <- recv sockS 2048+            n <- atomicModifyIORef' irefS $ \x -> (x + 1, x)+            dropPacket <- shouldDrop scenario False n+            unless dropPacket $ void $ send sockC bs+        body+        killThread tid0+        killThread tid1+  where+    hints = defaultHints { addrSocketType = Datagram }+    resolve port =+        head <$> getAddrInfo (Just hints) (Just "127.0.0.1") (Just port)+    shouldDrop (Randomly n) _ _ = do+        w <- getRandomOneByte+        return ((w `mod` fromIntegral n) == 0)+    shouldDrop (DropClientPacket ns) fromC pn+      | fromC     = return (pn `elem` ns)+      | otherwise = return False+    shouldDrop (DropServerPacket ns) fromC pn+      | fromC     = return False+      | otherwise = return (pn `elem` ns)++chooseALPN :: Version -> [ByteString] -> IO ByteString+chooseALPN _ver protos = return $ case mh3idx of+    Nothing    -> case mhqidx of+      Nothing    -> ""+      Just _     -> "hq"+    Just h3idx ->  case mhqidx of+      Nothing    -> "h3"+      Just hqidx -> if h3idx < hqidx then "h3" else "hq"+  where+    mh3idx = "h3" `L.elemIndex` protos+    mhqidx = "hq" `L.elemIndex` protos++newSessionManager :: IO SessionManager+newSessionManager = sessionManager <$> newIORef Nothing++sessionManager :: IORef (Maybe (SessionID, SessionData)) -> SessionManager+sessionManager ref = SessionManager {+    sessionEstablish      = establish+  , sessionResume         = resume+  , sessionResumeOnlyOnce = resume+  , sessionInvalidate     = \_ -> return ()+  }+  where+    establish sid sdata = writeIORef ref $ Just (sid,sdata)+    resume sid = do+        mx <- readIORef ref+        case mx of+          Nothing -> return Nothing+          Just (s,d)+            | s == sid  -> return $ Just d+            | otherwise -> return Nothing
+ test/ErrorSpec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}++module ErrorSpec where++import Control.Concurrent+import Control.Monad (forever, void)+import Data.ByteString ()+import Network.QUIC+import Network.QUIC.Server+import Test.Hspec++import Config+import TransportError++setup :: IO ThreadId+setup = do+    sc' <- makeTestServerConfig+    smgr <- newSessionManager+    let sc = sc' { scSessionManager = smgr+                 , scUse0RTT        = True+                 }+    tid <- forkIO $ run sc loop+    threadDelay 500000 -- give enough time to the server+    return tid+  where+    loop conn = forever $ void $ acceptStream conn++teardown :: ThreadId -> IO ()+teardown tid = killThread tid++spec :: Spec+spec = beforeAll setup $ afterAll teardown $ transportErrorSpec testClientConfig 2000 -- 2 seconds
+ test/FrameSpec.hs view
@@ -0,0 +1,48 @@+module FrameSpec where++import Control.Monad+import Data.ByteString.Internal (memset)+import Data.Word+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import Test.Hspec+import qualified UnliftIO.Exception as E++import Network.QUIC.Internal++spec :: Spec+spec = do+    describe "countZero" $ do+        it "counts 0 correctly" $ do+            let siz = 512+            E.bracket (mallocBytes siz) free $ \beg -> do+                let (+.) = plusPtr+                    end  = beg +. siz+                void $ memset beg 0 $ fromIntegral siz+                countZero beg end `shouldReturn` siz+                countZero (beg +. 1) end `shouldReturn` (siz - 1)+                countZero (beg +. 2) end `shouldReturn` (siz - 2)+                countZero (beg +. 3) end `shouldReturn` (siz - 3)+                countZero (beg +. 4) end `shouldReturn` (siz - 4)+                countZero (beg +. 5) end `shouldReturn` (siz - 5)+                countZero (beg +. 6) end `shouldReturn` (siz - 6)+                countZero (beg +. 7) end `shouldReturn` (siz - 7)+                countZero (beg +. 8) end `shouldReturn` (siz - 8)+                poke (end +. (-1)) (1 :: Word8)+                countZero (beg +. 3) end `shouldReturn` (siz - 4)+                poke (end +. (-2)) (2 :: Word8)+                countZero (beg +. 3) end `shouldReturn` (siz - 5)+                poke (end +. (-3)) (3 :: Word8)+                countZero (beg +. 3) end `shouldReturn` (siz - 6)+                countZero (beg +. 1) (beg +. 2) `shouldReturn` 1+                countZero (beg +. 1) (beg +. 3) `shouldReturn` 2+                countZero (beg +. 1) (beg +. 4) `shouldReturn` 3+                countZero (beg +. 1) (beg +. 5) `shouldReturn` 4+                countZero (beg +. 1) (beg +. 6) `shouldReturn` 5+                countZero (beg +. 1) (beg +. 7) `shouldReturn` 6+                countZero (beg +. 1) (beg +. 8) `shouldReturn` 7+                countZero (beg +. 1) (beg +. 9) `shouldReturn` 8+                countZero (beg +. 1) (beg +. 10) `shouldReturn` 9+                countZero (beg +. 1) (beg +. 11) `shouldReturn` 10+                countZero (beg +. 2) (beg +. 3) `shouldReturn` 1
+ test/HandshakeSpec.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE OverloadedStrings #-}++module HandshakeSpec where++import Control.Concurrent+import Control.Monad+import qualified Data.ByteString as BS+import Network.TLS (HandshakeMode13(..), Group(..))+import qualified Network.TLS as TLS+import Test.Hspec+import UnliftIO.Async+import qualified UnliftIO.Exception as E++import Network.QUIC+import Network.QUIC.Client as C+import Network.QUIC.Internal hiding (RTT0)+import Network.QUIC.Server as S++import Config++spec :: Spec+spec = do+    sc0' <- runIO makeTestServerConfig+    smgr <- runIO newSessionManager+    let sc0 = sc0' { scSessionManager = smgr }+    describe "handshake" $ do+        it "can handshake in the normal case" $ do+            let cc = testClientConfig+                sc = sc0+            testHandshake cc sc FullHandshake+        it "can handshake in the case of TLS hello retry" $ do+            let cc = testClientConfig+                sc = sc0 { scGroups = [P256] }+            testHandshake cc sc HelloRetryRequest+        it "can handshake in the case of QUIC retry" $ do+            let cc = testClientConfig+                sc = sc0 { scRequireRetry = True }+            testHandshake cc sc FullHandshake+        it "can handshake in the case of resumption" $ do+            let cc = testClientConfig+                sc = sc0+            testHandshake2 cc sc (FullHandshake, PreSharedKey) False+        it "can handshake in the case of 0-RTT" $ do+            let cc = testClientConfig+                sc = sc0 { scUse0RTT = True }+            testHandshake2 cc sc (FullHandshake, RTT0) True+        it "fails with unknown server certificate" $ do+            let cc1 = testClientConfig {+                        ccValidate = True  -- ouch, default should be reversed+                      }+                cc2 = testClientConfig+                sc  = sc0+                certificateRejected e+                    | TransportErrorIsSent te@(TransportError _) _ <- e = te == cryptoError TLS.CertificateUnknown+                    | otherwise = False+            testHandshake3 cc1 cc2 sc certificateRejected+        it "fails with no group in common" $ do+            let cc1 = testClientConfig { ccGroups = [X25519] }+                cc2 = testClientConfig { ccGroups = [P256] }+                sc  = sc0 { scGroups = [P256] }+                handshakeFailure e+                    | TransportErrorIsReceived te@(TransportError _) _ <- e = te == cryptoError TLS.HandshakeFailure+                    | otherwise = False+            testHandshake3 cc1 cc2 sc handshakeFailure+        it "can handshake with large EE from a client" $ do+            let cc0 = testClientConfig+                params = (ccParameters cc0) {+                      grease = Just (BS.pack (replicate 2400 0))+                    }+                cc = cc0 { ccParameters = params }+                sc = sc0+            testHandshake cc sc FullHandshake+        it "can handshake with large EE from a server (3-times rule)" $ do+            let cc = testClientConfig+                params = (scParameters sc0) {+                      grease = Just (BS.pack (replicate 3800 0))+                    }+                sc = sc0 { scParameters = params }+            testHandshake cc sc FullHandshake++onE :: IO b -> IO a -> IO a+onE h b = E.onException b h++testHandshake :: ClientConfig -> ServerConfig -> HandshakeMode13 -> IO ()+testHandshake cc sc mode = concurrently_ server client+  where+    client = do+        threadDelay 10000+        C.run cc $ \conn -> do+            waitEstablished conn+            handshakeMode <$> getConnectionInfo conn `shouldReturn` mode+    server = S.run sc $ \conn -> do+        waitEstablished conn+        handshakeMode <$> getConnectionInfo conn `shouldReturn` mode+        stop conn++query :: BS.ByteString -> Connection -> IO ()+query content conn = do+    waitEstablished conn+    s <- stream conn+    sendStream s content+    shutdownStream s+    void $ recvStream s 1024++testHandshake2 :: ClientConfig -> ServerConfig -> (HandshakeMode13, HandshakeMode13) -> Bool -> IO ()+testHandshake2 cc1 sc (mode1, mode2) use0RTT = concurrently_ server client+  where+    runClient cc mode action = C.run cc $ \conn -> do+        void $ action conn+        handshakeMode <$> getConnectionInfo conn `shouldReturn` mode+        getResumptionInfo conn+    client = do+        threadDelay 10000+        res <- runClient cc1 mode1 $ query "first"+        threadDelay 10000+        let cc2 = cc1 { ccResumption = res+                      , ccUse0RTT    = use0RTT+                      }+        void $ runClient cc2 mode2 $ query "second"+    server = S.run sc serv+      where+        serv conn = do+            s <- acceptStream conn+            bs <- recvStream s 1024+            sendStream s "bye"+            when (bs == "second") $ stop conn++testHandshake3 :: ClientConfig -> ClientConfig -> ServerConfig -> (QUICException -> Bool) -> IO ()+testHandshake3 cc1 cc2 sc selector = concurrently_ server client+  where+    client = do+        threadDelay 10000+        C.run cc1 (query "first")  `shouldThrow` selector+        C.run cc2 (query "second") `shouldReturn` ()+    server = S.run sc $ \conn -> do+        s <- acceptStream conn+        recvStream s 1024 `shouldReturn` "second"+        sendStream s "bye"+        stop conn
+ test/IOSpec.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}++module IOSpec where++import Control.Concurrent+import Control.Monad+import qualified Data.ByteString as BS+import Test.Hspec+import UnliftIO.Async++import qualified Network.QUIC.Client as C+import Network.QUIC+import Network.QUIC.Server++import Config++spec :: Spec+spec = do+    sc <- runIO makeTestServerConfigR+    let cc = testClientConfigR+    describe "send & recv" $ do+        it "can exchange data on random dropping" $ do+            withPipe (Randomly 20) $ testSendRecv cc sc 1000+        it "can exchange data on server 0" $ do+            withPipe (DropServerPacket [0]) $ testSendRecv cc sc 20+        it "can exchange data on server 1" $ do+            withPipe (DropServerPacket [1]) $ testSendRecv cc sc 20+        it "can exchange data on server 2" $ do+            withPipe (DropServerPacket [2]) $ testSendRecv cc sc 20+        it "can exchange data on server 3" $ do+            withPipe (DropServerPacket [3]) $ testSendRecv cc sc 20+        it "can exchange data on server 4" $ do+            withPipe (DropServerPacket [4]) $ testSendRecv cc sc 20+        it "can exchange data on server 5" $ do+            withPipe (DropServerPacket [5]) $ testSendRecv cc sc 20+        it "can exchange data on server 6" $ do+            withPipe (DropServerPacket [6]) $ testSendRecv cc sc 20+        it "can exchange data on server 7" $ do+            withPipe (DropServerPacket [7]) $ testSendRecv cc sc 20+        it "can exchange data on server 8" $ do+            withPipe (DropServerPacket [8]) $ testSendRecv cc sc 20+        it "can exchange data on server 9" $ do+            withPipe (DropServerPacket [9]) $ testSendRecv cc sc 20+        it "can exchange data on server 10" $ do+            withPipe (DropServerPacket [10]) $ testSendRecv cc sc 20+        it "can exchange data on server 11" $ do+            withPipe (DropServerPacket [11]) $ testSendRecv cc sc 20+        it "can exchange data on client 0" $ do+            withPipe (DropClientPacket [0]) $ testSendRecv cc sc 20+        it "can exchange data on client 1" $ do+            withPipe (DropClientPacket [1]) $ testSendRecv cc sc 20+        it "can exchange data on client 2" $ do+            withPipe (DropClientPacket [2]) $ testSendRecv cc sc 20+        it "can exchange data on client 3" $ do+            withPipe (DropClientPacket [3]) $ testSendRecv cc sc 20+        it "can exchange data on client 4" $ do+            withPipe (DropClientPacket [4]) $ testSendRecv cc sc 20+        it "can exchange data on client 5" $ do+            withPipe (DropClientPacket [5]) $ testSendRecv cc sc 20+        it "can exchange data on client 6" $ do+            withPipe (DropClientPacket [6]) $ testSendRecv cc sc 20+        it "can exchange data on client 7" $ do+            withPipe (DropClientPacket [7]) $ testSendRecv cc sc 20+        it "can exchange data on client 8" $ do+            withPipe (DropClientPacket [8]) $ testSendRecv cc sc 20+        it "can exchange data on client 9" $ do+            withPipe (DropClientPacket [9]) $ testSendRecv cc sc 20+        it "can exchange data on client 10" $ do+            withPipe (DropClientPacket [10]) $ testSendRecv cc sc 20+        it "can exchange data on client 11" $ do+            withPipe (DropClientPacket [11]) $ testSendRecv cc sc 20++testSendRecv :: C.ClientConfig -> ServerConfig -> Int -> IO ()+testSendRecv cc sc times = do+    mvar <- newEmptyMVar+    void $ concurrently (client mvar) (server mvar)+  where+    client mvar = do+        threadDelay 10000+        C.run cc $ \conn -> do+            strm <- stream conn+            let bs = BS.replicate 10000 0+            replicateM_ times $ sendStream strm bs+            shutdownStream strm+            takeMVar mvar `shouldReturn` ()+    server mvar = run sc $ \conn -> do+        strm <- acceptStream conn+        bs <- recvStream strm 1024+        let len = BS.length bs+        n <- loop strm bs len+        n `shouldBe` (10000 * times)+        putMVar mvar ()+        stop conn+      where+        loop _    "" n = return n+        loop strm _  n = do+            bs <- recvStream strm 1024+            let len = BS.length bs+                n' = n + len+            loop strm bs n'
+ test/PacketSpec.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings #-}++module PacketSpec where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Internal as BS+import Data.IORef+import Foreign.Marshal.Alloc+import qualified Network.Socket as NS+import Test.Hspec++import Network.QUIC.Internal++import Config++spec :: Spec+spec = do+    serverConf <- runIO makeTestServerConfig+    describe "test vector" $ do+        it "describes example of Client Initial version 1" $ do+            let noLog _ = return ()+            let serverCID = makeCID $ dec16s "8394c8f03e515708"+                clientCID = makeCID ""+                serverAuthCIDs = defaultAuthCIDs { initSrcCID = Just serverCID+                                                 , origDstCID = Just serverCID+                                                 }+                clientAuthCIDs = defaultAuthCIDs { initSrcCID = Just clientCID }+                -- dummy+            let clientConf = testClientConfig+                ver = Version1+            s <- NS.socket NS.AF_INET NS.Stream NS.defaultProtocol+            q <- newRecvQ+            sref <- newIORef [s]+            clientConn <- clientConnection clientConf ver clientAuthCIDs serverAuthCIDs noLog noLog defaultHooks sref q+            initializeCoder clientConn InitialLevel $ initialSecrets ver serverCID+            serverConn <- serverConnection serverConf ver serverAuthCIDs clientAuthCIDs noLog noLog defaultHooks sref q+            initializeCoder serverConn InitialLevel $ initialSecrets ver serverCID+            (PacketIC (CryptPacket header crypt) lvl, _) <- decodePacket clientInitialPacketBinary+            let dlen = 2048+            dbuf <- mallocBytes dlen+            Just plain <- decryptCrypt serverConn dbuf dlen crypt lvl+            let ppkt = PlainPacket header plain+            clientInitialPacketBinary' <- BS.createAndTrim 4096 $ \buf -> do+                fst <$> encodePlainPacket clientConn buf 2048 ppkt Nothing+            (PacketIC (CryptPacket header' crypt') lvl', _) <- decodePacket clientInitialPacketBinary'+            Just plain' <- decryptCrypt serverConn dbuf dlen crypt' lvl'+            header' `shouldBe` header+            plainFrames plain' `shouldBe` plainFrames plain++clientInitialPacketBinary :: ByteString+clientInitialPacketBinary = dec16 $ BS.concat [+    "c000000001088394c8f03e5157080000449e7b9aec34d1b1c98dd7689fb8ec11"+  , "d242b123dc9bd8bab936b47d92ec356c0bab7df5976d27cd449f63300099f399"+  , "1c260ec4c60d17b31f8429157bb35a1282a643a8d2262cad67500cadb8e7378c"+  , "8eb7539ec4d4905fed1bee1fc8aafba17c750e2c7ace01e6005f80fcb7df6212"+  , "30c83711b39343fa028cea7f7fb5ff89eac2308249a02252155e2347b63d58c5"+  , "457afd84d05dfffdb20392844ae812154682e9cf012f9021a6f0be17ddd0c208"+  , "4dce25ff9b06cde535d0f920a2db1bf362c23e596d11a4f5a6cf3948838a3aec"+  , "4e15daf8500a6ef69ec4e3feb6b1d98e610ac8b7ec3faf6ad760b7bad1db4ba3"+  , "485e8a94dc250ae3fdb41ed15fb6a8e5eba0fc3dd60bc8e30c5c4287e53805db"+  , "059ae0648db2f64264ed5e39be2e20d82df566da8dd5998ccabdae053060ae6c"+  , "7b4378e846d29f37ed7b4ea9ec5d82e7961b7f25a9323851f681d582363aa5f8"+  , "9937f5a67258bf63ad6f1a0b1d96dbd4faddfcefc5266ba6611722395c906556"+  , "be52afe3f565636ad1b17d508b73d8743eeb524be22b3dcbc2c7468d54119c74"+  , "68449a13d8e3b95811a198f3491de3e7fe942b330407abf82a4ed7c1b311663a"+  , "c69890f4157015853d91e923037c227a33cdd5ec281ca3f79c44546b9d90ca00"+  , "f064c99e3dd97911d39fe9c5d0b23a229a234cb36186c4819e8b9c5927726632"+  , "291d6a418211cc2962e20fe47feb3edf330f2c603a9d48c0fcb5699dbfe58964"+  , "25c5bac4aee82e57a85aaf4e2513e4f05796b07ba2ee47d80506f8d2c25e50fd"+  , "14de71e6c418559302f939b0e1abd576f279c4b2e0feb85c1f28ff18f58891ff"+  , "ef132eef2fa09346aee33c28eb130ff28f5b766953334113211996d20011a198"+  , "e3fc433f9f2541010ae17c1bf202580f6047472fb36857fe843b19f5984009dd"+  , "c324044e847a4f4a0ab34f719595de37252d6235365e9b84392b061085349d73"+  , "203a4a13e96f5432ec0fd4a1ee65accdd5e3904df54c1da510b0ff20dcc0c77f"+  , "cb2c0e0eb605cb0504db87632cf3d8b4dae6e705769d1de354270123cb11450e"+  , "fc60ac47683d7b8d0f811365565fd98c4c8eb936bcab8d069fc33bd801b03ade"+  , "a2e1fbc5aa463d08ca19896d2bf59a071b851e6c239052172f296bfb5e724047"+  , "90a2181014f3b94a4e97d117b438130368cc39dbb2d198065ae3986547926cd2"+  , "162f40a29f0c3c8745c0f50fba3852e566d44575c29d39a03f0cda721984b6f4"+  , "40591f355e12d439ff150aab7613499dbd49adabc8676eef023b15b65bfc5ca0"+  , "6948109f23f350db82123535eb8a7433bdabcb909271a6ecbcb58b936a88cd4e"+  , "8f2e6ff5800175f113253d8fa9ca8885c2f552e657dc603f252e1a8e308f76f0"+  , "be79e2fb8f5d5fbbe2e30ecadd220723c8c0aea8078cdfcb3868263ff8f09400"+  , "54da48781893a7e49ad5aff4af300cd804a6b6279ab3ff3afb64491c85194aab"+  , "760d58a606654f9f4400e8b38591356fbf6425aca26dc85244259ff2b19c41b9"+  , "f96f3ca9ec1dde434da7d2d392b905ddf3d1f9af93d1af5950bd493f5aa731b4"+  , "056df31bd267b6b90a079831aaf579be0a39013137aac6d404f518cfd4684064"+  , "7e78bfe706ca4cf5e9c5453e9f7cfd2b8b4c8d169a44e55c88d4a9a7f9474241"+  , "e221af44860018ab0856972e194cd934"+  ]
+ test/RecoverySpec.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++module RecoverySpec where++import Data.ByteString.Short ()+import qualified Data.Sequence as Seq+import Data.UnixTime+import Test.Hspec++import Network.QUIC.Internal++spec :: Spec+spec = do+    describe "persistent congestion" $ do+        it "does not find a pair" $ do+            findDuration (Seq.fromList [sp0]) 0 `shouldBe` Nothing+            findDuration (Seq.fromList [sp0,sp1]) 0 `shouldBe` Nothing+            findDuration (Seq.fromList [sp0,sp1,sp2]) 0 `shouldBe` Nothing+            findDuration (Seq.fromList [sp0,sp2,sp2,sp3]) 0 `shouldBe` Nothing+            findDuration (Seq.fromList [sp0,sp2,sp2,sp3,sp4]) 0 `shouldBe` Nothing+            findDuration (Seq.fromList [sp0,sp2,sp2,sp3,sp5]) 0 `shouldBe` Nothing+            findDuration (Seq.fromList [sp0,sp2,sp2,sp3,sp4,sp5]) 2 `shouldBe` Nothing+        it "finds a pair" $ do+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5]) 0 `shouldBe` Just (UnixDiffTime 4 0)+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5,sp6]) 0 `shouldBe` Just (UnixDiffTime 4 0)+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5,sp6,sp7]) 0 `shouldBe` Just (UnixDiffTime 6 0)+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5,sp6,sp7]) 3 `shouldBe` Just (UnixDiffTime 2 0)+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5,sp6,sp7,sp8,sp9,sp10]) 2 `shouldBe` Just (UnixDiffTime 5 0)+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5,sp6,sp7,sp8,sp9]) 0 `shouldBe` Just (UnixDiffTime 6 0)+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5,sp6,sp7,sp8,sp9,sp10]) 0 `shouldBe` Just (UnixDiffTime 9 0)+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5,sp6,sp7,sp8,sp9,sp10,sp20,sp21]) 0 `shouldBe` Just (UnixDiffTime 22 0)+            findDuration (Seq.fromList [sp0,sp1,sp2,sp3,sp4,sp5,sp6,sp7,sp8,sp9,sp10,sp20,sp21,sp30,sp31,sp32,sp33]) 0 `shouldBe` Just (UnixDiffTime 29 0)++sp0,sp1,sp2,sp3,sp4,sp5,sp6,sp7,sp8,sp9,sp10,sp20,sp21,sp30,sp31,sp32,sp33 :: SentPacket+sp0  = sp  0 False $ UnixTime  0 0+sp1  = sp  1 True  $ UnixTime  1 0+sp2  = sp  2 False $ UnixTime  2 0+sp3  = sp  3 False $ UnixTime  3 0+sp4  = sp  4 False $ UnixTime  4 0+sp5  = sp  5 True  $ UnixTime  5 0+sp6  = sp  6 False $ UnixTime  6 0+sp7  = sp  7 True  $ UnixTime  7 0+sp8  = sp  8 False $ UnixTime  8 0+sp9  = sp  9 False $ UnixTime  9 0+sp10 = sp 10 True  $ UnixTime 10 0+sp20 = sp 20 True  $ UnixTime 22 0+sp21 = sp 21 True  $ UnixTime 44 0+sp30 = sp 30 False $ UnixTime 50 0+sp31 = sp 31 True  $ UnixTime 51 0+sp32 = sp 32 False $ UnixTime 55 0+sp33 = sp 33 True  $ UnixTime 80 0++sp :: PacketNumber -> Bool -> TimeMicrosecond -> SentPacket+sp mypn ackeli tm = spkt { spTimeSent = tm }+  where+    ppkt = PlainPacket (Short $ toCID "") (Plain (Flags 0) 0 [] 0)+    spkt = mkSentPacket mypn InitialLevel ppkt emptyPeerPacketNumbers ackeli
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/TLSSpec.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module TLSSpec where++import qualified Data.ByteString as BS+import Test.Hspec++import Network.QUIC.Internal++----------------------------------------------------------------++instance Eq (ClientTrafficSecret a) where+    ClientTrafficSecret x == ClientTrafficSecret y = x == y++instance Eq (ServerTrafficSecret a) where+    ServerTrafficSecret x == ServerTrafficSecret y = x == y++----------------------------------------------------------------++spec :: Spec+spec = do+    let ver = Version1+    describe "test vector" $ do+        it "describes the examples of Keys" $ do+            ----------------------------------------------------------------+            -- shared keys+            let dcID = makeCID (dec16s "8394c8f03e515708")+            let client_initial_secret@(ClientTrafficSecret cis) = clientInitialSecret ver dcID+            client_initial_secret `shouldBe` ClientTrafficSecret (dec16 "c00cf151ca5be075ed0ebfb5c80323c42d6b7db67881289af4008f1f6c357aea")+            let ckey = aeadKey defaultCipher (Secret cis)+            ckey `shouldBe` Key (dec16 "1f369613dd76d5467730efcbe3b1a22d")+            let civ = initialVector defaultCipher (Secret cis)+            civ `shouldBe` IV (dec16 "fa044b2f42a3fd3b46fb255c")+            let chp = headerProtectionKey defaultCipher (Secret cis)+            chp `shouldBe` Key (dec16 "9f50449e04a0e810283a1e9933adedd2")+            let server_initial_secret@(ServerTrafficSecret sis) = serverInitialSecret ver dcID+            server_initial_secret `shouldBe` ServerTrafficSecret (dec16 "3c199828fd139efd216c155ad844cc81fb82fa8d7446fa7d78be803acdda951b")+            let skey = aeadKey defaultCipher (Secret sis)+            skey `shouldBe` Key (dec16 "cf3a5331653c364c88f0f379b6067e37")+            let siv = initialVector defaultCipher (Secret sis)+            siv `shouldBe` IV (dec16 "0ac1493ca1905853b0bba03e")+            let shp = headerProtectionKey defaultCipher (Secret sis)+            shp `shouldBe` Key (dec16 "c206b8d9b9f0f37644430b490eeaa314")++        it "describes the examples of Client Initial" $ do+            let dcID = makeCID (dec16s "8394c8f03e515708")+                ClientTrafficSecret cis = clientInitialSecret ver dcID+                ckey = aeadKey defaultCipher (Secret cis)+                civ = initialVector defaultCipher (Secret cis)+                chp = headerProtectionKey defaultCipher (Secret cis)+            ----------------------------------------------------------------+            -- payload encryption+            let clientCRYPTOframe = dec16 $ BS.concat [+                    "060040f1010000ed0303ebf8fa56f12939b9584a3896472ec40bb863cfd3e868"+                  , "04fe3a47f06a2b69484c00000413011302010000c000000010000e00000b6578"+                  , "616d706c652e636f6dff01000100000a00080006001d00170018001000070005"+                  , "04616c706e000500050100000000003300260024001d00209370b2c9caa47fba"+                  , "baf4559fedba753de171fa71f50f1ce15d43e994ec74d748002b000302030400"+                  , "0d0010000e0403050306030203080408050806002d00020101001c0002400100"+                  , "3900320408ffffffffffffffff05048000ffff07048000ffff08011001048000"+                  , "75300901100f088394c8f03e51570806048000ffff"+                  ]+            let clientPacketHeader = dec16 "c300000001088394c8f03e5157080000449e00000002"+            -- c30000000108 8394c8f03e515708 0000449e 00000002+            -- c3 (11000011)    -- flags+            -- 00000001         -- version 1+            -- 08               -- dcid len+            -- 8394c8f03e515708 -- dcid+            -- 00               -- scid len+            -- 00               -- token length+            -- 449e             -- length: decodeInt (dec16 "449e")+                                -- 1182 = 4 + 1162 + 16 (fixme)+            -- 00000002         -- encoded packet number++            let bodyLen = fromIntegral $ decodeInt (dec16 "449e")+            let padLen = bodyLen+                       - 4  -- packet number length+                       - 16 -- GCM encrypt expansion+                       - BS.length clientCRYPTOframe+                clientCRYPTOframePadded = clientCRYPTOframe `BS.append` BS.pack (replicate padLen 0)+            let plaintext = clientCRYPTOframePadded+            let nonce = makeNonce civ $ dec16 "00000002"+            let add = AddDat clientPacketHeader+            let ciphertext = BS.concat $ encryptPayload' defaultCipher ckey nonce plaintext add+            let Just plaintext' = decryptPayload' defaultCipher ckey nonce ciphertext add+            plaintext' `shouldBe` plaintext++            ----------------------------------------------------------------+            -- header protection+            let sample = Sample (BS.take 16 ciphertext)+            sample `shouldBe` Sample (dec16 "d1b1c98dd7689fb8ec11d242b123dc9b")+            let Mask mask = protectionMask defaultCipher chp sample+            BS.take 5 mask `shouldBe` dec16 "437b9aec36"
+ test/TransportError.hs view
@@ -0,0 +1,353 @@+{-# LANGUAGE OverloadedStrings #-}++module TransportError (+    transportErrorSpec+  ) where++import Control.Concurrent+import Control.Monad+import Data.ByteString ()+import qualified Data.ByteString as BS+import qualified Network.TLS as TLS+import Network.TLS.QUIC (ExtensionRaw)+import Test.Hspec+import UnliftIO.Timeout++import Network.QUIC.Client+import Network.QUIC.Internal hiding (timeout)++----------------------------------------------------------------++type Millisecond = Int++runC :: ClientConfig -> Millisecond -> (Connection -> IO a) -> IO (Maybe a)+runC cc ms body = timeout us $ run cc body'+  where+    us = ms * 1000+    body' conn = do+        waitEstablished conn+        threadDelay 100000+        body conn++runCnoOp :: ClientConfig -> Millisecond -> IO (Maybe ())+runCnoOp cc ms = timeout us $ run cc body'+  where+    us = ms * 1000+    body' conn = do+        waitEstablished conn+        threadDelay us++transportErrorSpec :: ClientConfig -> Millisecond -> SpecWith a+transportErrorSpec cc0 ms = do+    describe "QUIC servers" $ do+        it "MUST send FLOW_CONTROL_ERROR if a STREAM frame with a large offset is received [Transport 4.1]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated largeOffset+            runCnoOp cc ms `shouldThrow` transportErrorsIn [FlowControlError]+        it "MUST send TRANSPORT_PARAMETER_ERROR if initial_source_connection_id is missing [Transport 7.3]" $ \_ -> do+            let cc = addHook cc0 $ setOnTransportParametersCreated dropInitialSourceConnectionId+            runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+        it "MUST send TRANSPORT_PARAMETER_ERROR if original_destination_connection_id is received [Transport 18.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnTransportParametersCreated setOriginalDestinationConnectionId+            runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+        it "MUST send TRANSPORT_PARAMETER_ERROR if preferred_address, is received [Transport 18.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnTransportParametersCreated setPreferredAddress+            runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+        it "MUST send TRANSPORT_PARAMETER_ERROR if retry_source_connection_id is received [Transport 18.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnTransportParametersCreated setRetrySourceConnectionId+            runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+        it "MUST send TRANSPORT_PARAMETER_ERROR if stateless_reset_token is received [Transport 18.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnTransportParametersCreated setStatelessResetToken+            runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+        it "MUST send TRANSPORT_PARAMETER_ERROR if max_udp_payload_size < 1200 [Transport 7.4 and 18.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnTransportParametersCreated setMaxUdpPayloadSize+            runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+        it "MUST send TRANSPORT_PARAMETER_ERROR if ack_delay_exponen > 20 [Transport 7.4 and 18.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnTransportParametersCreated setAckDelayExponent+            runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+        it "MUST send TRANSPORT_PARAMETER_ERROR if max_ack_delay >= 2^14 [Transport 7.4 and 18.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnTransportParametersCreated setMaxAckDelay+            runCnoOp cc ms `shouldThrow` transportErrorsIn [TransportParameterError]+        it "MUST send FRAME_ENCODING_ERROR if a frame of unknown type is received [Transport 12.4]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated unknownFrame+            runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError]+        it "MUST send PROTOCOL_VIOLATION on no frames [Transport 12.4]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated noFrames+            runCnoOp cc ms `shouldThrow` transportError+        it "MUST send PROTOCOL_VIOLATION if reserved bits in Handshake are non-zero [Transport 17.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated $ rrBits HandshakeLevel+            runCnoOp cc ms `shouldThrow` transportError+        it "MUST send PROTOCOL_VIOLATION if PATH_CHALLENGE in Handshake is received [Transport 17.2.4]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated handshakePathChallenge+            runCnoOp cc ms `shouldThrow` transportError+        it "MUST send PROTOCOL_VIOLATION if reserved bits in Short are non-zero [Transport 17.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated $ rrBits RTT1Level+            runCnoOp cc ms `shouldThrow` transportError+        it "MUST send STREAM_STATE_ERROR if RESET_STREAM is received for a send-only stream [Transport 19.4]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated resetStrm+            runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+        it "MUST send STREAM_STATE_ERROR if STOP_SENDING is received for a non-existing stream [Transport 19.5]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated stopSending+            runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+        it "MUST send PROTOCOL_VIOLATION if NEW_TOKEN is received [Transport 19.7]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated newToken+            runCnoOp cc ms `shouldThrow` transportError+        it "MUST send STREAM_STATE_ERROR if it receives a STREAM frame for a locally-initiated stream that has not yet been created [Transport 19.8]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated localInitiatedNotCreatedYet+            runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+        it "MUST send STREAM_STATE_ERROR if it receives a STREAM frame for a send-only stream [Transport 19.8]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated sendOnlyStream+            runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+        it "MUST send STREAM_STATE_ERROR if MAX_STREAM_DATA is received for a non-existing stream [Transport 19.10]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated maxStreamData+            runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+        it "MUST send STREAM_STATE_ERROR if MAX_STREAM_DATA is received for a receive-only stream [Transport 19.10]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated maxStreamData2+            runCnoOp cc ms `shouldThrow` transportErrorsIn [StreamStateError]+        it "MUST send FRAME_ENCODING_ERROR if invalid MAX_STREAMS is received [Transport 19.11]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated maxStreams'+            runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError]+        it "MUST send STREAM_LIMIT_ERROR or FRAME_ENCODING_ERROR if invalid STREAMS_BLOCKED is received [Transport 19.14]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated streamsBlocked+            runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError,StreamLimitError]+        it "MUST send FRAME_ENCODING_ERROR if NEW_CONNECTION_ID with invalid Retire_Prior_To is received [Transport 19.15]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated $ newConnectionID ncidLargeRPT+            runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError]+        it "MUST send FRAME_ENCODING_ERROR if NEW_CONNECTION_ID with 0-byte CID is received [Transport 19.15]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated $ newConnectionID ncidZeroCID+            runCnoOp cc ms `shouldThrow` transportErrorsIn [FrameEncodingError]+        it "MUST send PROTOCOL_VIOLATION if HANDSHAKE_DONE is received [Transport 19.20]" $ \_ -> do+            let cc = addHook cc0 $ setOnPlainCreated handshakeDone+            runCnoOp cc ms `shouldThrow` transportError+        it "MUST send unexpected_message TLS alert if KeyUpdate in Handshake is received [TLS 6]" $ \_ -> do+            let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoKeyUpdate+            runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage]+        it "MUST send unexpected_message TLS alert if KeyUpdate in 1-RTT is received [TLS 6]" $ \_ -> do+            let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoKeyUpdate2+            runC cc ms (\_ -> threadDelay 1000000) `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage]+        it "MUST send no_application_protocol TLS alert if no application protocols are supported [TLS 8.1]" $ \_ -> do+            let cc = cc0 { ccALPN = \_ -> return $ Just ["dummy"] }+            runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.NoApplicationProtocol]+        it "MUST send missing_extension TLS alert if the quic_transport_parameters extension does not included [TLS 8.2]" $ \_ -> do+            let cc = addHook cc0 $ setOnTLSExtensionCreated (const [])+            runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.MissingExtension]+        it "MUST send unexpected_message TLS alert if EndOfEarlyData is received [TLS 8.3]" $ \_ -> do+            let cc = addHook cc0 $ setOnTLSHandshakeCreated cryptoEndOfEarlyData+            runCnoOp cc ms `shouldThrow` cryptoErrorsIn [TLS.UnexpectedMessage]+        it "MUST send PROTOCOL_VIOLATION if CRYPTO in 0-RTT is received [TLS 8.3]" $ \_ -> do+            mres <- runC cc0 ms getResumptionInfo+            case mres of+              Just res+                | is0RTTPossible res -> do+                    let cc1 = addHook cc0 $ setOnTLSHandshakeCreated crypto0RTT+                        cc = cc1 { ccResumption = res+                                 , ccUse0RTT = True+                                 }+                    runCnoOp cc ms `shouldThrow` transportError+              _ -> do+                    putStrLn "Warning: 0-RTT is not possible. Skipping this test. Use \"h3spec -s 0-RTT\" next time."+                    when (ccDebugLog cc0) $ print mres++----------------------------------------------------------------++addHook :: ClientConfig -> (Hooks -> Hooks) -> ClientConfig+addHook cc modify = cc'+  where+    cc' = cc { ccHooks = modify $ ccHooks cc }++setOnPlainCreated :: (EncryptionLevel -> Plain -> Plain) -> Hooks -> Hooks+setOnPlainCreated f hooks = hooks { onPlainCreated = f }++setOnTransportParametersCreated :: (Parameters -> Parameters) -> Hooks -> Hooks+setOnTransportParametersCreated f hooks = hooks { onTransportParametersCreated = f }++setOnTLSExtensionCreated :: ([ExtensionRaw] -> [ExtensionRaw]) -> Hooks -> Hooks+setOnTLSExtensionCreated f params = params { onTLSExtensionCreated = f }++setOnTLSHandshakeCreated :: ([(EncryptionLevel,CryptoData)] -> ([(EncryptionLevel,CryptoData)],Bool)) -> Hooks -> Hooks+setOnTLSHandshakeCreated f hooks = hooks { onTLSHandshakeCreated = f }++----------------------------------------------------------------++rrBits :: EncryptionLevel -> EncryptionLevel -> Plain -> Plain+rrBits lvl0 lvl plain+  | lvl0 == lvl = if plainPacketNumber plain /= 0 then+                    plain { plainFlags = Flags 0x08 }+                  else+                    plain+  | otherwise   = plain++dropInitialSourceConnectionId :: Parameters -> Parameters+dropInitialSourceConnectionId params = params { initialSourceConnectionId = Nothing }++dummyCID :: Maybe CID+dummyCID = Just $ toCID "DUMMY"++setOriginalDestinationConnectionId :: Parameters -> Parameters+setOriginalDestinationConnectionId params = params { originalDestinationConnectionId = dummyCID }++setPreferredAddress :: Parameters -> Parameters+setPreferredAddress params = params { preferredAddress = Just prefAddr }+  where+    prefAddr = BS.concat+        [ "\x7f\x00\x00\x01"+        , "\x01\xbb"+        , "\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00"+        , "\x00\x00"+        , "\x08"+        , "\x00\x01\x02\x03\x04\x05\x06\x07"+        , "\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\x0a\x0b\x0c\x0d\x0e\x0f"+        ]++setRetrySourceConnectionId :: Parameters -> Parameters+setRetrySourceConnectionId params = params { retrySourceConnectionId = dummyCID }++setStatelessResetToken :: Parameters -> Parameters+setStatelessResetToken params = params { statelessResetToken = Just $ StatelessResetToken "DUMMY" }++----------------------------------------------------------------++setMaxUdpPayloadSize :: Parameters -> Parameters+setMaxUdpPayloadSize params = params { maxUdpPayloadSize = 1090 }++setAckDelayExponent :: Parameters -> Parameters+setAckDelayExponent params = params { ackDelayExponent = 30 }++setMaxAckDelay :: Parameters -> Parameters+setMaxAckDelay params = params { maxAckDelay = 2^(15 :: Int) }++----------------------------------------------------------------++largeOffset :: EncryptionLevel -> Plain -> Plain+largeOffset lvl plain+  | lvl == RTT1Level = plain { plainFrames = fake : plainFrames plain }+  | otherwise        = plain+  where+    fake = StreamF 0 100000000 ["GET /\r\n"] True++unknownFrame :: EncryptionLevel -> Plain -> Plain+unknownFrame lvl plain+  | lvl == RTT1Level = plain { plainFrames = UnknownFrame 0x20 : plainFrames plain }+  | otherwise        = plain++handshakePathChallenge :: EncryptionLevel -> Plain -> Plain+handshakePathChallenge lvl plain+  | lvl == HandshakeLevel = plain { plainFrames = PathChallenge (PathData "01234567") : plainFrames plain }+  | otherwise        = plain++noFrames :: EncryptionLevel -> Plain -> Plain+noFrames lvl plain+  | lvl == RTT1Level = plain { plainFrames = [], plainMarks = set4bytesPN $ setNoPaddings $ plainMarks plain }+  | otherwise        = plain++handshakeDone :: EncryptionLevel -> Plain -> Plain+handshakeDone lvl plain+  | lvl == RTT1Level = plain { plainFrames = HandshakeDone : plainFrames plain }+  | otherwise = plain++newToken :: EncryptionLevel -> Plain -> Plain+newToken lvl plain+  | lvl == RTT1Level = plain { plainFrames = NewToken "DUMMY" : plainFrames plain }+  | otherwise = plain++localInitiatedNotCreatedYet :: EncryptionLevel -> Plain -> Plain+localInitiatedNotCreatedYet lvl plain+  | lvl == RTT1Level = plain { plainFrames = StreamF 1 0 [""] False : plainFrames plain }+  | otherwise = plain++sendOnlyStream :: EncryptionLevel -> Plain -> Plain+sendOnlyStream lvl plain+  | lvl == RTT1Level = plain { plainFrames = StreamF 3 0 [""] False : plainFrames plain }+  | otherwise = plain++resetStrm :: EncryptionLevel -> Plain -> Plain+resetStrm lvl plain+  | lvl == RTT1Level = plain { plainFrames = ResetStream 3 (ApplicationProtocolError 0) 0 : plainFrames plain }+  | otherwise = plain++stopSending :: EncryptionLevel -> Plain -> Plain+stopSending lvl plain+  | lvl == RTT1Level = plain { plainFrames = StopSending 101 (ApplicationProtocolError 0) : plainFrames plain }+  | otherwise = plain++maxStreamData :: EncryptionLevel -> Plain -> Plain+maxStreamData lvl plain+  | lvl == RTT1Level = plain { plainFrames = MaxStreamData 101 1000000 : plainFrames plain }+  | otherwise = plain++maxStreamData2 :: EncryptionLevel -> Plain -> Plain+maxStreamData2 lvl plain+  | lvl == RTT1Level = plain { plainFrames = MaxStreamData 2 1000000 : plainFrames plain }+  | otherwise = plain++maxStreams' :: EncryptionLevel -> Plain -> Plain+maxStreams' lvl plain+  | lvl == RTT1Level = plain { plainFrames = MaxStreams Bidirectional (2^(60 :: Int) + 1) : plainFrames plain }+  | otherwise = plain++streamsBlocked :: EncryptionLevel -> Plain -> Plain+streamsBlocked lvl plain+  | lvl == RTT1Level = plain { plainFrames = StreamsBlocked Bidirectional (2^(60 :: Int) + 1) : plainFrames plain }+  | otherwise = plain++newConnectionID :: (Frame -> Frame) -> EncryptionLevel -> Plain -> Plain+newConnectionID f lvl plain+  | lvl == RTT1Level = plain { plainFrames = map f $ plainFrames plain }+  | otherwise = plain++ncidZeroCID :: Frame -> Frame+ncidZeroCID (NewConnectionID cidinfo0 rpt) = NewConnectionID cidinfo rpt+  where+    cidinfo = cidinfo0 { cidInfoCID = CID "" }+ncidZeroCID frame = frame++ncidLargeRPT :: Frame -> Frame+ncidLargeRPT (NewConnectionID cidinfo rpt) = NewConnectionID cidinfo (rpt + 10)+ncidLargeRPT frame = frame++----------------------------------------------------------------++cryptoKeyUpdate :: [(EncryptionLevel,CryptoData)] -> ([(EncryptionLevel,CryptoData)],Bool)+cryptoKeyUpdate [(HandshakeLevel,fin)] = ([(HandshakeLevel,BS.append fin "\x18\x00\x00\x01\x01")],False)+cryptoKeyUpdate lcs = (lcs,False)++cryptoKeyUpdate2 :: [(EncryptionLevel,CryptoData)] -> ([(EncryptionLevel,CryptoData)],Bool)+-- [] is intentionally created in RTT1Level for h3spec+cryptoKeyUpdate2 []  = ([(RTT1Level,"\x18\x00\x00\x01\x01")],False)+cryptoKeyUpdate2 lcs = (lcs,False)++cryptoEndOfEarlyData :: [(EncryptionLevel,CryptoData)] -> ([(EncryptionLevel,CryptoData)],Bool)+cryptoEndOfEarlyData [(HandshakeLevel,fin)] = ([(HandshakeLevel,BS.append "\x05\x00\x00\x00" fin)],False)+cryptoEndOfEarlyData lcs = (lcs,False)++crypto0RTT :: [(EncryptionLevel,CryptoData)] -> ([(EncryptionLevel,CryptoData)],Bool)+crypto0RTT [(InitialLevel,ch)] = ([(InitialLevel,ch),(RTT0Level,"\x08\x00\x00\x02\x00\x00")],True)+crypto0RTT lcs = (lcs,False)++----------------------------------------------------------------++transportError :: QUICException -> Bool+transportError (TransportErrorIsReceived te _) = te `elem` [ProtocolViolation, InternalError]+transportError _ = False++-- Transport Sec 11:+-- In particular, an endpoint MAY use any applicable error code when+-- it detects an error condition; a generic error code (such as+-- PROTOCOL_VIOLATION or INTERNAL_ERROR) can always be used in place+-- of specific error codes.+transportErrorsIn :: [TransportError] -> QUICException -> Bool+transportErrorsIn tes qe@(TransportErrorIsReceived te _) = (te `elem` tes) || transportError qe+transportErrorsIn _   _                           = False++cryptoErrorX :: QUICException -> Bool+cryptoErrorX (TransportErrorIsReceived te _) = te `elem` [cryptoError TLS.InternalError, cryptoError TLS.HandshakeFailure]+cryptoErrorX _ = False++-- Crypto Sec 4.8: QUIC permits the use of a generic code in place of+-- a specific error code; see Section 11 of [QUIC-TRANSPORT]. For TLS+-- alerts, this includes replacing any alert with a generic alert,+-- such as handshake_failure (0x128 in QUIC). Endpoints MAY use a+-- generic error code to avoid possibly exposing confidential+-- information.+cryptoErrorsIn :: [TLS.AlertDescription] -> QUICException -> Bool+cryptoErrorsIn tes qe@(TransportErrorIsReceived te _) = (te `elem` map cryptoError tes) || cryptoErrorX qe+cryptoErrorsIn _   _                           = False
+ test/TypesSpec.hs view
@@ -0,0 +1,15 @@+module TypesSpec where++import Data.List+import Test.Hspec+import Test.QuickCheck++import Network.QUIC.Internal++spec :: Spec+spec = do+    describe "toAckInfo and fromAckInfo" $ do+        it "should be dual" $ property $ \xs -> do+            let rs = nub . sort . map (getSmall . getNonNegative) . getNonEmpty $  (xs :: NonEmptyList (NonNegative (Small PacketNumber)))+                rs' = reverse rs+            fromAckInfo (toAckInfo rs') `shouldBe` rs
+ test/doctests.hs view
@@ -0,0 +1,4 @@+import Test.DocTest++main :: IO ()+main = doctest ["Network.QUIC.Client","Network.QUIC.Server"]
+ test/servercert.pem view
@@ -0,0 +1,21 @@+-----BEGIN CERTIFICATE-----+MIIDaDCCAlACCQC0r//bLWA1yzANBgkqhkiG9w0BAQsFADB2MQswCQYDVQQGEwJK+UDEOMAwGA1UECAwFVG9reW8xEDAOBgNVBAcMB0NoaXlvZGExDzANBgNVBAoMBkZh+bW91czETMBEGA1UEAwwKZXhhbXBsZS5qcDEfMB0GCSqGSIb3DQEJARYQYWxpY2VA+ZXhhbXBsZS5qcDAeFw0xOTAxMjgxMjExMjRaFw0yOTAxMjUxMjExMjRaMHYxCzAJ+BgNVBAYTAkpQMQ4wDAYDVQQIDAVUb2t5bzEQMA4GA1UEBwwHQ2hpeW9kYTEPMA0G+A1UECgwGRmFtb3VzMRMwEQYDVQQDDApleGFtcGxlLmpwMR8wHQYJKoZIhvcNAQkB+FhBhbGljZUBleGFtcGxlLmpwMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKC+AQEAv6dZNM7VekWEkFCINV1YC1dZWOZfyIpuTwJafE8Dz6vn8oMQQh8qiHoAsApm+p+zcs0fClaum5Jn6T+n54gJYEZbSnvpkAZnmylUQvVjFFqUS7iljDc9YkcgwNsY9+G5XtwIQ43HuFXYw0QTCJyZFmxxzTX1HuqY7D205Wfy5CWoEBKX1/iayo1kP8PVUg+jNMBoYrouw+H9+s7hWG0B+jXjHnpYJnJymGFNum0H2cOpz3i1V0hs14S8w3Kgm2R+z0NUzAdBF8dd3KRqHo/Fkj/gd1unpKQCcBrDmDTLmWjdqr1f77WgjmF9UFHWph99+bYvxwdw3yoo7GBX/96+E3v6QwwIDAQABMA0GCSqGSIb3DQEBCwUAA4IBAQALd/Hx+4GebJQO/vMzDMAaqG5oxer1thTSIUPAfqeWQuzUJLoY4Vsn4JioGGdF//kTLXYCy+DvFjHTRpf3wAwVHNfT0qZhWzG83TvVHebFS9FocrYTmNpvv0GFdW6Ua3uUXQg3Ia+z/Kn+27W4cGhcnoCw3LEI2BFwXokKxiWOeJRGf/Ag79NXp5C0j5omiGpDdGQ8D/V+eu/4JKaUH8Trx0sCwQZ55w/KU1S6YyJ4R5iaFLeuJrHsX7YjjN9nihGjelUNKQTv+sAHsy1FJQA10xoABbzVVNOeWLmJGCVjSAEA5cnvB96zthyAXZf/F9/gmsotjw/X/+UPdpzhCpPkjfu2Ex+-----END CERTIFICATE-----
+ test/serverkey.pem view
@@ -0,0 +1,27 @@+-----BEGIN RSA PRIVATE KEY-----+MIIEpAIBAAKCAQEAv6dZNM7VekWEkFCINV1YC1dZWOZfyIpuTwJafE8Dz6vn8oMQ+Qh8qiHoAsApmp+zcs0fClaum5Jn6T+n54gJYEZbSnvpkAZnmylUQvVjFFqUS7ilj+Dc9YkcgwNsY9G5XtwIQ43HuFXYw0QTCJyZFmxxzTX1HuqY7D205Wfy5CWoEBKX1/+iayo1kP8PVUgjNMBoYrouw+H9+s7hWG0B+jXjHnpYJnJymGFNum0H2cOpz3i1V0h+s14S8w3Kgm2Rz0NUzAdBF8dd3KRqHo/Fkj/gd1unpKQCcBrDmDTLmWjdqr1f77Wg+jmF9UFHWph99bYvxwdw3yoo7GBX/96+E3v6QwwIDAQABAoIBAHoZC2PxQV+cWk/2+flBBH45aH7nbSrpgNtZvEWaQkEUFp8eAaCM358j6sOV2OuBQrmopFXZ03OZWknnG+/kNWavUJuTU/H+dFPRs6Bmga3bUHhX/lLg3mQu7dMpoywUuJwOYdVnxg1R477C57+1cxsraW8X40ijYHISk61IbX0qqEs43ymTOEM35vY935n49hML87I7zFWAg1x5cWy+hK8dKFTfa4fHX11Tsz4vYivhQvBGnTT98IdD79hpGLm81JhvalizqlarX81ykmAc+edl/KYaf53fZgdVvXm5X+HnhY1yFAs1y//n1BKJgwZF6xUbn9p6NzdzGJwzdmJJ0+qD6+nEECgYEA8FVyA39QcgZMhaD1MrleGqH5eASsMCIOxpmcDOqy9rFVh3uFmbHd+5++z0mbJCq4mooEyQg3xSrbk7KEngzd5seHiYLu85Sbbrpfgnn884Z7OklUfmlBC+8YqrXKgV4osHu8LuGZSE6cgznsQ7UqgD9pstrEuN1FMNRc/qKdnfU0cCgYEAzCWO+vLHDK1RzixG1tNOzo3w0G4uIv6gF1iTEqDt2xuUy/05f7b/PZT/vS1uxTM4ctiDj+qn3QHfNP9C5ZPxKWjoIqvnNauq3r2sFn6vMSrGdhY9f4/e8tMg+OyYeOvh3X4ik2+TSm0jxJcfVNetJid7BnzScBMSG/zQiA75YVM/KUCgYA7/ph/lwCV9kyT7yJGj0+W+hmioNUJmoZneqenyr4QNYSdgss0fGO+0Pno9Q7tcFy0909Kf+qsJY66yA2jBsM+I+QEMqsrLs4U5lvzQrXMft6p7WmLlS5EZR1bQBZVRRQTOlA3w8ln63fWqlb4b/k0Gq+BgLYx+OX5UOi8cwatnCxcQKBgQCJ9Atb6ghIfJ5D6SjQVIs9PA5+WrGDSkj/aANY+6C4gw/vNWSosIIVHF4hedUz/6Pyv+tO+f5ym0KhECxoWLDp/fOjjoFI8epE6V54g+wDfrN0Ux0l2ZRApXnPnRqABG6yXa2Byw0jEIydCkhDUod0WoqfSk7wTdooFROzUe+qhDXXQKBgQDkI4P9sydf8QivoWWxL2l4a6lgEkBRSNKRN+cjQXkVRMYNjoASV/I0+HaSxyhaHw3+7DqUOzE7FYoAoOWPENo1yCaIDcqfArLsmxdofGzymXj27umQi5YI8+hcNPvP1QySUQ1v56xEPHVdURtinp4MvjAu7fuJRs4H4UE5k5bUzqHw==+-----END RSA PRIVATE KEY-----
+ util/ClientX.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}+{-# LANGUAGE StrictData #-}++module ClientX where++import Control.Concurrent+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import Network.ByteOrder++import H3+import Network.QUIC++data Aux = Aux {+    auxPath       :: String+  , auxAuthority  :: String+  , auxDebug      :: String -> IO ()+  , auxShow       :: ByteString -> IO ()+  , auxCheckClose :: IO Bool+  }++type Cli = Aux -> Connection -> IO ()++clientHQ :: Int -> Cli+clientHQ n0 aux@Aux{..} conn = loop n0+  where+    cmd = C8.pack ("GET " ++ auxPath ++ "\r\n")+    loop 0 = auxDebug "Connection finished"+    loop 1 = do+        auxDebug "GET"+        get+    loop n = do+        auxDebug "GET"+        get+        threadDelay 1000000+        loop (n - 1)+    get = do+        s <- stream conn+        sendStream s cmd+        shutdownStream s+        consume aux s++clientH3 :: Int -> Cli+clientH3 n0 aux@Aux{..} conn = do+    hdrblk <- taglen 1 <$> qpackClient auxPath auxAuthority+    s2 <- unidirectionalStream conn+    s6 <- unidirectionalStream conn+    s10 <- unidirectionalStream conn+    -- 0: control, 4 settings+    sendStream s2 (BS.pack [0,4,8,1,80,0,6,128,0,128,0])+    -- 2: from encoder to decoder+    sendStream s6 (BS.pack [2])+    -- 3: from decoder to encoder+    sendStream s10 (BS.pack [3])+    loop n0 hdrblk+ where+    loop 0 _ = auxDebug "Connection finished"+    loop 1 hdrblk = do+        auxDebug "GET"+        get hdrblk+    loop n hdrblk = do+        auxDebug "GET"+        get hdrblk+        threadDelay 1000000+        loop (n - 1) hdrblk+    get hdrblk = do+        s <- stream conn+        sendStream s hdrblk+        shutdownStream s+        consume aux s++consume :: Aux -> Stream -> IO ()+consume aux@Aux{..} s = do+    bs <- recvStream s 1024+    if bs == "" then do+        auxDebug "Fin received"+        closeStream s+      else do+        auxShow bs+        auxDebug $ show (BS.length bs) ++ " bytes received"+        consume aux s++clientPF :: Word64 -> Cli+clientPF n Aux{..} conn = do+    cmd <- withWriteBuffer 8 $ \wbuf -> write64 wbuf n+    s <- stream conn+    sendStream s cmd+    shutdownStream s+    loop s+  where+    loop s = do+        bs <- recvStream s 1024+        if bs == "" then do+            auxDebug "Connection finished"+            closeStream s+          else do+            auxShow bs+            loop s
+ util/Common.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++module Common (+    getGroups+  , getLogger+  , makeProtos+  ) where++import Data.Bits+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import Data.Maybe+import Network.TLS hiding (Version)++import Network.QUIC.Internal++namedGroups :: [(String, Group)]+namedGroups =+    [ ("ffdhe2048", FFDHE2048)+    , ("ffdhe3072", FFDHE3072)+    , ("ffdhe4096", FFDHE4096)+    , ("ffdhe6144", FFDHE6144)+    , ("ffdhe8192", FFDHE8192)+    , ("p256",      P256)+    , ("p384",      P384)+    , ("p521",      P521)+    , ("x25519",    X25519)+    , ("x448",      X448)+    ]++getGroups :: [Group] -> Maybe String -> [Group]+getGroups grps Nothing   = grps+getGroups _    (Just gs) = mapMaybe (`lookup` namedGroups) $ split ',' gs++split :: Char -> String -> [String]+split _ "" = []+split c s = case break (c==) s of+    ("",r)  -> split c (tail r)+    (s',"") -> [s']+    (s',r)  -> s' : split c (tail r)++getLogger :: Maybe FilePath -> (String -> IO ())+getLogger Nothing     = \_ -> return ()+getLogger (Just file) = \msg -> appendFile file (msg ++ "\n")++makeProtos :: Version -> (ByteString, ByteString)+makeProtos Version1 = ("h3","hq-interop")+makeProtos ver = (h3X,hqX)+  where+    verbs = C8.pack $ show $ fromVersion ver+    h3X = "h3-" `BS.append` verbs+    hqX = "hq-" `BS.append` verbs++fromVersion :: Version -> Int+fromVersion (Version ver) = fromIntegral (0x000000ff .&. ver)
+ util/H3.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Strict #-}+{-# LANGUAGE StrictData #-}++module H3 (+    qpackClient+  , qpackServer+  , taglen+  , html+  ) where++import Data.Bits+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import Data.Word+import Network.HPACK.Internal++import Network.QUIC.Internal++name :: ByteString+name = "HaskellQuic/0.0.0"++qpackServer :: IO ByteString+qpackServer = do+    let status = 0b11000000 .|. 25 -- :status: 200+        ct     = 0b11000000 .|. 52 -- content-type: text/html; charset=utf8+    server <- encStr 92 name+    return $ BS.concat [BS.pack[0,0,status,ct],server]++qpackClient :: String -> String -> IO ByteString+qpackClient path authority = do+    let method = 0b11000000 .|. 17 -- :method: GET+        scheme = 0b11000000 .|. 22 -- :scheme: http+    path' <- encStr  1 $ C8.pack path+    auth  <- encStr  0 $ C8.pack authority+    ua    <- encStr 95 name+    return $ BS.concat [BS.pack [0,0,method,scheme]+                       ,path'+                       ,auth+                       ,ua]++encStr :: Int -> ByteString -> IO ByteString+encStr idx val = do+    k <- setQpackTag 0b01010000 <$> encodeInteger 4 idx+    v <- encodeHuffman val+    vlen <- setQpackTag 0b10000000 <$> encodeInteger 7 (BS.length v)+    return $ BS.concat [k,vlen,v]++setQpackTag :: Word8 -> ByteString -> ByteString+setQpackTag tag bs = BS.cons (tag .|. BS.head bs) (BS.tail bs)++taglen :: Word8 -> ByteString -> ByteString+taglen i bs = BS.concat [tag,len,bs]+  where+    tag = BS.singleton i+    len = encodeInt $ fromIntegral $ BS.length bs++html :: ByteString+html = "<html><head><title>Welcome to QUIC in Haskell</title></head><body><p>Welcome to QUIC in Haskell. This server asks clients to retry if no token/retry_token is provided. HTTP 0.9, HTTP/3 and QPACK implementations are a toy and hard-coded. No path validation at this moment.</p></body></html>"
+ util/ServerX.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}+{-# LANGUAGE StrictData #-}++module ServerX where++import Control.Concurrent+import Control.Monad+import qualified Data.ByteString as BS+import Data.ByteString.Builder+import Network.ByteOrder+import qualified UnliftIO.Exception as E++import Network.QUIC+import Network.QUIC.Internal+import H3++serverHQ :: Connection -> IO ()+serverHQ conn = connDebugLog conn "Connection terminated" `onE` body+  where+    body = forever $ do+        s <- acceptStream conn+        consume conn s+        let sid = streamId s+        when (isClientInitiatedBidirectional sid) $ do+            sendStream s html+            closeStream s++serverH3 :: Connection -> IO ()+serverH3 conn = connDebugLog conn "Connection terminated" `onE` do+    s3 <- unidirectionalStream conn+    s7 <- unidirectionalStream conn+    s11 <- unidirectionalStream conn+    -- 0: control, 4 settings+    sendStream s3 (BS.pack [0,4,8,1,80,0,6,128,0,128,0])+    -- 2: from encoder to decoder+    sendStream s7 (BS.pack [2])+    -- 3: from decoder to encoder+    sendStream s11 (BS.pack [3])+    hdrblock <- taglen 1 <$> qpackServer+    let bdyblock = taglen 0 html+        hdrbdy = [hdrblock,bdyblock]+    loop hdrbdy+  where+    loop hdrbdy = do+        s <- acceptStream conn+        void . forkIO $ do+            consume conn s+            let sid = streamId s+            when (isClientInitiatedBidirectional sid) $ do+                sendStreamMany s hdrbdy+                closeStream s+        loop hdrbdy++serverPF :: Connection -> IO ()+serverPF conn = connDebugLog conn "Connection terminated" `onE` do+    s <- acceptStream conn+    let sid = streamId s+    when (isClientInitiatedBidirectional sid) $ do+        bs <- recvStream s 8+        n <- withReadBuffer bs read64+        loop s n+        closeStream s+  where+    bs1024 = BS.replicate 1024 65+    loop _ 0 = return ()+    loop s n+      | n < 1024  = sendStream s $ BS.replicate (fromIntegral n) 65+      | otherwise = do+            sendStream s bs1024+            loop s (n - 1024)++consume :: Connection -> Stream -> IO ()+consume conn s = loop+  where+    loop = do+        bs <- recvStream s 1024+        if bs == "" then+            connDebugLog conn "FIN received"+          else do+            connDebugLog conn $ byteString bs+            loop++onE :: IO b -> IO a -> IO a+h `onE` b = b `E.onException` h
+ util/client.hs view
@@ -0,0 +1,369 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}+{-# LANGUAGE StrictData #-}++module Main where++import Control.Concurrent+import Control.Monad+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as C8+import Data.UnixTime+import Data.Word+import Foreign.C.Types+import Network.TLS.QUIC+import System.Console.GetOpt+import System.Environment+import System.Exit+import System.IO+import Text.Printf++import ClientX+import Common+import Network.QUIC+import Network.QUIC.Client+import Network.QUIC.Internal hiding (RTT0)++data Options = Options {+    optDebugLog    :: Bool+  , optShow        :: Bool+  , optQLogDir     :: Maybe FilePath+  , optKeyLogFile  :: Maybe FilePath+  , optGroups      :: Maybe String+  , optValidate    :: Bool+  , optHQ          :: Bool+  , optVerNego     :: Bool+  , optResumption  :: Bool+  , opt0RTT        :: Bool+  , optRetry       :: Bool+  , optQuantum     :: Bool+  , optInteractive :: Bool+  , optMigration   :: Maybe ConnectionControl+  , optPacketSize  :: Maybe Int+  , optPerformance :: Word64+  , optNumOfReqs   :: Int+  , optUnconSock   :: Bool+  } deriving Show++defaultOptions :: Options+defaultOptions = Options {+    optDebugLog    = False+  , optShow        = False+  , optQLogDir     = Nothing+  , optKeyLogFile  = Nothing+  , optGroups      = Nothing+  , optHQ          = False+  , optValidate    = False+  , optVerNego     = False+  , optResumption  = False+  , opt0RTT        = False+  , optRetry       = False+  , optQuantum     = False+  , optInteractive = False+  , optMigration   = Nothing+  , optPacketSize  = Nothing+  , optPerformance = 0+  , optNumOfReqs   = 1+  , optUnconSock   = True+  }++usage :: String+usage = "Usage: client [OPTION] addr port"++options :: [OptDescr (Options -> Options)]+options = [+    Option ['d'] ["debug"]+    (NoArg (\o -> o { optDebugLog = True }))+    "print debug info"+  , Option ['v'] ["show-content"]+    (NoArg (\o -> o { optShow = True }))+    "print downloaded content"+  , Option ['q'] ["qlog-dir"]+    (ReqArg (\dir o -> o { optQLogDir = Just dir }) "<dir>")+    "directory to store qlog"+  , Option ['l'] ["key-log-file"]+    (ReqArg (\file o -> o { optKeyLogFile = Just file }) "<file>")+    "a file to store negotiated secrets"+  , Option ['g'] ["groups"]+    (ReqArg (\gs o -> o { optGroups = Just gs }) "<groups>")+    "specify groups"+  , Option ['c'] ["validate"]+    (NoArg (\o -> o { optValidate = True }))+    "validate server's certificate"+  , Option ['r'] ["hq"]+    (NoArg (\o -> o { optHQ = True }))+    "prefer hq (HTTP/0.9)"+  , Option ['s'] ["packet-size"]+    (ReqArg (\n o -> o { optPacketSize = Just (read n) }) "<size>")+    "specify QUIC packet size (UDP payload size)"+  , Option ['i'] ["interactive"]+    (NoArg (\o -> o { optInteractive = True }))+    "prefer hq (HTTP/0.9)"+  , Option ['V'] ["vernego"]+    (NoArg (\o -> o { optVerNego = True }))+    "try version negotiation"+  , Option ['R'] ["resumption"]+    (NoArg (\o -> o { optResumption = True }))+    "try session resumption"+  , Option ['Z'] ["0rtt"]+    (NoArg (\o -> o { opt0RTT = True }))+    "try sending early data"+  , Option ['S'] ["stateless-retry"]+    (NoArg (\o -> o { optRetry = True }))+    "check stateless retry"+  , Option ['Q'] ["quantum"]+    (NoArg (\o -> o { optQuantum = True }))+    "try sending large Initials"+  , Option ['M'] ["change-server-cid"]+    (NoArg (\o -> o { optMigration = Just ChangeServerCID }))+    "use a new server CID"+  , Option ['N'] ["change-client-cid"]+    (NoArg (\o -> o { optMigration = Just ChangeClientCID }))+    "use a new client CID"+  , Option ['B'] ["nat-rebinding"]+    (NoArg (\o -> o { optMigration = Just NATRebinding }))+    "use a new local port"+  , Option ['A'] ["address-mobility"]+    (NoArg (\o -> o { optMigration = Just ActiveMigration }))+    "use a new address and a new server CID"+  , Option ['t'] ["performance"]+    (ReqArg (\n o -> o { optPerformance = read n }) "<size>")+    "measure performance"+  , Option ['n'] ["number-of-requests"]+    (ReqArg (\n o -> o { optNumOfReqs = read n }) "<n>")+    "specify the number of requests"+  , Option ['m'] ["use-connected-socket"]+    (NoArg (\o -> o { optUnconSock = False }))+    "use connected sockets instead of unconnected sockets"+  ]++showUsageAndExit :: String -> IO a+showUsageAndExit msg = do+    putStrLn msg+    putStrLn $ usageInfo usage options+    exitFailure++clientOpts :: [String] -> IO (Options, [String])+clientOpts argv =+    case getOpt Permute options argv of+      (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)+      (_,_,errs) -> showUsageAndExit $ concat errs++main :: IO ()+main = do+    args <- getArgs+    (opts@Options{..}, ips) <- clientOpts args+    let ipslen = length ips+    when (ipslen /= 2 && ipslen /= 3) $+        showUsageAndExit "cannot recognize <addr> and <port>\n"+    cmvar <- newEmptyMVar+    let path | ipslen == 3 = ips !! 2+             | otherwise   = "/"+        addr:port:_ = ips+        ccalpn ver+          | optPerformance /= 0 = return $ Just ["perf"]+          | otherwise = let (h3X, hqX) = makeProtos ver+                            protos | optHQ     = [hqX,h3X]+                                   | otherwise = [h3X,hqX]+                        in return $ Just protos+        confver vers+          | optVerNego = GreasingVersion : vers+          | otherwise  = vers+        confparams params+          | optQuantum = let bs = BS.replicate 1200 0+                         in params { grease = Just bs }+          | otherwise  = params+        cc0 = defaultClientConfig+        cc = cc0 {+            ccServerName = addr+          , ccPortName   = port+          , ccALPN       = ccalpn+          , ccValidate   = optValidate+          , ccPacketSize = optPacketSize+          , ccDebugLog   = optDebugLog+          , ccVersions   = confver $ ccVersions cc0+          , ccParameters = confparams $ ccParameters cc0+          , ccKeyLog     = getLogger optKeyLogFile+          , ccGroups     = getGroups (ccGroups cc0) optGroups+          , ccQLog       = optQLogDir+          , ccHooks      = defaultHooks {+                onCloseCompleted = putMVar cmvar ()+              }+          , ccAutoMigration = optUnconSock+          }+        debug | optDebugLog = putStrLn+              | otherwise   = \_ -> return ()+        showContent | optShow = C8.putStrLn+                    | otherwise = \_ -> return ()+        aux = Aux {+            auxPath = path+          , auxAuthority = addr+          , auxDebug = debug+          , auxShow = showContent+          , auxCheckClose = do+                mx <- timeout 1000000 $ takeMVar cmvar+                case mx of+                  Nothing -> return False+                  _       -> return True+          }+    runClient cc opts aux++runClient :: ClientConfig -> Options -> Aux -> IO ()+runClient cc opts@Options{..} aux@Aux{..} = do+    auxDebug "------------------------"+    (info1,info2,res,mig,client') <- run cc $ \conn -> do+        i1 <- getConnectionInfo conn+        let client = case alpn i1 of+              Just proto | "hq" `BS.isPrefixOf` proto -> clientHQ optNumOfReqs+                         | "h3" `BS.isPrefixOf` proto -> clientH3 optNumOfReqs+              _                                       -> clientPF optPerformance+        m <- case optMigration of+          Nothing   -> return False+          Just mtyp -> do+              x <- controlConnection conn mtyp+              auxDebug $ "Migration by " ++ show mtyp+              return x+        t1 <- getUnixTime+        if optInteractive then do+            console aux client conn+          else do+            client aux conn+        stats <- getConnectionStats conn+        print stats+        t2 <- getUnixTime+        i2 <- getConnectionInfo conn+        r <- getResumptionInfo conn+        printThroughput t1 t2 stats+        return (i1, i2, r, m, client)+    if optVerNego then do+        putStrLn "Result: (V) version negotiation ... OK"+        exitSuccess+      else if optQuantum then do+        putStrLn "Result: (Q) quantum ... OK"+        exitSuccess+      else if optResumption then do+        if isResumptionPossible res then do+            info3 <- runClient2 cc opts aux res client'+            if handshakeMode info3 == PreSharedKey then do+                putStrLn "Result: (R) TLS resumption ... OK"+                exitSuccess+              else do+                putStrLn "Result: (R) TLS resumption ... NG"+                exitFailure+          else do+            putStrLn "Result: (R) TLS resumption ... NG"+            exitFailure+      else if opt0RTT then do+        if is0RTTPossible res then do+            info3 <- runClient2 cc opts aux res client'+            if handshakeMode info3 == RTT0 then do+                putStrLn "Result: (Z) 0-RTT ... OK"+                exitSuccess+              else do+                putStrLn "Result: (Z) 0-RTT ... NG"+                exitFailure+          else do+            putStrLn "Result: (Z) 0-RTT ... NG"+            exitFailure+      else if optRetry then do+        if retry info1 then do+            putStrLn "Result: (S) retry ... OK"+            exitSuccess+          else do+            putStrLn "Result: (S) retry ... NG"+            exitFailure+      else case optMigration of+             Just ChangeServerCID -> do+                 let changed = remoteCID info1 /= remoteCID info2+                 if mig && remoteCID info1 /= remoteCID info2 then do+                     putStrLn "Result: (M) change server CID ... OK"+                     exitSuccess+                   else do+                     putStrLn $ "Result: (M) change server CID ... NG " ++ show (mig,changed)+                     exitFailure+             Just ChangeClientCID -> do+                 let changed = localCID info1 /= localCID info2+                 if mig && changed then do+                     putStrLn "Result: (N) change client CID ... OK"+                     exitSuccess+                   else do+                     putStrLn $ "Result: (N) change client CID ... NG " ++ show (mig,changed)+                     exitFailure+             Just NATRebinding -> do+                 putStrLn "Result: (B) NAT rebinding ... OK"+                 exitSuccess+             Just ActiveMigration -> do+                 let changed = remoteCID info1 /= remoteCID info2+                 if mig && changed then do+                     putStrLn "Result: (A) address mobility ... OK"+                     exitSuccess+                   else do+                     putStrLn $ "Result: (A) address mobility ... NG " ++ show (mig,changed)+                     exitFailure+             Nothing -> do+                 putStrLn "Result: (H) handshake ... OK"+                 putStrLn "Result: (D) stream data ... OK"+                 closeCompleted <- auxCheckClose+                 when closeCompleted $ putStrLn "Result: (C) close completed ... OK"+                 case alpn info1 of+                   Nothing   -> return ()+                   Just alpn -> when ("h3" `BS.isPrefixOf` alpn) $+                     putStrLn "Result: (3) H3 transaction ... OK"+                 exitSuccess++runClient2 :: ClientConfig -> Options -> Aux -> ResumptionInfo -> Cli+           -> IO ConnectionInfo+runClient2 cc Options{..} aux@Aux{..} res client = do+    threadDelay 100000+    auxDebug "<<<< next connection >>>>"+    auxDebug "------------------------"+    run cc' $ \conn -> do+        void $ client aux conn+        getConnectionInfo conn+  where+    cc' = cc {+        ccResumption = res+      , ccUse0RTT    = opt0RTT && is0RTTPossible res+      }++printThroughput :: UnixTime -> UnixTime -> ConnectionStats -> IO ()+printThroughput t1 t2 ConnectionStats{..} =+    printf "Throughput %.2f Mbps (%d bytes in %d msecs)\n" bytesPerSeconds rxBytes millisecs+  where+    UnixDiffTime (CTime s) u = t2 `diffUnixTime` t1+    millisecs :: Int+    millisecs = fromIntegral s * 1000 + fromIntegral u `div` 1000+    bytesPerSeconds :: Double+    bytesPerSeconds = fromIntegral rxBytes * (1000 :: Double) * 8 / fromIntegral millisecs / 1024 / 1024++console :: Aux -> (Aux -> Connection -> IO ()) -> Connection -> IO ()+console aux client conn = do+    waitEstablished conn+    putStrLn "q -- quit"+    putStrLn "g -- get"+    putStrLn "p -- ping"+    putStrLn "n -- NAT rebinding"+    loop+   where+     loop = do+         hSetBuffering stdout NoBuffering+         putStr "> "+         hSetBuffering stdout LineBuffering+         l <- getLine+         case l of+           "q" -> putStrLn "bye"+           "g" -> do+               putStrLn $ "GET " ++ auxPath aux+               _ <- forkIO $ client aux conn+               loop+           "p" -> do+               putStrLn "Ping"+               sendFrames conn RTT1Level [Ping]+               loop+           "n" -> do+               controlConnection conn NATRebinding >>= print+               loop+           _   -> do+               putStrLn "No such command"+               loop
+ util/server.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE Strict #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TupleSections #-}++module Main where++import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.List as L+import Network.TLS (credentialLoadX509, Credentials(..))+import qualified Network.TLS.SessionManager as SM+import System.Console.GetOpt+import System.Environment (getArgs)+import System.Exit+import System.IO++import Common+import Network.QUIC+import Network.QUIC.Internal+import Network.QUIC.Server+import ServerX++data Options = Options {+    optDebugLogDir :: Maybe FilePath+  , optQLogDir     :: Maybe FilePath+  , optKeyLogFile  :: Maybe FilePath+  , optGroups      :: Maybe String+  , optCertFile    :: FilePath+  , optKeyFile     :: FilePath+  , optRetry       :: Bool+  } deriving Show++defaultOptions :: Options+defaultOptions = Options {+    optDebugLogDir = Nothing+  , optQLogDir     = Nothing+  , optKeyLogFile  = Nothing+  , optGroups      = Nothing+  , optCertFile    = "servercert.pem"+  , optKeyFile     = "serverkey.pem"+  , optRetry       = False+  }++options :: [OptDescr (Options -> Options)]+options = [+    Option ['d'] ["debug-log-dir"]+    (ReqArg (\dir o -> o { optDebugLogDir = Just dir }) "<dir>")+    "directory to store a debug file"+  , Option ['q'] ["qlog-dir"]+    (ReqArg (\dir o -> o { optQLogDir = Just dir }) "<dir>")+    "directory to store qlog"+  , Option ['l'] ["key-log-file"]+    (ReqArg (\file o -> o { optKeyLogFile = Just file }) "<file>")+    "a file to store negotiated secrets"+  , Option ['g'] ["groups"]+    (ReqArg (\gs o -> o { optGroups = Just gs }) "<groups>")+    "groups for key exchange"+  , Option ['c'] ["cert"]+    (ReqArg (\fl o -> o { optCertFile = fl }) "<file>")+    "certificate file"+  , Option ['k'] ["key"]+    (ReqArg (\fl o -> o { optKeyFile = fl }) "<file>")+    "key file"+  , Option ['S'] ["retry"]+    (NoArg (\o -> o { optRetry = True }))+    "require stateless retry"+  ]++usage :: String+usage = "Usage: server [OPTION] addr [addrs] port"++showUsageAndExit :: String -> IO a+showUsageAndExit msg = do+    putStrLn msg+    putStrLn $ usageInfo usage options+    exitFailure++serverOpts :: [String] -> IO (Options, [String])+serverOpts argv =+    case getOpt Permute options argv of+      (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)+      (_,_,errs) -> showUsageAndExit $ concat errs++chooseALPN :: Version -> [ByteString] -> IO ByteString+chooseALPN _ protos+  | "perf" `elem` protos = return "perf"+chooseALPN ver protos = return $ case mh3idx of+    Nothing    -> case mhqidx of+      Nothing    -> ""+      Just _     -> hqX+    Just h3idx ->  case mhqidx of+      Nothing    -> h3X+      Just hqidx -> if h3idx < hqidx then h3X else hqX+  where+    (h3X, hqX) = makeProtos ver+    mh3idx = h3X `L.elemIndex` protos+    mhqidx = hqX `L.elemIndex` protos++main :: IO ()+main = do+    hSetBuffering stdout NoBuffering+    args <- getArgs+    (Options{..}, ips) <- serverOpts args+    when (length ips < 2) $ showUsageAndExit "cannot recognize <addr> and <port>\n"+    let port = read (last ips)+        addrs = read <$> init ips+        aps = (,port) <$> addrs+    smgr <- SM.newSessionManager SM.defaultConfig+    Right cred@(!_cc,!_priv) <- credentialLoadX509 optCertFile optKeyFile+    let sc0 = defaultServerConfig+        sc = sc0 {+            scAddresses      = aps+          , scALPN           = Just chooseALPN+          , scRequireRetry   = optRetry+          , scSessionManager = smgr+          , scUse0RTT        = True+          , scDebugLog       = optDebugLogDir+          , scKeyLog         = getLogger optKeyLogFile+          , scGroups         = getGroups (scGroups sc0) optGroups+          , scQLog           = optQLogDir+          , scCredentials    = Credentials [cred]+          }+    run sc $ \conn -> do+        info <- getConnectionInfo conn+        let server = case alpn info of+              Just proto | "perf" == proto            -> serverPF+                         | "hq" `BS.isPrefixOf` proto -> serverHQ+              _                                       -> serverH3+        server conn