switch to CPRG instead of CryptoRandomGen
This commit is contained in:
parent
ce421b40c8
commit
cedd5b2c86
8 changed files with 32 additions and 29 deletions
|
@ -85,7 +85,7 @@ import Data.List (intercalate)
|
|||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
import Crypto.Random
|
||||
import Crypto.Random.API
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
import Control.Monad.State
|
||||
|
@ -333,7 +333,7 @@ ctxLogging :: Context -> Logging
|
|||
ctxLogging = pLogging . ctxParams
|
||||
|
||||
-- | create a new context using the backend and parameters specified.
|
||||
contextNew :: (MonadIO m, CryptoRandomGen rng)
|
||||
contextNew :: (MonadIO m, CPRG rng)
|
||||
=> Backend -- ^ Backend abstraction with specific method to interacat with the connection type.
|
||||
-> Params -- ^ Parameters of the context.
|
||||
-> rng -- ^ Random number generator associated with this context.
|
||||
|
@ -362,7 +362,7 @@ contextNew backend params rng = liftIO $ do
|
|||
}
|
||||
|
||||
-- | create a new context on an handle.
|
||||
contextNewOnHandle :: (MonadIO m, CryptoRandomGen rng)
|
||||
contextNewOnHandle :: (MonadIO m, CPRG rng)
|
||||
=> Handle -- ^ Handle of the connection.
|
||||
-> Params -- ^ Parameters of the context.
|
||||
-> rng -- ^ Random number generator associated with this context.
|
||||
|
|
|
@ -26,8 +26,9 @@ import qualified Crypto.Hash.SHA1 as SHA1
|
|||
import qualified Crypto.Hash.MD5 as MD5
|
||||
import qualified Data.ByteString as B
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Crypto.Cipher.RSA as RSA
|
||||
import Crypto.Random (CryptoRandomGen)
|
||||
import qualified Crypto.PubKey.RSA as RSA
|
||||
import qualified Crypto.PubKey.RSA.PKCS15 as RSA
|
||||
import Crypto.Random.API
|
||||
|
||||
data PublicKey = PubRSA RSA.PublicKey
|
||||
|
||||
|
@ -100,8 +101,10 @@ generalizeRSAError :: Either RSA.Error a -> Either KxError a
|
|||
generalizeRSAError (Left e) = Left (RSAError e)
|
||||
generalizeRSAError (Right x) = Right x
|
||||
|
||||
kxEncrypt :: CryptoRandomGen g => g -> PublicKey -> ByteString -> Either KxError (ByteString, g)
|
||||
kxEncrypt g (PubRSA pk) b = generalizeRSAError $ RSA.encrypt g pk b
|
||||
kxEncrypt :: CPRG g => g -> PublicKey -> ByteString -> (Either KxError ByteString, g)
|
||||
kxEncrypt g (PubRSA pk) b = case RSA.encrypt g pk b of
|
||||
Left e -> (Left $ RSAError e, g)
|
||||
Right (v, g') -> (Right v, g')
|
||||
|
||||
kxDecrypt :: PrivateKey -> ByteString -> Either KxError ByteString
|
||||
kxDecrypt (PrivRSA pk) b = generalizeRSAError $ RSA.decrypt pk b
|
||||
|
|
|
@ -84,9 +84,11 @@ encryptRSA :: ByteString -> TLSSt ByteString
|
|||
encryptRSA content = do
|
||||
st <- get
|
||||
let rsakey = fromJust "rsa public key" $ hstRSAPublicKey $ fromJust "handshake" $ stHandshake st
|
||||
case withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content) of
|
||||
(v,rng') = withTLSRNG (stRandomGen st) (\g -> kxEncrypt g rsakey content)
|
||||
in do put (st { stRandomGen = rng' })
|
||||
case v of
|
||||
Left err -> fail ("rsa encrypt failed: " ++ show err)
|
||||
Right (econtent, rng') -> put (st { stRandomGen = rng' }) >> return econtent
|
||||
Right econtent -> return econtent
|
||||
|
||||
signRSA :: (ByteString -> ByteString, ByteString) -> ByteString -> TLSSt ByteString
|
||||
signRSA hsh content = do
|
||||
|
|
|
@ -89,7 +89,7 @@ import Control.Applicative ((<$>))
|
|||
import Control.Monad
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Error
|
||||
import Crypto.Random
|
||||
import Crypto.Random.API
|
||||
import Data.Certificate.X509
|
||||
|
||||
assert :: Monad m => String -> [(String,Bool)] -> m ()
|
||||
|
@ -127,7 +127,7 @@ data TLSHandshakeState = TLSHandshakeState
|
|||
, hstClientCertChain :: !(Maybe [X509])
|
||||
} deriving (Show)
|
||||
|
||||
data StateRNG = forall g . CryptoRandomGen g => StateRNG g
|
||||
data StateRNG = forall g . CPRG g => StateRNG g
|
||||
|
||||
instance Show StateRNG where
|
||||
show _ = "rng[..]"
|
||||
|
@ -178,7 +178,7 @@ instance MonadState TLSState TLSSt where
|
|||
runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
|
||||
runTLSState f st = runState (runErrorT (runTLSSt f)) st
|
||||
|
||||
newTLSState :: CryptoRandomGen g => g -> TLSState
|
||||
newTLSState :: CPRG g => g -> TLSState
|
||||
newTLSState rng = TLSState
|
||||
{ stClientContext = False
|
||||
, stVersion = TLS10
|
||||
|
@ -209,10 +209,9 @@ newTLSState rng = TLSState
|
|||
, stClientCertificateChain = Nothing
|
||||
}
|
||||
|
||||
withTLSRNG :: StateRNG -> (forall g . CryptoRandomGen g => g -> Either e (a,g)) -> Either e (a, StateRNG)
|
||||
withTLSRNG (StateRNG rng) f = case f rng of
|
||||
Left err -> Left err
|
||||
Right (a, rng') -> Right (a, StateRNG rng')
|
||||
withTLSRNG :: StateRNG -> (forall g . CPRG g => g -> (a,g)) -> (a, StateRNG)
|
||||
withTLSRNG (StateRNG rng) f = let (a, rng') = f rng
|
||||
in (a, StateRNG rng')
|
||||
|
||||
withCompression :: (Compression -> (Compression, a)) -> TLSSt a
|
||||
withCompression f = do
|
||||
|
@ -224,9 +223,8 @@ withCompression f = do
|
|||
genTLSRandom :: (MonadState TLSState m, MonadError TLSError m) => Int -> m Bytes
|
||||
genTLSRandom n = do
|
||||
st <- get
|
||||
case withTLSRNG (stRandomGen st) (genBytes n) of
|
||||
Left err -> throwError $ Error_Random $ show err
|
||||
Right (bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
|
||||
case withTLSRNG (stRandomGen st) (\g -> genRandomBytes g n) of
|
||||
(bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
|
||||
|
||||
makeDigest :: MonadState TLSState m => Bool -> Header -> Bytes -> m Bytes
|
||||
makeDigest w hdr content = do
|
||||
|
|
|
@ -7,7 +7,7 @@ module Tests.PubKey
|
|||
import Test.QuickCheck
|
||||
|
||||
import qualified Crypto.Random.AESCtr as RNG
|
||||
import qualified Crypto.Cipher.RSA as RSA
|
||||
import qualified Crypto.PubKey.RSA as RSA
|
||||
|
||||
import qualified Data.ByteString as B
|
||||
|
||||
|
@ -19,9 +19,7 @@ arbitraryRSAPair = do
|
|||
rng <- (maybe (error "making rng") id . RNG.make . B.pack) `fmap` vector 64
|
||||
arbitraryRSAPairWithRNG rng
|
||||
|
||||
arbitraryRSAPairWithRNG rng = case RSA.generate rng 128 65537 of
|
||||
Left _ -> error "couldn't generate RSA"
|
||||
Right (keypair, _) -> return keypair
|
||||
arbitraryRSAPairWithRNG rng = return $ fst $ RSA.generate rng 128 0x10001
|
||||
|
||||
{-# NOINLINE globalRSAPair #-}
|
||||
globalRSAPair :: MVar (RSA.PublicKey, RSA.PrivateKey)
|
||||
|
|
|
@ -45,7 +45,8 @@ Library
|
|||
, cereal >= 0.3
|
||||
, bytestring
|
||||
, network
|
||||
, crypto-api >= 0.5
|
||||
, crypto-random-api
|
||||
, crypto-pubkey
|
||||
, cryptocipher >= 0.3.0 && < 0.4.0
|
||||
, certificate >= 1.3.0 && < 1.4.0
|
||||
Exposed-modules: Network.TLS
|
||||
|
@ -98,11 +99,12 @@ executable Tests
|
|||
, bytestring
|
||||
, time
|
||||
, cryptocipher >= 0.3.0 && < 0.4.0
|
||||
, crypto-pubkey
|
||||
, network
|
||||
, cprng-aes >= 0.3.0
|
||||
, cryptohash >= 0.6
|
||||
, certificate >= 1.3.0 && < 1.4.0
|
||||
, crypto-api >= 0.5
|
||||
, crypto-random-api
|
||||
else
|
||||
Buildable: False
|
||||
ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures -fhpc
|
||||
|
|
|
@ -9,7 +9,7 @@ module Network.TLS.Extra.Connection
|
|||
( connectionClient
|
||||
) where
|
||||
|
||||
import Crypto.Random
|
||||
import Crypto.Random.Types
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Exception
|
||||
import Data.Char
|
||||
|
@ -33,7 +33,7 @@ import Network.TLS
|
|||
--
|
||||
-- will make a new RNG (using system entropy) and connect to IP 192.168.2.2
|
||||
-- on port 7777.
|
||||
connectionClient :: CryptoRandomGen g => String -> String -> TLSParams -> g -> IO Context
|
||||
connectionClient :: CPRG g => String -> String -> TLSParams -> g -> IO Context
|
||||
connectionClient s p params rng = do
|
||||
pn <- if and $ map isDigit $ p
|
||||
then return $ fromIntegral $ (read p :: Int)
|
||||
|
|
|
@ -30,9 +30,9 @@ Library
|
|||
, cryptohash >= 0.6
|
||||
, bytestring
|
||||
, vector
|
||||
, crypto-api >= 0.5
|
||||
, cryptocipher >= 0.3.0 && < 0.4.0
|
||||
, certificate >= 1.3.0 && < 1.4.0
|
||||
, crypto-random-types
|
||||
, pem >= 0.1.0 && < 0.2.0
|
||||
, text >= 0.5 && < 1.0
|
||||
, time
|
||||
|
|
Loading…
Reference in a new issue