あどけない話

Internet technologies

Improving QUIC APIs of the TLS library in Haskell

In "Implementation status of QUIC in Haskell", I briefly described QUIC APIs of the TLS library in Haskell. I first invented APIs based on static functions but switched to the thread-based approach to follow Olivier Chéron's recommendation. The current APIs got two steps further. This article describes how Olivier and I improved the thread-based APIs.

Recall the handshake flow of TLS 1.3:

f:id:kazu-yamamoto:20200916150139p:plain:w400
The handshake flow of TLS 1.3

This article focuses on the client side because it is more challenging than the server side.

Thread-based APIs

With the thread-based APIs, a designate TLS thread is spawn and its controller is created by the following API:

newQUICClient :: ClientParams -> IO ClientController

ClientController is defined as follows:

type ClientController = ClientControl -> IO ClientStatus

That is, the controller passes ClientControl to the designated thread and receives ClientStatus. ClientControl is defined as follows:

data ClientControl =
    GetClientHello                 -- ^ 'SendClientHello'
  | PutServerHello ServerHello     -- ^ 'SendClientHello', 'RecvServerHello', 'ClientNeedsMore'
  | PutServerFinished Finished     -- ^ 'SendClientFinished'
  | PutSessionTicket SessionTicket -- ^ 'RecvSessionTicket'
  | ExitClient                     -- ^ 'ClientHandshakeDone'

The comments in the right-hand side describe corresponding ClientStatus. The entire definition of ClientStatus is as follows:

data ClientStatus =
    ClientNeedsMore
  | SendClientHello ClientHello (Maybe EarlySecretInfo)
  | RecvServerHello HandshakeSecretInfo
  | SendClientFinished Finished [ExtensionRaw] ApplicationSecretInfo
  | RecvSessionTicket
  | ClientHandshakeDone

Users of the controller can receive key information, TLS extension for QUIC transport parameters, etc through ClientStatus. The following is an example usage of the controller:

handshakeClient :: ClientConfig -> Connection -> IO ()
handshakeClient conf conn = do
    ver <- getVersion conn
    let sendEarlyData = isJust $ ccEarlyData conf
    control <- clientController conf ver (setResumptionSession conn) sendEarlyData
    setClientController conn control
    sendClientHelloAndRecvServerHello control conn $ ccEarlyData conf
    recvServerFinishedSendClientFinished control conn

sendClientHelloAndRecvServerHello :: ClientController -> Connection -> Maybe (StreamId,ByteString) -> IO ()
sendClientHelloAndRecvServerHello control conn mEarlyData = do
    SendClientHello ch0 mEarlySecInf <- control GetClientHello
    setEarlySecretInfo conn mEarlySecInf
    sendCryptoData conn $ OutHndClientHello ch0 mEarlyData
    (InitialLevel, sh0) <- recvCryptoData conn
    state0 <- control $ PutServerHello sh0
    case state0 of
      RecvServerHello hndSecInf -> do
          setHandshakeSecretInfo conn hndSecInf
          setEncryptionLevel conn HandshakeLevel
      SendClientHello ch1 mEarlySecInf1 -> do
          setEarlySecretInfo conn mEarlySecInf1
          sendCryptoData conn $ OutHndClientHello ch1 Nothing
          (InitialLevel, sh1) <- recvCryptoData conn
          state1 <- control $ PutServerHello sh1
          case state1 of
            RecvServerHello hndSecInf -> do
                setHandshakeSecretInfo conn hndSecInf
                setEncryptionLevel conn HandshakeLevel
            _ -> E.throwIO $ HandshakeFailed "sendClientHelloAndRecvServerHello"
      _ -> E.throwIO $ HandshakeFailed "sendClientHelloAndRecvServerHello"

