<commit_before>-- |
-- Module      : Network.TLS.Handshake.Key
-- License     : BSD-style
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : unknown
--
-- functions for RSA operations
--
module Network.TLS.Handshake.Key
    ( encryptRSA
    , signRSA
    , decryptRSA
    , verifyRSA
    ) where

import Control.Applicative ((<$>))
import Control.Monad.State

import Data.ByteString (ByteString)
import qualified Data.ByteString as B

import Network.TLS.Util
import Network.TLS.State
import Network.TLS.Crypto
import Network.TLS.Types
import Network.TLS.Context

{- if the RSA encryption fails we just return an empty bytestring, and let the protocol
 - fail by itself; however it would be probably better to just report it since it's an internal problem.
 -}
encryptRSA :: MonadIO m => Context -> ByteString -> m ByteString
encryptRSA ctx content = usingState_ ctx $ do
    rsakey <- fromJust "rsa public key" . hstRSAPublicKey . fromJust "handshake" . stHandshake <$> get
    v      <- withRNG (\g -> kxEncrypt g rsakey content)
    case v of
        Left err       -> fail ("rsa encrypt failed: " ++ show err)
        Right econtent -> return econtent

signRSA :: MonadIO m => Context -> HashDescr -> ByteString -> m ByteString
signRSA ctx hsh content = usingState_ ctx $ do
    rsakey <- fromJust "rsa client private key" . hstRSAClientPrivateKey . fromJust "handshake" . stHandshake <$> get
    r      <- withRNG (\g -> kxSign g rsakey hsh content)
    case r of
        Left err       -> fail ("rsa sign failed: " ++ show err)
        Right econtent -> return econtent

decryptRSA :: MonadIO m => Context -> ByteString -> m (Either KxError ByteString)
decryptRSA ctx econtent = usingState_ ctx $ do
    ver     <- getVersion
    rsapriv <- fromJust "rsa private key" . hstRSAPrivateKey . fromJust "handshake" . stHandshake <$> get
    let cipher = if ver < TLS10 then econtent else B.drop 2 econtent
    withRNG (\g -> kxDecrypt g rsapriv cipher)

verifyRSA :: MonadIO m => Context -> HashDescr -> ByteString -> ByteString -> m Bool
verifyRSA ctx hsh econtent sign = usingState_ ctx $ do
    rsapriv <- fromJust "rsa client public key" . hstRSAClientPublicKey . fromJust "handshake" . stHandshake <$> get
    return $ kxVerify rsapriv hsh econtent sign
<commit_msg>separate state from handshake state<commit_after>-- |
-- Module      : Network.TLS.Handshake.Key
-- License     : BSD-style
-- Maintainer  : <NAME> <<EMAIL>>
-- Stability   : experimental
-- Portability : unknown
--
-- functions for RSA operations
--
module Network.TLS.Handshake.Key
    ( encryptRSA
    , signRSA
    , decryptRSA
    , verifyRSA
    ) where

import Control.Monad.State

import Data.ByteString (ByteString)
import qualified Data.ByteString as B

import Network.TLS.Util
import Network.TLS.State
import Network.TLS.Crypto
import Network.TLS.Types
import Network.TLS.Context

{- if the RSA encryption fails we just return an empty bytestring, and let the protocol
 - fail by itself; however it would be probably better to just report it since it's an internal problem.
 -}
encryptRSA :: MonadIO m => Context -> ByteString -> m ByteString
encryptRSA ctx content = do
    rsakey <- return . fromJust "rsa public key" =<< handshakeGet ctx hstRSAPublicKey
    usingState_ ctx $ do
        v      <- withRNG (\g -> kxEncrypt g rsakey content)
        case v of
            Left err       -> fail ("rsa encrypt failed: " ++ show err)
            Right econtent -> return econtent

signRSA :: MonadIO m => Context -> HashDescr -> ByteString -> m ByteString
signRSA ctx hsh content = do
    rsakey <- return . fromJust "rsa client private key" =<< handshakeGet ctx hstRSAClientPrivateKey
    usingState_ ctx $ do
        r      <- withRNG (\g -> kxSign g rsakey hsh content)
        case r of
            Left err       -> fail ("rsa sign failed: " ++ show err)
            Right econtent -> return econtent

decryptRSA :: MonadIO m => Context -> ByteString -> m (Either KxError ByteString)
decryptRSA ctx econtent = do
    rsapriv <- return . fromJust "rsa private key" =<< handshakeGet ctx hstRSAPrivateKey
    usingState_ ctx $ do
        ver     <- getVersion
        let cipher = if ver < TLS10 then econtent else B.drop 2 econtent
        withRNG (\g -> kxDecrypt g rsapriv cipher)

verifyRSA :: MonadIO m => Context -> HashDescr -> ByteString -> ByteString -> m Bool
verifyRSA ctx hsh econtent sign = do
    rsapriv <- return . fromJust "rsa client public key" =<< handshakeGet ctx hstRSAClientPublicKey
    return $ kxVerify rsapriv hsh econtent sign

handshakeGet :: MonadIO m => Context -> (HandshakeState -> a) -> m a
handshakeGet ctx f = usingHState ctx (gets f)
{'fraction_non_alphanumeric': 0.09224855861627163, 'fraction_numerical': 0.0012812299807815502, 'mean_word_length': 2.906588824020017, 'pattern_counts': {'":': 0, '<': 38, '<?xml version=': 0, '>': 62, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3377068', 'n_tokens_mistral': 1446, 'n_tokens_neox': 1389, 'n_words': 514}