f828294 · typeable/wai

git.iko.soy/typeable/wai

implementing clientCertificate.

commitf8282948d891fbf6a9e6dc22ca1339b4a5275817 authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 27 Nov 2019, 22:23 (7 years ago) parent21fc6b0

7 files changed+28−6

compare with master

unifiedsplit

warp-tls/Network/Wai/Handler/WarpTLS.hs+2 warp-tls/warp-tls.cabal+3−3 warp/Network/Wai/Handler/Warp.hs+9−1 warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+2−1 warp/Network/Wai/Handler/Warp/Request.hs+7 warp/Network/Wai/Handler/Warp/Types.hs+2 warp/warp.cabal+3−1

warp-tls/Network/Wai/Handler/WarpTLS.hs+2

@@ -468,11 +468,13 @@ getTLSinfo ctx = do

468468#if MIN_VERSION_tls(1,5,0)

469469 TLS.TLS13 -> (3,4)

470470#endif

471+ clientCert <- TLS.getClientCertificateChain ctx

471472 return TLS {

472473 tlsMajorVersion = major

473474 , tlsMinorVersion = minor

474475 , tlsNegotiatedProtocol = proto

475476 , tlsChiperID = TLS.cipherID infoCipher

477+ , tlsClientCertificate = clientCert

476478 }

477479

478480tryIO :: IO a -> IO (Either IOException a)

warp-tls/warp-tls.cabal+3−3

@@ -1,5 +1,5 @@

11Name: warp-tls

2−Version: 3.2.9

2+Version: 3.2.10

33Synopsis: HTTP over TLS support for Warp via the TLS package

44License: MIT

55License-file: LICENSE

@@ -21,9 +21,9 @@ Library

2121 Build-Depends: base >= 4.8 && < 5

2222 , bytestring >= 0.9

2323 , wai >= 3.2 && < 3.3

24− , warp >= 3.3.5 && < 3.4

24+ , warp >= 3.3.6 && < 3.4

2525 , data-default-class >= 0.0.1

26− , tls >= 1.3.10

26+ , tls >= 1.5.3

2727 , cryptonite >= 0.12

2828 , network >= 2.2.1

2929 , streaming-commons

warp/Network/Wai/Handler/Warp.hs+9−1

@@ -97,6 +97,7 @@ module Network.Wai.Handler.Warp (

9797 , pauseTimeout

9898 , FileInfo(..)

9999 , getFileInfo

100+ , clientCertificate

100101 , withApplication

101102 , withApplicationSettings

102103 , testWithApplication

@@ -122,9 +123,10 @@ module Network.Wai.Handler.Warp (

122123 , defaultPushPromise

123124 ) where

124125

125−import Control.Exception (SomeException, throwIO)

126+import Control.Exception (SomeException, throwIO, throw)

126127import Data.Streaming.Network (HostPreference)

127128import qualified Data.Vault.Lazy as Vault

129+import Data.X509

128130import qualified Network.HTTP.Types as H

129131import Network.Socket (SockAddr)

130132import Network.Wai (Request, Response, vault)

@@ -491,3 +493,9 @@ setGracefulCloseTimeout2 x y = y { settingsGracefulCloseTimeout2 = x }

491493-- Since 3.3.5

492494getGracefulCloseTimeout2 :: Settings -> Int

493495getGracefulCloseTimeout2 = settingsGracefulCloseTimeout2

496+

497+-- | Getting information of client certificate.

498+--

499+-- Since 3.3.5

500+clientCertificate :: Request -> Maybe CertificateChain

501+clientCertificate = join . Vault.lookup getClientCertificateKey . vault

warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+2−1

@@ -22,7 +22,7 @@ import qualified System.TimeManager as T

2222

2323import Network.Wai.Handler.Warp.HTTP2.Types

2424import Network.Wai.Handler.Warp.Imports

25−import Network.Wai.Handler.Warp.Request (getFileInfoKey, pauseTimeoutKey)

25+import Network.Wai.Handler.Warp.Request (getFileInfoKey, pauseTimeoutKey, getClientCertificateKey)

2626import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath)

2727import Network.Wai.Handler.Warp.Types

2828

