diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Network/QUIC.hs b/Network/QUIC.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC.hs @@ -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 diff --git a/Network/QUIC/Client.hs b/Network/QUIC/Client.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Client.hs @@ -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 diff --git a/Network/QUIC/Client/Reader.hs b/Network/QUIC/Client/Reader.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Client/Reader.hs @@ -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 diff --git a/Network/QUIC/Client/Run.hs b/Network/QUIC/Client/Run.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Client/Run.hs @@ -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 diff --git a/Network/QUIC/Closer.hs b/Network/QUIC/Closer.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Closer.hs @@ -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 diff --git a/Network/QUIC/Common.hs b/Network/QUIC/Common.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Common.hs @@ -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 diff --git a/Network/QUIC/Config.hs b/Network/QUIC/Config.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Config.hs @@ -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 + } diff --git a/Network/QUIC/Connection.hs b/Network/QUIC/Connection.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection.hs @@ -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 diff --git a/Network/QUIC/Connection/Crypto.hs b/Network/QUIC/Connection/Crypto.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Crypto.hs @@ -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) diff --git a/Network/QUIC/Connection/Migration.hs b/Network/QUIC/Connection/Migration.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Migration.hs @@ -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 () diff --git a/Network/QUIC/Connection/Misc.hs b/Network/QUIC/Connection/Misc.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Misc.hs @@ -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 diff --git a/Network/QUIC/Connection/PacketNumber.hs b/Network/QUIC/Connection/PacketNumber.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/PacketNumber.hs @@ -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 diff --git a/Network/QUIC/Connection/Queue.hs b/Network/QUIC/Connection/Queue.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Queue.hs @@ -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 diff --git a/Network/QUIC/Connection/Role.hs b/Network/QUIC/Connection/Role.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Role.hs @@ -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 diff --git a/Network/QUIC/Connection/State.hs b/Network/QUIC/Connection/State.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/State.hs @@ -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 diff --git a/Network/QUIC/Connection/Stream.hs b/Network/QUIC/Connection/Stream.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Stream.hs @@ -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 diff --git a/Network/QUIC/Connection/StreamTable.hs b/Network/QUIC/Connection/StreamTable.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/StreamTable.hs @@ -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 diff --git a/Network/QUIC/Connection/Timeout.hs b/Network/QUIC/Connection/Timeout.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Timeout.hs @@ -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 diff --git a/Network/QUIC/Connection/Types.hs b/Network/QUIC/Connection/Types.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Types.hs @@ -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 diff --git a/Network/QUIC/Connection/Types.hs-boot b/Network/QUIC/Connection/Types.hs-boot new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connection/Types.hs-boot @@ -0,0 +1,3 @@ +module Network.QUIC.Connection.Types where + +data Connection diff --git a/Network/QUIC/Connector.hs b/Network/QUIC/Connector.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Connector.hs @@ -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 diff --git a/Network/QUIC/Crypto.hs b/Network/QUIC/Crypto.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Crypto.hs @@ -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" diff --git a/Network/QUIC/CryptoFusion.hs b/Network/QUIC/CryptoFusion.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/CryptoFusion.hs @@ -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) diff --git a/Network/QUIC/Exception.hs b/Network/QUIC/Exception.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Exception.hs @@ -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 diff --git a/Network/QUIC/Handshake.hs b/Network/QUIC/Handshake.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Handshake.hs @@ -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) diff --git a/Network/QUIC/IO.hs b/Network/QUIC/IO.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/IO.hs @@ -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 () diff --git a/Network/QUIC/Imports.hs b/Network/QUIC/Imports.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Imports.hs @@ -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, ()) diff --git a/Network/QUIC/Info.hs b/Network/QUIC/Info.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Info.hs @@ -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 + } diff --git a/Network/QUIC/Internal.hs b/Network/QUIC/Internal.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Internal.hs @@ -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 diff --git a/Network/QUIC/Logger.hs b/Network/QUIC/Logger.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Logger.hs @@ -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) diff --git a/Network/QUIC/Packet.hs b/Network/QUIC/Packet.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Packet.hs @@ -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 diff --git a/Network/QUIC/Packet/Decode.hs b/Network/QUIC/Packet/Decode.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Packet/Decode.hs @@ -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 diff --git a/Network/QUIC/Packet/Decrypt.hs b/Network/QUIC/Packet/Decrypt.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Packet/Decrypt.hs @@ -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 diff --git a/Network/QUIC/Packet/Encode.hs b/Network/QUIC/Packet/Encode.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Packet/Encode.hs @@ -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 diff --git a/Network/QUIC/Packet/Frame.hs b/Network/QUIC/Packet/Frame.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Packet/Frame.hs @@ -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 diff --git a/Network/QUIC/Packet/Header.hs b/Network/QUIC/Packet/Header.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Packet/Header.hs @@ -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 diff --git a/Network/QUIC/Packet/Number.hs b/Network/QUIC/Packet/Number.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Packet/Number.hs @@ -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 diff --git a/Network/QUIC/Packet/Token.hs b/Network/QUIC/Packet/Token.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Packet/Token.hs @@ -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) diff --git a/Network/QUIC/Parameters.hs b/Network/QUIC/Parameters.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Parameters.hs @@ -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 + } diff --git a/Network/QUIC/QLogger.hs b/Network/QUIC/QLogger.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/QLogger.hs @@ -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) diff --git a/Network/QUIC/Qlog.hs b/Network/QUIC/Qlog.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Qlog.hs @@ -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 diff --git a/Network/QUIC/Receiver.hs b/Network/QUIC/Receiver.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Receiver.hs @@ -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 "" diff --git a/Network/QUIC/Recovery.hs b/Network/QUIC/Recovery.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery.hs @@ -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 diff --git a/Network/QUIC/Recovery/Constants.hs b/Network/QUIC/Recovery/Constants.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Constants.hs @@ -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) diff --git a/Network/QUIC/Recovery/Detect.hs b/Network/QUIC/Recovery/Detect.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Detect.hs @@ -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 diff --git a/Network/QUIC/Recovery/Interface.hs b/Network/QUIC/Recovery/Interface.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Interface.hs @@ -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 diff --git a/Network/QUIC/Recovery/LossRecovery.hs b/Network/QUIC/Recovery/LossRecovery.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/LossRecovery.hs @@ -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' diff --git a/Network/QUIC/Recovery/Metrics.hs b/Network/QUIC/Recovery/Metrics.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Metrics.hs @@ -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) diff --git a/Network/QUIC/Recovery/Misc.hs b/Network/QUIC/Recovery/Misc.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Misc.hs @@ -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 } diff --git a/Network/QUIC/Recovery/PeerPacketNumbers.hs b/Network/QUIC/Recovery/PeerPacketNumbers.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/PeerPacketNumbers.hs @@ -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 diff --git a/Network/QUIC/Recovery/Persistent.hs b/Network/QUIC/Recovery/Persistent.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Persistent.hs @@ -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 diff --git a/Network/QUIC/Recovery/Release.hs b/Network/QUIC/Recovery/Release.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Release.hs @@ -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 + } diff --git a/Network/QUIC/Recovery/Timer.hs b/Network/QUIC/Recovery/Timer.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Timer.hs @@ -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 diff --git a/Network/QUIC/Recovery/Types.hs b/Network/QUIC/Recovery/Types.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Types.hs @@ -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 diff --git a/Network/QUIC/Recovery/Utils.hs b/Network/QUIC/Recovery/Utils.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Recovery/Utils.hs @@ -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 diff --git a/Network/QUIC/Sender.hs b/Network/QUIC/Sender.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Sender.hs @@ -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 diff --git a/Network/QUIC/Server.hs b/Network/QUIC/Server.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Server.hs @@ -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 diff --git a/Network/QUIC/Server/Reader.hs b/Network/QUIC/Server/Reader.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Server/Reader.hs @@ -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) diff --git a/Network/QUIC/Server/Run.hs b/Network/QUIC/Server/Run.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Server/Run.hs @@ -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 diff --git a/Network/QUIC/Socket.hs b/Network/QUIC/Socket.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Socket.hs @@ -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 diff --git a/Network/QUIC/Stream.hs b/Network/QUIC/Stream.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Stream.hs @@ -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 diff --git a/Network/QUIC/Stream/Frag.hs b/Network/QUIC/Stream/Frag.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Stream/Frag.hs @@ -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" diff --git a/Network/QUIC/Stream/Misc.hs b/Network/QUIC/Stream/Misc.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Stream/Misc.hs @@ -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 diff --git a/Network/QUIC/Stream/Queue.hs b/Network/QUIC/Stream/Queue.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Stream/Queue.hs @@ -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 diff --git a/Network/QUIC/Stream/Reass.hs b/Network/QUIC/Stream/Reass.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Stream/Reass.hs @@ -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 diff --git a/Network/QUIC/Stream/Skew.hs b/Network/QUIC/Stream/Skew.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Stream/Skew.hs @@ -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 +-} diff --git a/Network/QUIC/Stream/Table.hs b/Network/QUIC/Stream/Table.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Stream/Table.hs @@ -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 diff --git a/Network/QUIC/Stream/Types.hs b/Network/QUIC/Stream/Types.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Stream/Types.hs @@ -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 diff --git a/Network/QUIC/TLS.hs b/Network/QUIC/TLS.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/TLS.hs @@ -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 + } diff --git a/Network/QUIC/Types.hs b/Network/QUIC/Types.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types.hs @@ -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 () diff --git a/Network/QUIC/Types/Ack.hs b/Network/QUIC/Types/Ack.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Ack.hs @@ -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 + diff --git a/Network/QUIC/Types/CID.hs b/Network/QUIC/Types/CID.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/CID.hs @@ -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) diff --git a/Network/QUIC/Types/Constants.hs b/Network/QUIC/Types/Constants.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Constants.hs @@ -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 diff --git a/Network/QUIC/Types/Error.hs b/Network/QUIC/Types/Error.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Error.hs @@ -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) diff --git a/Network/QUIC/Types/Exception.hs b/Network/QUIC/Types/Exception.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Exception.hs @@ -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 diff --git a/Network/QUIC/Types/Frame.hs b/Network/QUIC/Types/Frame.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Frame.hs @@ -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 diff --git a/Network/QUIC/Types/Integer.hs b/Network/QUIC/Types/Integer.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Integer.hs @@ -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) diff --git a/Network/QUIC/Types/Packet.hs b/Network/QUIC/Types/Packet.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Packet.hs @@ -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 diff --git a/Network/QUIC/Types/Queue.hs b/Network/QUIC/Types/Queue.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Queue.hs @@ -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 diff --git a/Network/QUIC/Types/Resumption.hs b/Network/QUIC/Types/Resumption.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Resumption.hs @@ -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 + diff --git a/Network/QUIC/Types/Time.hs b/Network/QUIC/Types/Time.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Types/Time.hs @@ -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 diff --git a/Network/QUIC/Utils.hs b/Network/QUIC/Utils.hs new file mode 100644 --- /dev/null +++ b/Network/QUIC/Utils.hs @@ -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 () diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cbits/fusion.c b/cbits/fusion.c new file mode 100644 --- /dev/null +++ b/cbits/fusion.c @@ -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 + +#include +#include +#include +#include +#include +#include +#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); +} diff --git a/cbits/picotls.c b/cbits/picotls.c new file mode 100644 --- /dev/null +++ b/cbits/picotls.c @@ -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 +#include +#include +#include +#include +#ifdef _WINDOWS +#include "wincompat.h" +#else +#include +#include +#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(¬_before, &src, end)) != 0 || (ret = ptls_decode64(¬_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, ¶ms)) != 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, ¶ms); + } 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; +} diff --git a/cbits/picotls.h b/cbits/picotls.h new file mode 100644 --- /dev/null +++ b/cbits/picotls.h @@ -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 +#include +#include +#include + +#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(©, md); \ + ptls_clear_memory(©, 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 diff --git a/cbits/picotls/fusion.h b/cbits/picotls/fusion.h new file mode 100644 --- /dev/null +++ b/cbits/picotls/fusion.h @@ -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 +#include +#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 diff --git a/quic.cabal b/quic.cabal new file mode 100644 --- /dev/null +++ b/quic.cabal @@ -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 diff --git a/test/Config.hs b/test/Config.hs new file mode 100644 --- /dev/null +++ b/test/Config.hs @@ -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 diff --git a/test/ErrorSpec.hs b/test/ErrorSpec.hs new file mode 100644 --- /dev/null +++ b/test/ErrorSpec.hs @@ -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 diff --git a/test/FrameSpec.hs b/test/FrameSpec.hs new file mode 100644 --- /dev/null +++ b/test/FrameSpec.hs @@ -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 diff --git a/test/HandshakeSpec.hs b/test/HandshakeSpec.hs new file mode 100644 --- /dev/null +++ b/test/HandshakeSpec.hs @@ -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 diff --git a/test/IOSpec.hs b/test/IOSpec.hs new file mode 100644 --- /dev/null +++ b/test/IOSpec.hs @@ -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' diff --git a/test/PacketSpec.hs b/test/PacketSpec.hs new file mode 100644 --- /dev/null +++ b/test/PacketSpec.hs @@ -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" + ] diff --git a/test/RecoverySpec.hs b/test/RecoverySpec.hs new file mode 100644 --- /dev/null +++ b/test/RecoverySpec.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/TLSSpec.hs b/test/TLSSpec.hs new file mode 100644 --- /dev/null +++ b/test/TLSSpec.hs @@ -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" diff --git a/test/TransportError.hs b/test/TransportError.hs new file mode 100644 --- /dev/null +++ b/test/TransportError.hs @@ -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 diff --git a/test/TypesSpec.hs b/test/TypesSpec.hs new file mode 100644 --- /dev/null +++ b/test/TypesSpec.hs @@ -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 diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,4 @@ +import Test.DocTest + +main :: IO () +main = doctest ["Network.QUIC.Client","Network.QUIC.Server"] diff --git a/test/servercert.pem b/test/servercert.pem new file mode 100644 --- /dev/null +++ b/test/servercert.pem @@ -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----- diff --git a/test/serverkey.pem b/test/serverkey.pem new file mode 100644 --- /dev/null +++ b/test/serverkey.pem @@ -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----- diff --git a/util/ClientX.hs b/util/ClientX.hs new file mode 100644 --- /dev/null +++ b/util/ClientX.hs @@ -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 diff --git a/util/Common.hs b/util/Common.hs new file mode 100644 --- /dev/null +++ b/util/Common.hs @@ -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) diff --git a/util/H3.hs b/util/H3.hs new file mode 100644 --- /dev/null +++ b/util/H3.hs @@ -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 = "Welcome to QUIC in Haskell

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.

