Merge branch 'warnings'

kazu-yamamoto · Dec 1, 2023 · 19c72a3 · 19c72a3
2 parents f2cfc60 + 8d18e40
commit 19c72a3
Show file tree

Hide file tree

Showing 20 changed files with 108 additions and 120 deletions.
diff --git a/core/Network/TLS/Context.hs b/core/Network/TLS/Context.hs
@@ -13,8 +13,6 @@ module Network.TLS.Context (
     Hooks (..),
     Established (..),
     ctxEOF,
-    ctxHasSSLv2ClientHello,
-    ctxDisableSSLv2ClientHello,
     ctxEstablished,
     withLog,
     ctxWithHooks,
@@ -150,9 +148,6 @@ contextNew backend params = liftIO $ do
     eof <- newIORef False
     established <- newIORef NotEstablished
     stats <- newIORef newMeasurement
-    -- we enable the reception of SSLv2 ClientHello message only in the
-    -- server context, where we might be dealing with an old/compat client.
-    sslv2Compat <- newIORef (role == ServerRole)
     needEmptyPacket <- newIORef False
     hooks <- newIORef defaultHooks
     tx <- newMVar newRecordState
@@ -183,7 +178,6 @@ contextNew backend params = liftIO $ do
                 , ctxMeasurement = stats
                 , ctxEOF_ = eof
                 , ctxEstablished_ = established
-                , ctxSSLv2ClientHello = sslv2Compat
                 , ctxNeedEmptyPacket = needEmptyPacket
                 , ctxHooks = hooks
                 , ctxLockWrite = lockWrite

diff --git a/core/Network/TLS/Context/Internal.hs b/core/Network/TLS/Context/Internal.hs
@@ -24,8 +24,6 @@ module Network.TLS.Context.Internal (
     Established (..),
     PendingAction (..),
     ctxEOF,
-    ctxHasSSLv2ClientHello,
-    ctxDisableSSLv2ClientHello,
     ctxEstablished,
     withLog,
     ctxWithHooks,
@@ -125,10 +123,6 @@ data Context = forall bytes.
     -- ^ has the handshake been done and been successful.
     , ctxNeedEmptyPacket :: IORef Bool
     -- ^ empty packet workaround for CBC guessability.
-    , ctxSSLv2ClientHello :: IORef Bool
-    -- ^ enable the reception of compatibility SSLv2 client hello.
-    -- the flag will be set to false regardless of its initial value
-    -- after the first packet received.
     , ctxFragmentSize :: Maybe Int
     -- ^ maximum size of plaintext fragments
     , ctxTxState :: MVar RecordState
@@ -232,12 +226,6 @@ contextRecv c sz = updateMeasure c (addBytesReceived sz) >> (backendRecv $ ctxCo
 ctxEOF :: Context -> IO Bool
 ctxEOF ctx = readIORef $ ctxEOF_ ctx
 
-ctxHasSSLv2ClientHello :: Context -> IO Bool
-ctxHasSSLv2ClientHello ctx = readIORef $ ctxSSLv2ClientHello ctx
-
-ctxDisableSSLv2ClientHello :: Context -> IO ()
-ctxDisableSSLv2ClientHello ctx = writeIORef (ctxSSLv2ClientHello ctx) False
-
 setEOF :: Context -> IO ()
 setEOF ctx = writeIORef (ctxEOF_ ctx) True
 
@@ -361,7 +349,10 @@ getCertRequest13 :: Context -> CertReqContext -> IO (Maybe Handshake13)
 getCertRequest13 ctx context = do
     let ref = ctxCertRequests ctx
     l <- readIORef ref
-    let (matched, others) = partition (\(CertRequest13 c _) -> context == c) l
+    let (matched, others) = partition (\cr -> context == fromCertRequest13 cr) l
     case matched of
         [] -> return Nothing
         (certReq : _) -> writeIORef ref others >> return (Just certReq)
+  where
+    fromCertRequest13 (CertRequest13 c _) = c
+    fromCertRequest13 _ = error "fromCertRequest13"
diff --git a/core/Network/TLS/Crypto.hs b/core/Network/TLS/Crypto.hs
@@ -58,6 +58,7 @@ import qualified Crypto.PubKey.RSA.PSS as PSS
 import Crypto.Random
 import qualified Data.ByteArray as B (convert)
 import qualified Data.ByteString as B
+import Data.Maybe (fromJust)
 
 import Data.X509 (
     PrivKey (..),
@@ -115,7 +116,7 @@ findFiniteFieldGroup params = lookup (pg params) table
     pg (DH.Params p g _) = (p, g)
 
     table =
-        [ (pg prms, grp) | grp <- availableFFGroups, let Just prms = dhParamsForGroup grp
+        [ (pg prms, grp) | grp <- availableFFGroups, let prms = fromJust $ dhParamsForGroup grp
         ]
 
 findEllipticCurveGroup :: PubKeyEC -> Maybe Group

diff --git a/core/Network/TLS/Handshake/Client.hs b/core/Network/TLS/Handshake/Client.hs
@@ -13,30 +13,19 @@ module Network.TLS.Handshake.Client (
     postHandshakeAuthClientWith,
 ) where
 
+import Control.Exception (SomeException, bracket)
+import Control.Monad.State.Strict
 import qualified Data.ByteString as B
+import Data.Maybe (fromJust)
 import Data.X509 (ExtKeyUsageFlag (..))
+
 import Network.TLS.Cipher
 import Network.TLS.Compression
 import Network.TLS.Context.Internal
 import Network.TLS.Credentials
 import Network.TLS.Crypto
 import Network.TLS.ErrT
 import Network.TLS.Extension
-import Network.TLS.IO
-import Network.TLS.Imports
-import Network.TLS.Measurement
-import Network.TLS.Packet hiding (getExtensions)
-import Network.TLS.Parameters
-import Network.TLS.State
-import Network.TLS.Struct
-import Network.TLS.Struct13
-import Network.TLS.Types
-import Network.TLS.Util (bytesEq, catchException, fromJust, mapChunks_)
-import Network.TLS.X509
-
-import Control.Exception (SomeException, bracket)
-import Control.Monad.State.Strict
-
 import Network.TLS.Handshake.Certificate
 import Network.TLS.Handshake.Common
 import Network.TLS.Handshake.Common13
@@ -47,7 +36,18 @@ import Network.TLS.Handshake.Random
 import Network.TLS.Handshake.Signature
 import Network.TLS.Handshake.State
 import Network.TLS.Handshake.State13
+import Network.TLS.IO
+import Network.TLS.Imports
+import Network.TLS.Measurement
+import Network.TLS.Packet hiding (getExtensions)
+import Network.TLS.Parameters
+import Network.TLS.State
+import Network.TLS.Struct
+import Network.TLS.Struct13
+import Network.TLS.Types
+import Network.TLS.Util (bytesEq, catchException, mapChunks_)
 import Network.TLS.Wire
+import Network.TLS.X509
 
 handshakeClientWith :: ClientParams -> Context -> Handshake -> IO ()
 handshakeClientWith cparams ctx HelloRequest = handshakeClient cparams ctx
@@ -252,7 +252,7 @@ handshakeClient' cparams ctx groups mparams = do
         case sessionAndCipherToResume13 of
             Nothing -> return Nothing
             Just (sid, sdata, sCipher) -> do
-                let tinfo = fromJust "sessionTicketInfo" $ sessionTicketInfo sdata
+                let tinfo = fromJust $ sessionTicketInfo sdata
                 age <- getAge tinfo
                 return $
                     if isAgeValid age tinfo

diff --git a/core/Network/TLS/Handshake/Common.hs b/core/Network/TLS/Handshake/Common.hs
@@ -29,7 +29,11 @@ module Network.TLS.Handshake.Common (
 ) where
 
 import Control.Concurrent.MVar
+import Control.Exception (IOException, fromException, handle, throwIO)
+import Control.Monad.State.Strict
 import qualified Data.ByteString as B
+import Data.IORef (writeIORef)
+import Data.Maybe (fromJust)
 
 import Network.TLS.Cipher
 import Network.TLS.Compression
@@ -52,10 +56,6 @@ import Network.TLS.Types
 import Network.TLS.Util
 import Network.TLS.X509
 
-import Control.Exception (IOException, fromException, handle, throwIO)
-import Control.Monad.State.Strict
-import Data.IORef (writeIORef)
-
 handshakeFailed :: TLSError -> IO ()
 handshakeFailed err = throwIO $ HandshakeFailed err
 
@@ -119,7 +119,7 @@ handshakeTerminate ctx = do
                 sessionEstablish
                     (sharedSessionManager $ ctxShared ctx)
                     sessionId'
-                    (fromJust "session-data" sessionData)
+                    (fromJust sessionData)
         _ -> return ()
     -- forget most handshake data and reset bytes counters.
     liftIO $ modifyMVar_ (ctxHandshake ctx) $ \mhshake ->
@@ -233,7 +233,7 @@ getSessionData ctx = do
     !ems <- usingHState ctx getExtendedMasterSec
     tx <- liftIO $ readMVar (ctxTxState ctx)
     alpn <- usingState_ ctx getNegotiatedProtocol
-    let !cipher = cipherID $ fromJust "cipher" $ stCipher tx
+    let !cipher = cipherID $ fromJust $ stCipher tx
         !compression = compressionID $ stCompression tx
         flags = [SessionEMS | ems]
     case mms of
@@ -271,13 +271,16 @@ storePrivInfo
     -> PrivKey
     -> m PubKey
 storePrivInfo ctx cc privkey = do
-    let CertificateChain (c : _) = cc
+    let c = fromCC cc
         pubkey = certPubKey $ getCertificate c
     unless (isDigitalSignaturePair (pubkey, privkey)) $
         throwCore $
             Error_Protocol "mismatched or unsupported private key pair" InternalError
     usingHState ctx $ setPublicPrivateKeys (pubkey, privkey)
     return pubkey
+  where
+    fromCC (CertificateChain (c : _)) = c
+    fromCC _ = error "fromCC"
 
 -- verify that the group selected by the peer is supported in the local
 -- configuration

diff --git a/core/Network/TLS/Handshake/Common13.hs b/core/Network/TLS/Handshake/Common13.hs
@@ -48,6 +48,7 @@ module Network.TLS.Handshake.Common13 (
 
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as B
+import Data.Maybe (fromJust)
 import Data.UnixTime
 import Foreign.C.Types (CTime (..))
 import Network.TLS.Cipher
@@ -337,7 +338,7 @@ checkFreshness tinfo obfAge = do
     return $ isAlive && isFresh
   where
     serverSendTime = txrxTime tinfo
-    Just rtt = estimatedRTT tinfo
+    rtt = fromJust $ estimatedRTT tinfo
     age = obfuscatedAgeToAge obfAge tinfo
     expectedArrivalTime = serverSendTime + rtt + fromIntegral age
     isAlive = isAgeValid age tinfo

diff --git a/core/Network/TLS/Handshake/Server.hs b/core/Network/TLS/Handshake/Server.hs
@@ -13,19 +13,28 @@ module Network.TLS.Handshake.Server (
     postHandshakeAuthServerWith,
 ) where
 
+import Control.Exception (bracket)
+import Control.Monad.State.Strict
 import qualified Data.ByteString as B
+import Data.Maybe (fromJust)
 import Data.X509 (ExtKeyUsageFlag (..))
+
 import Network.TLS.Cipher
 import Network.TLS.Compression
 import Network.TLS.Context.Internal
 import Network.TLS.Credentials
 import Network.TLS.Crypto
 import Network.TLS.Extension
+import Network.TLS.Handshake.Certificate
+import Network.TLS.Handshake.Common
+import Network.TLS.Handshake.Common13
 import Network.TLS.Handshake.Control
 import Network.TLS.Handshake.Key
 import Network.TLS.Handshake.Process
 import Network.TLS.Handshake.Random
+import Network.TLS.Handshake.Signature
 import Network.TLS.Handshake.State
+import Network.TLS.Handshake.State13
 import Network.TLS.IO
 import Network.TLS.Imports
 import Network.TLS.Measurement
@@ -35,16 +44,7 @@ import Network.TLS.State
 import Network.TLS.Struct
 import Network.TLS.Struct13
 import Network.TLS.Types
-import Network.TLS.Util (bytesEq, catchException, fromJust)
-
-import Control.Exception (bracket)
-import Control.Monad.State.Strict
-
-import Network.TLS.Handshake.Certificate
-import Network.TLS.Handshake.Common
-import Network.TLS.Handshake.Common13
-import Network.TLS.Handshake.Signature
-import Network.TLS.Handshake.State13
+import Network.TLS.Util (bytesEq, catchException)
 import Network.TLS.X509
 
 -- Put the server context in handshake mode.
@@ -513,7 +513,7 @@ doHandshake sparams mcred ctx chosenVersion usedCipher usedCompression clientSes
         (dhparams, priv, pub) <-
             case possibleFFGroups of
                 [] ->
-                    let dhparams = fromJust "server DHE Params" $ serverDHEParams sparams
+                    let dhparams = fromJust $ serverDHEParams sparams
                      in case findFiniteFieldGroup dhparams of
                             Just g -> do
                                 usingHState ctx $ setNegotiatedGroup g
@@ -1005,7 +1005,7 @@ doHandshake13 sparams ctx chosenVersion usedCipher exts usedHash clientKeyShare
                             else sessionResume mgr sessionId
                     case msdata of
                         Just sdata -> do
-                            let Just tinfo = sessionTicketInfo sdata
+                            let tinfo = fromJust $ sessionTicketInfo sdata
                                 psk = sessionSecret sdata
                             isFresh <- checkFreshness tinfo obfAge
                             (isPSKvalid, is0RTTvalid) <- checkSessionEquality sdata
@@ -1385,7 +1385,7 @@ postHandshakeAuthServerWith sparams ctx h@(Certificate13 certCtx certs _ext) = d
     when (isNothing mCertReq) $
         throwCore $
             Error_Protocol "unknown certificate request context" DecodeError
-    let certReq = fromJust "certReq" mCertReq
+    let certReq = fromJust mCertReq
 
     -- fixme checking _ext
     clientCertificate sparams ctx certs

diff --git a/core/Network/TLS/Handshake/Signature.hs b/core/Network/TLS/Handshake/Signature.hs
@@ -22,6 +22,9 @@ module Network.TLS.Handshake.Signature (
     decryptError,
 ) where
 
+import Control.Monad.State.Strict
+import Data.Maybe (fromJust)
+
 import Network.TLS.Context.Internal
 import Network.TLS.Crypto
 import Network.TLS.Handshake.Key
@@ -36,11 +39,8 @@ import Network.TLS.Packet (
 import Network.TLS.Parameters
 import Network.TLS.State
 import Network.TLS.Struct
-import Network.TLS.Util
 import Network.TLS.X509
 
-import Control.Monad.State.Strict
-
 decryptError :: MonadIO m => String -> m a
 decryptError msg = throwCore $ Error_Protocol msg DecryptError
 
@@ -330,7 +330,7 @@ withClientAndServerRandom ctx f = do
         usingHState ctx $
             (,)
                 <$> gets hstClientRandom
-                <*> (fromJust "withClientAndServer : server random" <$> gets hstServerRandom)
+                <*> (fromJust <$> gets hstServerRandom)
     return $ f cran sran
 
 -- verify that the hash and signature selected by the peer is supported in