hlint suggestion

core/Network/TLS/Context/Internal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -340,10 +341,9 @@ usingState_ :: Context -> TLSSt a -> IO a
 usingState_ ctx f = failOnEitherError $ usingState ctx f
 
 usingHState :: MonadIO m => Context -> HandshakeM a -> m a
-usingHState ctx f = liftIO $ modifyMVar (ctxHandshake ctx) $ \mst ->
-    case mst of
-        Nothing -> liftIO $ throwIO MissingHandshake
-        Just st -> return $ swap (Just <$> runHandshake st f)
+usingHState ctx f = liftIO $ modifyMVar (ctxHandshake ctx) $ \case
+    Nothing -> liftIO $ throwIO MissingHandshake
+    Just st -> return $ swap (Just <$> runHandshake st f)
 
 getHState :: MonadIO m => Context -> m (Maybe HandshakeState)
 getHState ctx = liftIO $ readMVar (ctxHandshake ctx)

core/Network/TLS/Core.hs

@@ -160,7 +160,7 @@ sendData ctx dataToSend = liftIO $ do
     let sendP bs
             | tls13 = do
                 sendPacket13 ctx $ AppData13 bs
-                when (not sentCF) $
+                unless sentCF $
                     modifyTLS13State ctx $
                         \st -> st{tls13stPendingSentData = tls13stPendingSentData st . (bs :)}
             | otherwise = sendPacket ctx $ AppData bs

core/Network/TLS/Handshake/Client/TLS13.hs

@@ -138,16 +138,15 @@ expectEncryptedExtensions ctx (EncryptedExtensions13 eexts) = do
         setALPN ctx MsgTEncryptedExtensions eexts
         modifyTLS13State ctx $ \st -> st{tls13stClientExtensions = eexts}
     st13 <- usingHState ctx getTLS13RTT0Status
-    if st13 == RTT0Sent
-        then case extensionLookup EID_EarlyData eexts of
+    when (st13 == RTT0Sent) $
+        case extensionLookup EID_EarlyData eexts of
             Just _ -> do
                 usingHState ctx $ setTLS13HandshakeMode RTT0
                 usingHState ctx $ setTLS13RTT0Status RTT0Accepted
                 liftIO $ modifyTLS13State ctx $ \st -> st{tls13st0RTTAccepted = True}
             Nothing -> do
                 usingHState ctx $ setTLS13HandshakeMode PreSharedKey
                 usingHState ctx $ setTLS13RTT0Status RTT0Rejected
-        else return ()
 expectEncryptedExtensions _ p = unexpected (show p) (Just "encrypted extensions")
 
 ----------------------------------------------------------------
@@ -282,7 +281,7 @@ sendClientSecondFlight13' cparams ctx choice hkey rtt0accepted eexts = do
     handshakeDone13 ctx
     builder <- tls13stPendingSentData <$> getTLS13State ctx
     modifyTLS13State ctx $ \st -> st{tls13stPendingSentData = id}
-    when (not rtt0accepted) $
+    unless rtt0accepted $
         mapM_ (sendPacket13 ctx . AppData13) $
             builder []
   where