recvServerFinishedSendClientFinished :: ClientController -> Connection -> IO ()
recvServerFinishedSendClientFinished control conn = loop (1 :: Int)
  where
    loop n = do
        (HandshakeLevel, eesf) <- recvCryptoData conn
        state <- control $ PutServerFinished eesf
        case state of
          ClientNeedsMore -> do
              -- Sending ACKs for three times rule
              when ((n `mod` 3) == 2) $
                  sendCryptoData conn $ OutControl HandshakeLevel []
              loop (n + 1)
          SendClientFinished cf exts appSecInf -> do
              setApplicationSecretInfo conn appSecInf
              setEncryptionLevel conn RTT1Level
              setPeerParams conn exts
              sendCryptoData conn $ OutHndClientFinished cf
          _ -> E.throwIO $ HandshakeFailed "putServerFinished"

NewSessionTicket in a CRYPTO frame is passed to the controller by a receiver thread.

Introducing callbacks

Olivier noticed that both the designated thread and the user of the controller manages the TLS state. To reduce the number of status in the user side, he defined callbacks:

data QUICCallbacks = QUICCallbacks {
    quicSend              :: [(CryptLevel, ByteString)] -> IO ()
  , quicRecv              :: CryptLevel -> IO (Either TLSError ByteString)
  , quicInstallKeys       :: KeyScheduleEvent -> IO ()
  , quicNotifyExtensions  :: [ExtensionRaw] -> IO ()
  }

Now newQUICClient takes QUICCallbacks additionally while the definition of ClientController remains the same:

newQUICClient :: ClientParams -> QUICCallbacks -> IO ClientController
type ClientController = ClientControl -> IO ClientStatus

Then Olivier divided the client side into two phases:

  • Phase 1: Send ClientHello, receive ServerHello etc and send Finished.
  • Phase 2: Receive NewSessionTicket and store it through a session manager.

The inside of the phases is opaque to users. Both ClientControl and ClientStatus were simplified as follows:

data ClientControl =
    EnterClient          -- ^ 'ClientHandshakeComplete', 'ClientHandshakeFailed'
  | RecvSessionTickets   -- ^ 'ClientRecvSessionTicket', 'ClientHandshakeFailed'
  | ExitClient           -- ^ 'ClientHandshakeDone'

data ClientStatus =
    ClientHandshakeComplete
  | ClientRecvSessionTicket
  | ClientHandshakeDone
  | ClientHandshakeFailed TLSError
  deriving Show

Phase 1 is handled by a user while phase 2 is treated by another thread:

do handshakeClient conf conn `E.onException` clearThreads conn
   tid4 <- forkIO $ getClientController conn >>= handshakeClientAsync conn

The followings are the definition of handshakeClient and handshakeClientAsync:

handshakeClient :: ClientConfig -> Connection -> IO ()
handshakeClient conf conn = do
    ver <- getVersion conn
    hsr <- newHndStateRef
    let sendEarlyData = isJust $ ccEarlyData conf
        qc = QUICCallbacks { quicSend = sendTLS conn hsr
                           , quicRecv = recvTLS conn hsr
                           , quicInstallKeys = installKeysClient
                           , quicNotifyExtensions = setPeerParams conn
                           }
    control <- clientController qc conf ver (setResumptionSession conn) sendEarlyData
    setClientController conn control
    state <- control EnterClient
    case state of
        ClientHandshakeComplete -> return ()
        ClientHandshakeFailed e -> notifyPeer conn e >>= E.throwIO
        _ -> E.throwIO $ HandshakeFailed $ "handshakeClient: unexpected " ++ show state

  where
    installKeysClient (InstallEarlyKeys mEarlySecInf) = do
        setEarlySecretInfo conn mEarlySecInf
        sendCryptoData conn $ OutEarlyData (ccEarlyData conf)
    installKeysClient (InstallHandshakeKeys hndSecInf) = do
        setHandshakeSecretInfo conn hndSecInf
        setEncryptionLevel conn HandshakeLevel
    installKeysClient (InstallApplicationKeys appSecInf) = do
        setApplicationSecretInfo conn appSecInf
        setEncryptionLevel conn RTT1Level