" diff --git a/util/ServerX.hs b/util/ServerX.hs new file mode 100644 --- /dev/null +++ b/util/ServerX.hs @@ -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 diff --git a/util/client.hs b/util/client.hs new file mode 100644 --- /dev/null +++ b/util/client.hs @@ -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 }) "") + "directory to store qlog" + , Option ['l'] ["key-log-file"] + (ReqArg (\file o -> o { optKeyLogFile = Just file }) "") + "a file to store negotiated secrets" + , Option ['g'] ["groups"] + (ReqArg (\gs o -> o { optGroups = Just gs }) "") + "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) }) "") + "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 }) "") + "measure performance" + , Option ['n'] ["number-of-requests"] + (ReqArg (\n o -> o { optNumOfReqs = read 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 and \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 diff --git a/util/server.hs b/util/server.hs new file mode 100644 --- /dev/null +++ b/util/server.hs @@ -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 }) "") + "directory to store a debug file" + , Option ['q'] ["qlog-dir"] + (ReqArg (\dir o -> o { optQLogDir = Just dir }) "") + "directory to store qlog" + , Option ['l'] ["key-log-file"] + (ReqArg (\file o -> o { optKeyLogFile = Just file }) "") + "a file to store negotiated secrets" + , Option ['g'] ["groups"] + (ReqArg (\gs o -> o { optGroups = Just gs }) "") + "groups for key exchange" + , Option ['c'] ["cert"] + (ReqArg (\fl o -> o { optCertFile = fl }) "") + "certificate file" + , Option ['k'] ["key"] + (ReqArg (\fl o -> o { optKeyFile = fl }) "") + "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 and \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