Skip to content

Commit

Permalink
Support ClientHooks and ServerHooks from tls
Browse files Browse the repository at this point in the history
Closes #59
  • Loading branch information
bjin committed Jan 6, 2024
1 parent 02b971e commit 6acdeb4
Show file tree
Hide file tree
Showing 3 changed files with 16 additions and 5 deletions.
4 changes: 4 additions & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
## 0.1.15

- Support customizing ClientHooks and ServerHooks config from tls

## 0.1.14

- Using crypto-token v0.1
Expand Down
5 changes: 5 additions & 0 deletions Network/QUIC/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@

module Network.QUIC.Config where

import Data.Default.Class
import Data.IP
import Network.Socket
import Network.TLS hiding (Hooks, HostName, Version)
Expand Down Expand Up @@ -57,6 +58,7 @@ data ClientConfig = ClientConfig
, ccCredentials :: Credentials
-- ^ TLS credentials.
, ccHooks :: Hooks
, ccTlsHooks :: ClientHooks
, ccUse0RTT :: Bool
-- ^ Use 0-RTT on the 2nd connection if possible.
-- client original
Expand Down Expand Up @@ -89,6 +91,7 @@ defaultClientConfig =
, ccQLog = Nothing
, ccCredentials = mempty
, ccHooks = defaultHooks
, ccTlsHooks = def
, ccUse0RTT = False
, -- client original
ccServerName = "127.0.0.1"
Expand Down Expand Up @@ -117,6 +120,7 @@ data ServerConfig = ServerConfig
, scCredentials :: Credentials
-- ^ Server certificate information.
, scHooks :: Hooks
, scTlsHooks :: ServerHooks
, scUse0RTT :: Bool
-- ^ Use 0-RTT on the 2nd connection if possible.
-- server original
Expand All @@ -143,6 +147,7 @@ defaultServerConfig =
, scQLog = Nothing
, scCredentials = mempty
, scHooks = defaultHooks
, scTlsHooks = def
, scUse0RTT = False
, -- server original
scAddresses = [("0.0.0.0", 4433), ("::", 4433)]
Expand Down
12 changes: 7 additions & 5 deletions Network/QUIC/TLS.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ module Network.QUIC.TLS (
serverHandshaker,
) where

import Control.Applicative ((<|>))
import Data.Default.Class
import Network.TLS hiding (Version)
import Network.TLS.QUIC
Expand Down Expand Up @@ -57,8 +58,8 @@ clientHandshaker callbacks ClientConfig{..} ver myAuthCIDs establish use0RTT = d
, sharedSessionManager = sessionManager establish
}
hook =
def
{ onSuggestALPN = ccALPN ver
ccTlsHooks
{ onSuggestALPN = (<|>) <$> ccALPN ver <*> onSuggestALPN ccTlsHooks
}
supported =
defaultSupported
Expand Down Expand Up @@ -101,14 +102,15 @@ serverHandshaker callbacks ServerConfig{..} ver getParams =
, sharedSessionManager = scSessionManager
}
hook =
def
scTlsHooks
{ onALPNClientSuggest = case scALPN of
Nothing -> Nothing
Nothing -> onALPNClientSuggest scTlsHooks
Just io -> Just $ io ver
, onEncryptedExtensionsCreating = \exts0 -> do
exts0' <- onEncryptedExtensionsCreating scTlsHooks exts0
params <- getParams
let exts = convExt $ parametersToExtensionRaw ver $ convTP params
return $ exts ++ exts0
return $ exts ++ exts0'
}
supported =
def
Expand Down

0 comments on commit 6acdeb4

Please sign in to comment.