-- second half the the TLS handshake, executed out of the main thread
handshakeClientAsync :: Connection -> ClientController -> IO ()
handshakeClientAsync conn control = handleLog logAction $ forever $ do
    state <- control RecvSessionTickets
    case state of
        ClientRecvSessionTicket -> return ()
        ClientHandshakeFailed e -> notifyPeerAsync conn e >>= E.throwIO
        _ -> E.throwIO $ HandshakeFailed $ "unexpected " ++ show state
  where
    logAction msg = connDebugLog conn ("client handshake: " ++ msg)

Stateless APIs

When I tried to implement HTTP/3, I noticed a disadvantage of this APIs. handshakeClient returns when 1-RTT gets ready. This means that dynamically-created early data of 0-RTT cannot be sent.

So, I removed both ClientControl and ClientStatus completely from users. newQUICClient was renamed to tlsQUICClient and it does not return ClientController anymore:

tlsQUICClient :: ClientParams -> QUICCallbacks -> IO ()

QUICCallbacks takes one more field quicDone mainly used in the server side:

data QUICCallbacks = QUICCallbacks {
    quicSend             :: [(CryptLevel, ByteString)] -> IO ()
  , quicRecv             :: CryptLevel -> IO (Either TLSError ByteString)
  , quicInstallKeys      :: Context -> KeyScheduleEvent -> IO ()
  , quicNotifyExtensions :: Context -> [ExtensionRaw] -> IO ()
  , quicDone             :: Context -> IO ()
  }

handshakeClient forks the action of tlsQUICClient and synchronizes with it to return when either 0-RTT or 1-RTT gets ready:

handshakeClient :: ClientConfig -> Connection -> AuthCIDs -> IO ()
handshakeClient conf conn myAuthCIDs = do
    ver <- getVersion conn
    hsr <- newHndStateRef
    let use0RTT = ccUse0RTT conf
        qc = QUICCallbacks { quicSend = sendTLS conn hsr
                           , quicRecv = recvTLS conn hsr
                           , quicInstallKeys = installKeysClient hsr
                           , quicNotifyExtensions = setPeerParams conn
                           , quicDone = done
                           }
        setter = setResumptionSession conn
        handshaker = tlsQUICClient ... qc
    tid <- forkIO (handshaker `E.catch` tell)
    qlogParamsSet conn (confParameters (ccConfig conf), "local")
    setKillHandshaker conn tid
    if use0RTT then
       wait0RTTReady conn
     else
       wait1RTTReady conn
  where
    tell (TLS.HandshakeFailed (TLS.Error_Misc _)) = return () -- thread blocked
    tell e = notifyPeer conn $ getErrorCause e
    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 hsr _ctx (InstallHandshakeKeys (HandshakeSecretInfo cphr tss)) = do
        setCipher conn HandshakeLevel cphr
        setCipher conn RTT1Level cphr
        initializeCoder conn HandshakeLevel tss
        setEncryptionLevel conn HandshakeLevel
        rxLevelChanged hsr
    installKeysClient hsr ctx (InstallApplicationKeys appSecInf@(ApplicationSecretInfo tss)) = do
        storeNegotiated conn ctx appSecInf
        initializeCoder conn RTT1Level tss
        setEncryptionLevel conn RTT1Level
        rxLevelChanged hsr
        setConnection1RTTReady conn
        cidInfo <- getNewMyCID conn
        let ncid = NewConnectionID cidInfo 0
        putOutput conn $ OutControl RTT1Level [ncid]
    done _ctx = do
        info <- getConnectionInfo conn
        connDebugLog conn $ bhow info

Like the first approach, NewSessionTicket in a CRYPTO frame is passed to the controller by a receiver thread.

Now the APIs are thread-based, stateless and callbacks only!

Note

If you want to know the discussions deeply, please refer to the following pull requests: