<commit_before>{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
-- |
-- Module      : Network.TLS.Handshake.Client
-- License     : BSD-style
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.Handshake.Client
    ( handshakeClient
    , handshakeClientWith
    ) where

import Network.TLS.Crypto
import Network.TLS.Context.Internal
import Network.TLS.Parameters
import Network.TLS.Struct
import Network.TLS.Cipher
import Network.TLS.Compression
import Network.TLS.Packet
import Network.TLS.ErrT
import Network.TLS.Extension
import Network.TLS.IO
import Network.TLS.State hiding (getNegotiatedProtocol)
import Network.TLS.Measurement
import Network.TLS.Wire (encodeWord16)
import Network.TLS.Util (bytesEq, catchException)
import Network.TLS.Types
import Network.TLS.X509
import Data.Maybe
import Data.List (find)
import qualified Data.ByteString as B
import Data.ByteString.Char8 ()

import Control.Applicative ((<$>), (<*>))
import Control.Monad.State
import Control.Exception (SomeException)

import Network.TLS.Handshake.Common
import Network.TLS.Handshake.Process
import Network.TLS.Handshake.Certificate
import Network.TLS.Handshake.Signature
import Network.TLS.Handshake.Key
import Network.TLS.Handshake.State

handshakeClientWith :: ClientParams -> Context -> Handshake -> IO ()
handshakeClientWith cparams ctx HelloRequest = handshakeClient cparams ctx
handshakeClientWith _       _   _            = throwCore $ Error_Protocol ("unexpected handshake message received in handshakeClientWith", True, HandshakeFailure)

-- client part of handshake. send a bunch of handshake of client
-- values intertwined with response from the server.
handshakeClient :: ClientParams -> Context -> IO ()
handshakeClient cparams ctx = do
    updateMeasure ctx incrementNbHandshakes
    sentExtensions <- sendClientHello
    recvServerHello sentExtensions
    sessionResuming <- usingState_ ctx isSessionResuming
    if sessionResuming
        then sendChangeCipherAndFinish sendMaybeNPN ctx ClientRole
        else do sendClientData cparams ctx
                sendChangeCipherAndFinish sendMaybeNPN ctx ClientRole
                recvChangeCipherAndFinish ctx
    handshakeTerminate ctx
  where ciphers      = ctxCiphers ctx
        compressions = supportedCompressions $ ctxSupported ctx
        getExtensions = sequence [sniExtension,secureReneg,npnExtention,alpnExtension] >>= return . catMaybes

        toExtensionRaw :: Extension e => e -> ExtensionRaw
        toExtensionRaw ext = (extensionID ext, extensionEncode ext)

        secureReneg  =
                if supportedSecureRenegotiation $ ctxSupported ctx
                then usingState_ ctx (getVerifiedData ClientRole) >>= \vd -> return $ Just $ toExtensionRaw $ SecureRenegotiation vd Nothing
                else return Nothing
        npnExtention = if isJust $ onNPNServerSuggest $ clientHooks cparams
                         then return $ Just $ toExtensionRaw $ NextProtocolNegotiation []
                         else return Nothing
        alpnExtension = do
            mprotos <- onSuggestALPN $ clientHooks cparams
            case mprotos of
                Nothing -> return Nothing
                Just protos -> do
                    usingState_ ctx $ setClientALPNSuggest protos
                    return $ Just $ toExtensionRaw $ ApplicationLayerProtocolNegotiation protos
        sniExtension = if clientUseServerNameIndication cparams
                         then return $ Just $ toExtensionRaw $ ServerName [ServerNameHostName $ fst $ clientServerIdentification cparams]
                         else return Nothing
        sendClientHello = do
            crand <- getStateRNG ctx 32 >>= return . ClientRandom
            let clientSession = Session . maybe Nothing (Just . fst) $ clientWantSessionResume cparams
                highestVer = maximum $ supportedVersions $ ctxSupported ctx
            extensions <- getExtensions
            startHandshake ctx highestVer crand
            usingState_ ctx $ setVersionIfUnset highestVer
            sendPacket ctx $ Handshake
                [ ClientHello highestVer crand clientSession (map cipherID ciphers)
                              (map compressionID compressions) extensions Nothing
                ]
            return $ map fst extensions

        sendMaybeNPN = do
            suggest <- usingState_ ctx $ getServerNextProtocolSuggest
            case (onNPNServerSuggest $ clientHooks cparams, suggest) of
                -- client offered, server picked up. send NPN handshake.
                (Just io, Just protos) -> do proto <- liftIO $ io protos
                                             sendPacket ctx (Handshake [HsNextProtocolNegotiation proto])
                                             usingState_ ctx $ setNegotiatedProtocol proto
                -- client offered, server didn't pick up. do nothing.
                (Just _, Nothing) -> return ()
                -- client didn't offer. do nothing.
                (Nothing, _) -> return ()

        recvServerHello sentExts = runRecvState ctx recvState
          where recvState = RecvStateNext $ \p ->
                    case p of
                        Handshake hs -> onRecvStateHandshake ctx (RecvStateHandshake $ onServerHello ctx cparams sentExts) hs
                        Alert a      ->
                            case a of<commit_msg>add signature algorithms extension<commit_after>{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
-- |
-- Module      : Network.TLS.Handshake.Client
-- License     : BSD-style
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : unknown
--
module Network.TLS.Handshake.Client
    ( handshakeClient
    , handshakeClientWith
    ) where

import Network.TLS.Crypto
import Network.TLS.Context.Internal
import Network.TLS.Parameters
import Network.TLS.Struct
import Network.TLS.Cipher
import Network.TLS.Compression
import Network.TLS.Packet
import Network.TLS.ErrT
import Network.TLS.Extension
import Network.TLS.IO
import Network.TLS.State hiding (getNegotiatedProtocol)
import Network.TLS.Measurement
import Network.TLS.Wire (encodeWord16)
import Network.TLS.Util (bytesEq, catchException)
import Network.TLS.Types
import Network.TLS.X509
import Data.Maybe
import Data.List (find)
import qualified Data.ByteString as B
import Data.ByteString.Char8 ()

import Control.Applicative ((<$>), (<*>))
import Control.Monad.State
import Control.Exception (SomeException)

import Network.TLS.Handshake.Common
import Network.TLS.Handshake.Process
import Network.TLS.Handshake.Certificate
import Network.TLS.Handshake.Signature
import Network.TLS.Handshake.Key
import Network.TLS.Handshake.State

handshakeClientWith :: ClientParams -> Context -> Handshake -> IO ()
handshakeClientWith cparams ctx HelloRequest = handshakeClient cparams ctx
handshakeClientWith _       _   _            = throwCore $ Error_Protocol ("unexpected handshake message received in handshakeClientWith", True, HandshakeFailure)

-- client part of handshake. send a bunch of handshake of client
-- values intertwined with response from the server.
handshakeClient :: ClientParams -> Context -> IO ()
handshakeClient cparams ctx = do
    updateMeasure ctx incrementNbHandshakes
    sentExtensions <- sendClientHello
    recvServerHello sentExtensions
    sessionResuming <- usingState_ ctx isSessionResuming
    if sessionResuming
        then sendChangeCipherAndFinish sendMaybeNPN ctx ClientRole
        else do sendClientData cparams ctx
                sendChangeCipherAndFinish sendMaybeNPN ctx ClientRole
                recvChangeCipherAndFinish ctx
    handshakeTerminate ctx
  where ciphers      = ctxCiphers ctx
        compressions = supportedCompressions $ ctxSupported ctx
        getExtensions = sequence [sniExtension,secureReneg,npnExtention,alpnExtension] >>= return . catMaybes

        toExtensionRaw :: Extension e => e -> ExtensionRaw
        toExtensionRaw ext = (extensionID ext, extensionEncode ext)

        secureReneg  =
                if supportedSecureRenegotiation $ ctxSupported ctx
                then usingState_ ctx (getVerifiedData ClientRole) >>= \vd -> return $ Just $ toExtensionRaw $ SecureRenegotiation vd Nothing
                else return Nothing
        npnExtention = if isJust $ onNPNServerSuggest $ clientHooks cparams
                         then return $ Just $ toExtensionRaw $ NextProtocolNegotiation []
                         else return Nothing
        alpnExtension = do
            mprotos <- onSuggestALPN $ clientHooks cparams
            case mprotos of
                Nothing -> return Nothing
                Just protos -> do
                    usingState_ ctx $ setClientALPNSuggest protos
                    return $ Just $ toExtensionRaw $ ApplicationLayerProtocolNegotiation protos
        sniExtension = if clientUseServerNameIndication cparams
                         then return $ Just $ toExtensionRaw $ ServerName [ServerNameHostName $ fst $ clientServerIdentification cparams]
                         else return Nothing
        signatureAlgExtension = return $ Just $ toExtensionRaw $ SignatureAlgorithms $ supportedHashSignatures $ clientSupported cparams

        sendClientHello = do
            crand <- getStateRNG ctx 32 >>= return . ClientRandom
            let clientSession = Session . maybe Nothing (Just . fst) $ clientWantSessionResume cparams
                highestVer = maximum $ supportedVersions $ ctxSupported ctx
            extensions <- getExtensions
            startHandshake ctx highestVer crand
            usingState_ ctx $ setVersionIfUnset highestVer
            sendPacket ctx $ Handshake
                [ ClientHello highestVer crand clientSession (map cipherID ciphers)
                              (map compressionID compressions) extensions Nothing
                ]
            return $ map fst extensions

        sendMaybeNPN = do
            suggest <- usingState_ ctx $ getServerNextProtocolSuggest
            case (onNPNServerSuggest $ clientHooks cparams, suggest) of
                -- client offered, server picked up. send NPN handshake.
                (Just io, Just protos) -> do proto <- liftIO $ io protos
                                             sendPacket ctx (Handshake [HsNextProtocolNegotiation proto])
                                             usingState_ ctx $ setNegotiatedProtocol proto
                -- client offered, server didn't pick up. do nothing.
                (Just _, Nothing) -> return ()
                -- client didn't offer. do nothing.
                (Nothing, _) -> return ()

        recvServerHello sentExts = runRecvState ctx recvState
          where recvState = RecvStateNext $ \p ->
                    case p of
                        Handshake hs -> onRecvStateHandshake ctx (RecvStateHandshake $ onServerHello ctx cparams sentExts) hs
                        Alert a      ->
                            case a of
{'fraction_non_alphanumeric': 0.05955515206536541, 'fraction_numerical': 0.0014525646845211075, 'mean_word_length': 2.42430836182779, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 57, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 8, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5882932', 'n_tokens_mistral': 2738, 'n_tokens_neox': 2601, 'n_words': 810}