diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,11 @@ # Revision history for rustls +## 0.2.2.0 -- 25.03.2025 + + * Use rustls-ffi 0.15.0. + * Allow to get the handshake kind and the negotiated key exchange group. + * Allow to enforce CRL expiry. + ## 0.2.1.0 -- 30.12.2024 * Add `use-pkg-config` flag (enabled by default). diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ [![CI](https://github.com/amesgen/hs-rustls/workflows/CI/badge.svg)](https://github.com/amesgen/hs-rustls/actions) [![Hackage](https://img.shields.io/hackage/v/rustls)](https://hackage.haskell.org/package/rustls) -Haskell bindings for the [Rustls](https://github.com/rustls/rustls) TLS library via [rustls-ffi](https://github.com/rustls/rustls-ffi). +Haskell bindings for the [Rustls](https://github.com/rustls/rustls) TLS library via [rustls-ffi][]. See [the haddocks](https://hackage.haskell.org/package/rustls/docs/Rustls.html) for documentation. @@ -22,15 +22,9 @@ #### rustls-ffi -Make sure to have [Cargo](https://doc.rust-lang.org/stable/cargo/getting-started/installation.html) installed. Then, clone and install rustls-ffi: - -```bash -git clone https://github.com/rustls/rustls-ffi -b v0.14.1 -cd rustls-ffi -make DESTDIR=/path/to/some/dir install -``` +Install [rustls-ffi][] 0.15 either by downloading a pre-built artifact from the release page, or by [building it from source](https://github.com/rustls/rustls-ffi#build-rustls-ffi). -Then, in a `cabal.project.local`, add these lines: +If you installed rustls-ffi globally, you should be good to go. Otherwise, assuming that you installed it to `/path/to/some/dir`, in a `cabal.project.local`, add these lines: ```cabal extra-include-dirs: /path/to/some/dir/include @@ -39,8 +33,8 @@ With this, Cabal should be able to find the rustls-ffi native library. -> Note: This process might become less manual if sth like [haskell/cabal#7906](https://github.com/haskell/cabal/issues/7906) lands in Cabal. - #### Testing When running the tests in this repo, you have to have [minica](https://github.com/jsha/minica) and [miniserve](https://github.com/svenstaro/miniserve) installed. + +[rustls-ffi]: https://github.com/rustls/rustls-ffi diff --git a/cbits/hs_rustls.h b/cbits/hs_rustls.h --- a/cbits/hs_rustls.h +++ b/cbits/hs_rustls.h @@ -24,12 +24,39 @@ *str = rustls_connection_get_negotiated_ciphersuite_name(conn); } +static inline void hs_rustls_connection_get_negotiated_key_exchange_group_name( + const struct rustls_connection *conn, rustls_str *str); +static inline void hs_rustls_connection_get_negotiated_key_exchange_group_name( + const struct rustls_connection *conn, rustls_str *str) { + *str = rustls_connection_get_negotiated_key_exchange_group_name(conn); +} + +static inline void hs_rustls_server_connection_get_server_name( + const struct rustls_connection *conn, rustls_str *str); +static inline void hs_rustls_server_connection_get_server_name( + const struct rustls_connection *conn, rustls_str *str) { + *str = rustls_server_connection_get_server_name(conn); +} + static inline uint16_t hs_rustls_supported_ciphersuite_protocol_version( const struct rustls_supported_ciphersuite *supported_ciphersuite); static inline uint16_t hs_rustls_supported_ciphersuite_protocol_version( const struct rustls_supported_ciphersuite *supported_ciphersuite) { return (uint16_t)rustls_supported_ciphersuite_protocol_version( supported_ciphersuite); +} + +static inline uint16_t +hs_rustls_connection_handshake_kind(const struct rustls_connection *conn); +static inline uint16_t +hs_rustls_connection_handshake_kind(const struct rustls_connection *conn) { + return (uint16_t)rustls_connection_handshake_kind(conn); +} + +static inline void hs_rustls_handshake_kind_str(uint16_t kind, rustls_str *str); +static inline void hs_rustls_handshake_kind_str(uint16_t kind, + rustls_str *str) { + *str = rustls_handshake_kind_str(kind); } #endif diff --git a/rustls.cabal b/rustls.cabal --- a/rustls.cabal +++ b/rustls.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: rustls -version: 0.2.1.0 +version: 0.2.2.0 synopsis: TLS bindings for Rustls description: TLS bindings for [Rustls](https://github.com/rustls/rustls) @@ -74,7 +74,7 @@ transformers >=0.5.6 && <0.7, if flag(use-pkg-config) - pkgconfig-depends: rustls >=0.14 && <0.15 + pkgconfig-depends: rustls >=0.15 && <0.16 else extra-libraries: rustls diff --git a/src/Rustls.hs b/src/Rustls.hs --- a/src/Rustls.hs +++ b/src/Rustls.hs @@ -4,8 +4,9 @@ -- See the [README on GitHub](https://github.com/amesgen/hs-rustls/tree/main/rustls) -- for setup instructions. -- --- Currently, most of the functionality exposed by rustls-ffi is available, --- while rustls-ffi is still missing some more niche Rustls features. +-- Currently, a large part of the functionality exposed by rustls-ffi is +-- available; please open an issue if you want to use something that is not yet +-- exposed. -- -- Also see [http-client-rustls](https://hackage.haskell.org/package/http-client-rustls) -- for making HTTPS requests using @@ -93,9 +94,11 @@ -- ** Handshaking handshake, HandshakeQuery, + getHandshakeKind, getALPNProtocol, getTLSVersion, getNegotiatedCipherSuite, + getNegotiatedKeyExchangeGroup, getSNIHostname, getPeerCertificate, @@ -136,6 +139,12 @@ TLSVersion (TLS12, TLS13, unTLSVersion), CipherSuite (..), NegotiatedCipherSuite (..), + NegotiatedKeyExchangeGroup (..), + HandshakeKind + ( HandshakeKindFull, + HandshakeKindFullWithHelloRetryRequest, + HandshakeKindResumed + ), -- ** Exceptions RustlsException, @@ -185,7 +194,7 @@ -- cryptography provider. -- -- >>> version --- "rustls-ffi/0.14.1/rustls/0.23.18/aws-lc-rs" +-- "rustls-ffi/0.15.0/rustls/0.23.25/aws-lc-rs" version :: Text version = unsafePerformIO $ alloca \strPtr -> do FFI.hsVersion strPtr @@ -407,11 +416,14 @@ crls :: [CStringLen] <- for serverCertVerifierCRLs $ ContT . BU.unsafeUseAsCStringLen . unCertificateRevocationList - liftIO $ for_ crls \(ptr, len) -> - FFI.webPkiServerCertVerifierBuilderAddCrl - scvb - (ConstPtr (castPtr ptr)) - (intToCSize len) + liftIO do + for_ crls \(ptr, len) -> + FFI.webPkiServerCertVerifierBuilderAddCrl + scvb + (ConstPtr (castPtr ptr)) + (intToCSize len) + when serverCertVerifierEnforceCRLExpiry $ + rethrowR =<< FFI.webPkiServerCertVerifierEnforceRevocationExpiry scvb scvPtr <- ContT alloca let buildScv = do rethrowR =<< FFI.webPkiServerCertVerifierBuilderBuild scvb scvPtr @@ -624,6 +636,11 @@ _ <- completePriorIO c runReaderT query c +-- | Describes which sort of TLS handshake happened. +getHandshakeKind :: HandshakeQuery side HandshakeKind +getHandshakeKind = handshakeQuery \Connection' {conn} -> + HandshakeKind <$> FFI.connectionHandshakeKind (ConstPtr conn) + -- | Get the negotiated ALPN protocol, if any. getALPNProtocol :: HandshakeQuery side (Maybe ALPNProtocol) getALPNProtocol = handshakeQuery \Connection' {conn, lenPtr} -> @@ -658,19 +675,29 @@ pure NegotiatedCipherSuite {..} +-- | Get the negotiated key exchange group. +getNegotiatedKeyExchangeGroup :: HandshakeQuery side NegotiatedKeyExchangeGroup +getNegotiatedKeyExchangeGroup = handshakeQuery \Connection' {conn} -> do + negotiatedKeyExchangeGroupID <- + FFI.connectionGetNegotiatedKeyExchangeGroup (ConstPtr conn) + when (negotiatedKeyExchangeGroupID == 0) $ + fail "internal rustls error: no exchange group negotiated" + + negotiatedKeyExchangeGroupName <- alloca \strPtr -> do + FFI.connectionGetNegotiatedKeyExchangeGroupName (ConstPtr conn) strPtr + strToText =<< peek strPtr + when (T.null negotiatedKeyExchangeGroupName) $ + fail "internal rustls error: no key exchange group negotiated" + + pure NegotiatedKeyExchangeGroup {..} + -- | Get the SNI hostname set by the client, if any. getSNIHostname :: HandshakeQuery Server (Maybe Text) -getSNIHostname = handshakeQuery \Connection' {conn, lenPtr} -> - let go n = allocaBytes (cSizeToInt n) \bufPtr -> do - res <- FFI.serverConnectionGetSNIHostname (ConstPtr conn) bufPtr n lenPtr - if res == FFI.resultInsufficientSize - then go (2 * n) - else do - rethrowR res - len <- peek lenPtr - !sni <- T.peekCStringLen (castPtr bufPtr, cSizeToInt len) - pure $ if T.null sni then Nothing else Just sni - in go 16 +getSNIHostname = handshakeQuery \Connection' {conn} -> do + sniHostname <- alloca \strPtr -> do + FFI.serverConnectionGetSNIHostname (ConstPtr conn) strPtr + strToText =<< peek strPtr + pure if T.null sniHostname then Nothing else Just sniHostname -- | A DER-encoded certificate. newtype DERCertificate = DERCertificate {unDERCertificate :: ByteString} diff --git a/src/Rustls/Internal.hs b/src/Rustls/Internal.hs --- a/src/Rustls/Internal.hs +++ b/src/Rustls/Internal.hs @@ -71,6 +71,48 @@ } deriving stock (Show, Eq, Ord, Generic) +-- | A negotiated key exchange group. +data NegotiatedKeyExchangeGroup = NegotiatedKeyExchangeGroup + { -- | The IANA value of the key exchange group. + negotiatedKeyExchangeGroupID :: Word16, + -- | The text representation of the key exchange group. + negotiatedKeyExchangeGroupName :: Text + } + deriving stock (Show, Eq, Ord, Generic) + +-- | Describes which sort of TLS handshake happened. +newtype HandshakeKind = HandshakeKind Word16 + deriving newtype (Eq, Ord) + +instance Show HandshakeKind where + show (HandshakeKind kind) = unsafePerformIO $ + alloca \strPtr -> do + FFI.handshakeKindStr kind strPtr + T.unpack <$> do strToText =<< peek strPtr + +-- | A full TLS handshake. +-- +-- This is the typical TLS connection initiation process when resumption is not +-- yet unavailable, and the initial client hello was accepted by the server. +pattern HandshakeKindFull :: HandshakeKind +pattern HandshakeKindFull = HandshakeKind 1 + +-- | A full TLS handshake, with an extra round-trip for a hello retry request. +-- +-- The server can respond with a hello retry request (HRR) if the initial client +-- hello is unacceptable for several reasons, the most likely if no supported +-- key shares were offered by the client. +pattern HandshakeKindFullWithHelloRetryRequest :: HandshakeKind +pattern HandshakeKindFullWithHelloRetryRequest = HandshakeKind 2 + +-- | A resumed TLS handshake. +-- +-- Resumed handshakes involve fewer round trips and less cryptography than full +-- ones, but can only happen when the peers have previously done a full +-- handshake together, and then remember data about it. +pattern HandshakeKindResumed :: HandshakeKind +pattern HandshakeKindResumed = HandshakeKind 3 + -- | Rustls client config builder. data ClientConfigBuilder = ClientConfigBuilder { -- | The cryptography provider. @@ -100,7 +142,9 @@ serverCertVerifierCertificates :: NonEmpty PEMCertificates, -- | List of certificate revocation lists used to verify TLS server -- certificates. - serverCertVerifierCRLs :: [CertificateRevocationList] + serverCertVerifierCRLs :: [CertificateRevocationList], + -- | Whether to treat expired certificate revocation lists as an error condition. + serverCertVerifierEnforceCRLExpiry :: Bool } deriving stock (Show, Generic) diff --git a/src/Rustls/Internal/FFI.hs b/src/Rustls/Internal/FFI.hs --- a/src/Rustls/Internal/FFI.hs +++ b/src/Rustls/Internal/FFI.hs @@ -1,4 +1,14 @@ -- | Internal module, not subject to PVP. +-- +-- Functionality without bindings ATM (not exhaustive): +-- +-- - Certain client verifier parts +-- - Session persistence +-- - ECH +-- - SSLKEYLOG +-- - FIPS +-- - Explicit TLS 1.3 key updates +-- - Certified key consistency check module Rustls.Internal.FFI ( ConstPtr (..), ConstCString, @@ -19,6 +29,7 @@ ServerCertVerifier, webPkiServerCertVerifierBuilderNewWithProvider, webPkiServerCertVerifierBuilderAddCrl, + webPkiServerCertVerifierEnforceRevocationExpiry, webPkiServerCertVerifierBuilderFree, webPkiServerCertVerifierBuilderBuild, platformServerCertVerifierWithProvider, @@ -87,6 +98,10 @@ connectionGetProtocolVersion, connectionGetNegotiatedCipherSuite, connectionGetNegotiatedCipherSuiteName, + connectionGetNegotiatedKeyExchangeGroup, + connectionGetNegotiatedKeyExchangeGroupName, + connectionHandshakeKind, + handshakeKindStr, serverConnectionGetSNIHostname, connectionGetPeerCertificate, @@ -266,6 +281,10 @@ webPkiServerCertVerifierBuilderAddCrl :: Ptr WebPkiServerCertVerifierBuilder -> ConstPtr Word8 -> CSize -> IO Result +foreign import capi unsafe "rustls.h rustls_web_pki_server_cert_verifier_enforce_revocation_expiry" + webPkiServerCertVerifierEnforceRevocationExpiry :: + Ptr WebPkiServerCertVerifierBuilder -> IO Result + foreign import capi unsafe "rustls.h rustls_web_pki_server_cert_verifier_builder_free" webPkiServerCertVerifierBuilderFree :: Ptr WebPkiServerCertVerifierBuilder -> IO () @@ -331,8 +350,6 @@ {-# CTYPE "rustls.h" "rustls_client_cert_verifier" #-} ClientCertVerifier --- TODO all features? - foreign import capi unsafe "rustls.h rustls_web_pki_client_cert_verifier_builder_new_with_provider" webPkiClientCertVerifierBuilderNewWithProvider :: ConstPtr CryptoProvider -> @@ -361,8 +378,6 @@ serverConfigBuilderSetClientVerifier :: Ptr ServerConfigBuilder -> ConstPtr ClientCertVerifier -> IO () --- add custom session persistence functions? - -- connection data {-# CTYPE "rustls.h" "rustls_connection" #-} Connection @@ -401,11 +416,23 @@ foreign import capi unsafe "rustls.h rustls_connection_get_negotiated_ciphersuite" connectionGetNegotiatedCipherSuite :: ConstPtr Connection -> IO Word16 -foreign import capi unsafe "rustls.h hs_rustls_connection_get_negotiated_ciphersuite_name" +foreign import capi unsafe "hs_rustls.h hs_rustls_connection_get_negotiated_ciphersuite_name" connectionGetNegotiatedCipherSuiteName :: ConstPtr Connection -> Ptr Str -> IO () -foreign import capi unsafe "rustls.h rustls_server_connection_get_server_name" - serverConnectionGetSNIHostname :: ConstPtr Connection -> Ptr Word8 -> CSize -> Ptr CSize -> IO Result +foreign import capi unsafe "rustls.h rustls_connection_get_negotiated_key_exchange_group" + connectionGetNegotiatedKeyExchangeGroup :: ConstPtr Connection -> IO Word16 + +foreign import capi unsafe "hs_rustls.h hs_rustls_connection_get_negotiated_key_exchange_group_name" + connectionGetNegotiatedKeyExchangeGroupName :: ConstPtr Connection -> Ptr Str -> IO () + +foreign import capi unsafe "hs_rustls.h hs_rustls_connection_handshake_kind" + connectionHandshakeKind :: ConstPtr Connection -> IO Word16 + +foreign import capi unsafe "hs_rustls.h hs_rustls_handshake_kind_str" + handshakeKindStr :: Word16 -> Ptr Str -> IO () + +foreign import capi unsafe "hs_rustls.h hs_rustls_server_connection_get_server_name" + serverConnectionGetSNIHostname :: ConstPtr Connection -> Ptr Str -> IO () foreign import capi unsafe "rustls.h rustls_connection_get_peer_certificate" connectionGetPeerCertificate :: ConstPtr Connection -> CSize -> IO (ConstPtr Certificate) diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -77,6 +77,11 @@ case res of Right TestOutcome {..} -> do label "Success" + + -- TODO test more kinds + clientHandshakeKind === Rustls.HandshakeKindFull + serverHandshakeKind === Rustls.HandshakeKindFull + clientSends === serverReceived clientSends === clientReceived if clientConfigEnableSNI @@ -92,6 +97,7 @@ `Set.intersection` Set.fromList serverConfigALPNProtocols ) clientCipherSuite === serverCipherSuite + clientKeyExchangeGroup === serverKeyExchangeGroup assert $ clientCipherSuite `Set.member` (clientCipherSuites `Set.intersection` serverCipherSuites) @@ -158,6 +164,7 @@ Rustls.PemCertificatesFromFile miniCAFile parsing ] let serverCertVerifierCRLs = [] -- TODO test this + serverCertVerifierEnforceCRLExpiry <- Gen.bool pure Rustls.ServerCertVerifier {..} ] clientConfigALPNProtocols <- (commonALPNProtocols <>) <$> genALPNProtocols @@ -209,11 +216,13 @@ allCipherSuites = Rustls.cryptoProviderCipherSuites cryptoProvider data TestOutcome = TestOutcome - { negotiatedClientALPNProtocol, + { clientHandshakeKind, serverHandshakeKind :: Rustls.HandshakeKind, + negotiatedClientALPNProtocol, negotiatedServerALPNProtocol :: Maybe Rustls.ALPNProtocol, clientTLSVersion, serverTLSVersion :: Rustls.TLSVersion, clientCipherSuite, serverCipherSuite :: Rustls.NegotiatedCipherSuite, + clientKeyExchangeGroup, serverKeyExchangeGroup :: Rustls.NegotiatedKeyExchangeGroup, sniHostname :: Maybe Text, clientPeerCert, serverPeerCert :: Maybe Rustls.DERCertificate, clientReceived, serverReceived :: [ByteString] @@ -234,12 +243,14 @@ <$> Rustls.buildServerConfig serverConfigBuilder Rustls.newServerConnection backend rustlsConfig \conn -> do - (alpnProtocol, tlsVersion, cipherSuite, sniHostname, peerCert) <- + (handshakeKind, alpnProtocol, tlsVersion, cipherSuite, keyExGroup, sniHostname, peerCert) <- Rustls.handshake conn $ - (,,,,) - <$> Rustls.getALPNProtocol + (,,,,,,) + <$> Rustls.getHandshakeKind + <*> Rustls.getALPNProtocol <*> Rustls.getTLSVersion <*> Rustls.getNegotiatedCipherSuite + <*> Rustls.getNegotiatedKeyExchangeGroup <*> Rustls.getSNIHostname <*> Rustls.getPeerCertificate 0 received <- @@ -250,7 +261,7 @@ Rustls.writeBS conn bs go in recordOutput go - pure (alpnProtocol, tlsVersion, cipherSuite, sniHostname, peerCert, received) + pure (handshakeKind, alpnProtocol, tlsVersion, cipherSuite, keyExGroup, sniHostname, peerCert, received) runClient backend = withAcquire do @@ -260,33 +271,39 @@ <$> Rustls.buildClientConfig clientConfigBuilder Rustls.newClientConnection backend rustlsConfig testHostname \conn -> do - (alpnProtocol, tlsVersion, cipherSuite, peerCert) <- + (handshakeKind, alpnProtocol, tlsVersion, cipherSuite, keyExGroup, peerCert) <- Rustls.handshake conn $ - (,,,) - <$> Rustls.getALPNProtocol + (,,,,,) + <$> Rustls.getHandshakeKind + <*> Rustls.getALPNProtocol <*> Rustls.getTLSVersion <*> Rustls.getNegotiatedCipherSuite + <*> Rustls.getNegotiatedKeyExchangeGroup <*> Rustls.getPeerCertificate 0 received <- recordOutput . for_ clientSends $ \bs -> do Rustls.writeBS conn bs bs <- Rustls.readBS conn testMessageLen modify' (bs :) Rustls.writeBS conn "close" - pure (alpnProtocol, tlsVersion, cipherSuite, peerCert, received) + pure (handshakeKind, alpnProtocol, tlsVersion, cipherSuite, keyExGroup, peerCert, received) (backend0, backend1) <- mkConnectedBackends res <- liftIO . runExceptT $ do - ( ( negotiatedServerALPNProtocol, + ( ( serverHandshakeKind, + negotiatedServerALPNProtocol, serverTLSVersion, serverCipherSuite, + serverKeyExchangeGroup, sniHostname, serverPeerCert, serverReceived ), - ( negotiatedClientALPNProtocol, + ( clientHandshakeKind, + negotiatedClientALPNProtocol, clientTLSVersion, clientCipherSuite, + clientKeyExchangeGroup, clientPeerCert, clientReceived )