@@ -83,6 +83,7 @@ toRequest' ii settings addr ref (reqths,reqvt) bodylen body th transport = retur

8383 $ Vault.insert setHTTP2DataKey (writeIORef ref)

8484 $ Vault.insert modifyHTTP2DataKey (modifyIORef' ref)

8585 $ Vault.insert pauseTimeoutKey (T.pause th)

86+ $ Vault.insert getClientCertificateKey (tlsClientCertificate transport)

8687 Vault.empty

8788

8889getHTTP2DataKey :: Vault.Key (IO (Maybe HTTP2Data))

warp/Network/Wai/Handler/Warp/Request.hs+7

@@ -9,6 +9,7 @@ module Network.Wai.Handler.Warp.Request (

99 , headerLines

1010 , pauseTimeoutKey

1111 , getFileInfoKey

12+ , getClientCertificateKey

1213 , NoKeepAliveRequest (..)

1314 ) where

1415

@@ -21,6 +22,7 @@ import qualified Data.CaseInsensitive as CI

2122import qualified Data.IORef as I

2223import Data.Typeable (Typeable)

2324import qualified Data.Vault.Lazy as Vault

25+import Data.X509

2426import qualified Network.HTTP.Types as H

2527import Network.Socket (SockAddr)

2628import Network.Wai

@@ -76,6 +78,7 @@ recvRequest firstRequest settings conn ii th addr src transport = do

7678 rawPath = if settingsNoParsePath settings then unparsedPath else path

7779 vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)

7880 $ Vault.insert getFileInfoKey (getFileInfo ii)

81+ $ Vault.insert getClientCertificateKey (tlsClientCertificate transport)

7982 Vault.empty

8083 (rbody, remainingRef, bodyLength) <- bodyAndSource src cl te

8184 -- body producing function which will produce '100-continue', if needed

@@ -300,3 +303,7 @@ pauseTimeoutKey = unsafePerformIO Vault.newKey

300303getFileInfoKey :: Vault.Key (FilePath -> IO FileInfo)

301304getFileInfoKey = unsafePerformIO Vault.newKey

302305{-# NOINLINE getFileInfoKey #-}

306+

307+getClientCertificateKey :: Vault.Key (Maybe CertificateChain)

308+getClientCertificateKey = unsafePerformIO Vault.newKey

309+{-# NOINLINE getClientCertificateKey #-}

warp/Network/Wai/Handler/Warp/Types.hs+2

@@ -8,6 +8,7 @@ import Control.Exception

88import qualified Data.ByteString as S

99import Data.IORef (IORef, readIORef, writeIORef, newIORef)

1010import Data.Typeable (Typeable)

11+import Data.X509

1112import Foreign.Ptr (Ptr)

1213import System.Posix.Types (Fd)

1314import qualified System.TimeManager as T

@@ -179,6 +180,7 @@ data Transport = TCP -- ^ Plain channel: TCP

179180 , tlsMinorVersion :: Int

180181 , tlsNegotiatedProtocol :: Maybe ByteString -- ^ The result of Application Layer Protocol Negociation in RFC 7301

181182 , tlsChiperID :: Word16

183+ , tlsClientCertificate :: Maybe CertificateChain

182184 } -- ^ Encrypted channel: TLS or SSL

183185

184186isTransportSecure :: Transport -> Bool

warp/warp.cabal+3−1

@@ -1,5 +1,5 @@

11Name: warp

2−Version: 3.3.5

2+Version: 3.3.6

33Synopsis: A fast, light-weight web server for WAI applications.

44License: MIT

55License-file: LICENSE

@@ -56,6 +56,7 @@ Library

5656 , vault >= 0.3

5757 , wai >= 3.2 && < 3.3

5858 , word8

59+ , x509

5960 if impl(ghc < 8)

6061 Build-Depends: semigroups

6162 if flag(network-bytestring)

@@ -211,6 +212,7 @@ Test-Suite spec

211212 , vault

212213 , wai >= 3.2 && < 3.3

213214 , word8

215+ , x509

214216 -- Build-Tool-Depends: hspec-discover:hspec-discover

215217 if impl(ghc < 8)

216218 Build-Depends: semigroups