rustls 0.2.1.0 → 0.2.2.0

raw patch · 8 files changed

+193/−51 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• README.md +5/−11
• cbits/hs_rustls.h +27/−0
• rustls.cabal +2/−2
• src/Rustls.hs +46/−19
• src/Rustls/Internal.hs +45/−1
• src/Rustls/Internal/FFI.hs +34/−7
• test/Main.hs +28/−11

@@ -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).

@@ -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

@@ -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

@@ -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 

@@ -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}

@@ -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) 

@@ -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)

@@ -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         )