core/Network/TLS/Handshake/Common.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Network.TLS.Handshake.Common (
@@ -112,18 +113,17 @@ newSession ctx
 handshakeDone12 :: Context -> IO ()
 handshakeDone12 ctx = do
     -- forget most handshake data and reset bytes counters.
-    modifyMVar_ (ctxHandshake ctx) $ \mhshake ->
-        case mhshake of
-            Nothing -> return Nothing
-            Just hshake ->
-                return $
-                    Just
-                        (newEmptyHandshake (hstClientVersion hshake) (hstClientRandom hshake))
-                            { hstServerRandom = hstServerRandom hshake
-                            , hstMasterSecret = hstMasterSecret hshake
-                            , hstExtendedMasterSec = hstExtendedMasterSec hshake
-                            , hstSupportedGroup = hstSupportedGroup hshake
-                            }
+    modifyMVar_ (ctxHandshake ctx) $ \case
+        Nothing -> return Nothing
+        Just hshake ->
+            return $
+                Just
+                    (newEmptyHandshake (hstClientVersion hshake) (hstClientRandom hshake))
+                        { hstServerRandom = hstServerRandom hshake
+                        , hstMasterSecret = hstMasterSecret hshake
+                        , hstExtendedMasterSec = hstExtendedMasterSec hshake
+                        , hstSupportedGroup = hstSupportedGroup hshake
+                        }
     updateMeasure ctx resetBytesCounters
     -- mark the secure connection up and running.
     setEstablished ctx Established

core/Network/TLS/Handshake/Common13.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Network.TLS.Handshake.Common13 (
@@ -242,21 +243,20 @@ sendChangeCipherSpec13 ctx = do
 handshakeDone13 :: Context -> IO ()
 handshakeDone13 ctx = do
     -- forget most handshake data
-    modifyMVar_ (ctxHandshake ctx) $ \mhshake ->
-        case mhshake of
-            Nothing -> return Nothing
-            Just hshake ->
-                return $
-                    Just
-                        (newEmptyHandshake (hstClientVersion hshake) (hstClientRandom hshake))
-                            { hstServerRandom = hstServerRandom hshake
-                            , hstMasterSecret = hstMasterSecret hshake
-                            , hstSupportedGroup = hstSupportedGroup hshake
-                            , hstHandshakeDigest = hstHandshakeDigest hshake
-                            , hstTLS13HandshakeMode = hstTLS13HandshakeMode hshake
-                            , hstTLS13RTT0Status = hstTLS13RTT0Status hshake
-                            , hstTLS13ResumptionSecret = hstTLS13ResumptionSecret hshake
-                            }
+    modifyMVar_ (ctxHandshake ctx) $ \case
+        Nothing -> return Nothing
+        Just hshake ->
+            return $
+                Just
+                    (newEmptyHandshake (hstClientVersion hshake) (hstClientRandom hshake))
+                        { hstServerRandom = hstServerRandom hshake
+                        , hstMasterSecret = hstMasterSecret hshake
+                        , hstSupportedGroup = hstSupportedGroup hshake
+                        , hstHandshakeDigest = hstHandshakeDigest hshake
+                        , hstTLS13HandshakeMode = hstTLS13HandshakeMode hshake
+                        , hstTLS13RTT0Status = hstTLS13RTT0Status hshake
+                        , hstTLS13ResumptionSecret = hstTLS13ResumptionSecret hshake
+                        }
     -- forget handshake data stored in TLS state
     usingState_ ctx $ do
         setTLS13KeyShare Nothing
@@ -482,9 +482,7 @@ initEarlySecret choice mpsk = BaseSecret sec
     sec = hkdfExtract usedHash zero zeroOrPSK
     usedHash = cHash choice
     zero = cZero choice
-    zeroOrPSK = case mpsk of
-        Just psk -> psk
-        Nothing -> zero
+    zeroOrPSK = fromMaybe zero mpsk
 
 calculateHandshakeSecret
     :: Context

core/Network/TLS/Handshake/Process.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-
 -- |
 -- process handshake message received
 module Network.TLS.Handshake.Process (

core/Network/TLS/Handshake/Server/ServerHello12.hs

@@ -130,21 +130,19 @@ sendServerFirstFlight sparams ctx usedCipher mcred chExts = do
     --
     -- Client certificates MUST NOT be accepted if not requested.
     --
-    b3 <-
-        if serverWantClientCert sparams
-            then do
-                let (certTypes, hashSigs) =
-                        let as = supportedHashSignatures $ ctxSupported ctx
-                         in (nub $ mapMaybe hashSigToCertType as, as)
-                    creq =
-                        CertRequest
-                            certTypes
-                            hashSigs
-                            (map extractCAname $ serverCACertificates sparams)
-                usingHState ctx $ setCertReqSent True
-                return $ b2 . (creq :)
-            else return b2
-    return b3
+    if serverWantClientCert sparams
+        then do
+            let (certTypes, hashSigs) =
+                    let as = supportedHashSignatures $ ctxSupported ctx
+                     in (nub $ mapMaybe hashSigToCertType as, as)
+                creq =
+                    CertRequest
+                        certTypes
+                        hashSigs
+                        (map extractCAname $ serverCACertificates sparams)
+            usingHState ctx $ setCertReqSent True
+            return $ b2 . (creq :)
+        else return b2
   where
     setup_DHE = do
         let possibleFFGroups = negotiatedGroupsInCommon ctx chExts `intersect` availableFFGroups

core/Network/TLS/Record/Reading.hs

@@ -65,9 +65,8 @@ recvRecord
     -> Int
     -- ^ number of AppData bytes to accept above normal maximum size
     -> IO (Either TLSError (Record Plaintext))
-recvRecord ctx appDataOverhead
-    | otherwise =
-        readExactBytes ctx 5 >>= either (return . Left) (recvLengthE . decodeHeader)
+recvRecord ctx appDataOverhead =
+    readExactBytes ctx 5 >>= either (return . Left) (recvLengthE . decodeHeader)
   where
     recvLengthE = either (return . Left) recvLength
 

core/test/Session.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Session (

debug/src/CheckCiphers.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-
 import Control.Concurrent
 import Control.Exception (SomeException (..))
 import qualified Control.Exception as E
@@ -92,8 +90,8 @@ clienthello ciphers =
 openConnection :: String -> String -> [Word16] -> IO (Maybe Word16)
 openConnection s p ciphers = do
     pn <-
-        if and $ map isDigit $ p
-            then return $ fromIntegral $ (read p :: Int)
+        if all isDigit p
+            then return $ fromIntegral (read p :: Int)
             else do
                 service <- getServiceByName p "tcp"
                 return $ servicePort service
@@ -127,7 +125,7 @@ connectRange d p v r = do
         Nothing -> return (1, [])
         Just ccid -> do
             {-divide and conquer TLS-}
-            let newr = filter ((/=) ccid) r
+            let newr = filter (ccid /=) r
             let (lr, rr) =
                     if length newr > 2
                         then splitAt (length newr `div` 2) newr

debug/src/HexDump.hs

@@ -89,7 +89,7 @@ disptable cfg x =
 
     {-# INLINE hexBytes #-}
     hexBytes :: Word8 -> (Char, Char)
-    hexBytes w = (hex h, hex l) where (h, l) = (fromIntegral w) `divMod` 16
+    hexBytes w = (hex h, hex l) where (h, l) = fromIntegral w `divMod` 16
 
     -- \| Dump one byte into a 2 hexadecimal characters.
     hexString :: Word8 -> String

debug/src/RetrieveCertificate.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
 
 import Control.Exception
@@ -21,6 +19,7 @@ import Network.TLS.Extra.Cipher
 
 import Imports
 
+openConnection :: String -> String -> IO CertificateChain
 openConnection s p = do
     ref <- newIORef Nothing
     let params =
@@ -90,6 +89,7 @@ options =
     , Option ['h'] ["help"] (NoArg Help) "request help"
     ]
 
+showCert :: String -> SignedExact Certificate -> IO ()
 showCert "pem" cert = B.putStrLn $ pemWriteBS pem
   where
     pem =
@@ -98,31 +98,33 @@ showCert "pem" cert = B.putStrLn $ pemWriteBS pem
             , pemHeader = []
             , pemContent = encodeSignedObject cert
             }
-showCert "full" cert = putStrLn $ show cert
-showCert _ (signedCert) = do
-    putStrLn ("serial:   " ++ (show $ certSerial cert))
-    putStrLn ("issuer:   " ++ (show $ certIssuerDN cert))
-    putStrLn ("subject:  " ++ (show $ certSubjectDN cert))
+showCert "full" cert = print cert
+showCert _ signedCert = do
+    putStrLn ("serial:   " ++ show (certSerial cert))
+    putStrLn ("issuer:   " ++ show (certIssuerDN cert))
+    putStrLn ("subject:  " ++ show (certSubjectDN cert))
     putStrLn
         ( "validity: "
-            ++ (show $ fst $ certValidity cert)
+            ++ show (fst $ certValidity cert)
             ++ " to "
-            ++ (show $ snd $ certValidity cert)
+            ++ show (snd $ certValidity cert)
         )
   where
     cert = getCertificate signedCert
 
+printUsage :: IO ()
 printUsage =
     putStrLn $
         usageInfo
             "usage: retrieve-certificate [opts] <hostname> [port]\n\n\t(port default to: 443)\noptions:\n"
             options
 
+main :: IO ()
 main = do
     args <- getArgs
     let (opts, other, errs) = getOpt Permute options args
     when (not $ null errs) $ do
-        putStrLn $ show errs
+        print errs
         exitFailure
 
     when (Help `elem` opts) $ do
@@ -149,16 +151,14 @@ main = do
         let (CertificateChain certs) = chain
             format = outputFormat opts
             fqdn = getFQDN opts
-        case PrintChain `elem` opts of
-            True ->
-                forM_ (zip [0 ..] certs) $ \(n, cert) -> do
-                    putStrLn ("###### Certificate " ++ show (n + 1 :: Int) ++ " ######")
-                    showCert format cert
-            False ->
-                showCert format $ head certs
+        if PrintChain `elem` opts
+            then forM_ (zip [0 ..] certs) $ \(n, cert) -> do
+                putStrLn ("###### Certificate " ++ show (n + 1 :: Int) ++ " ######")
+                showCert format cert
+            else showCert format $ head certs
 
         let fingerprints = foldl (doFingerprint (head certs)) [] opts
-        unless (null fingerprints) $ putStrLn ("Fingerprints:")
+        unless (null fingerprints) $ putStrLn "Fingerprints:"
         mapM_ (\(alg, fprint) -> putStrLn ("  " ++ alg ++ " = " ++ show fprint)) $
             concat fingerprints
 
@@ -168,13 +168,13 @@ main = do
             let checks =
                     defaultChecks
                         { checkExhaustive = True
-                        , checkFQHN = maybe False (const True) fqdn
+                        , checkFQHN = isJust fqdn
                         }
-                servId = (maybe "" id fqdn, B.empty)
+                servId = (fromMaybe "" fqdn, B.empty)
             reasons <- validate X509.HashSHA256 def checks store def servId chain
-            when (not $ null reasons) $ do
+            unless (null reasons) $ do
                 putStrLn "fail validation:"
-                putStrLn $ show reasons
+                print reasons
 
     doFingerprint cert acc GetFingerprint =
         [ ("SHA1", getFingerprint cert X509.HashSHA1)