2011-03-02 08:43:05 +00:00
|
|
|
{-# OPTIONS_HADDOCK hide #-}
|
2010-09-09 21:47:19 +00:00
|
|
|
module Network.TLS.Crypto
|
|
|
|
( HashType(..)
|
|
|
|
, HashCtx
|
|
|
|
|
|
|
|
-- * incremental interface with algorithm type wrapping for genericity
|
|
|
|
, initHash
|
|
|
|
, updateHash
|
|
|
|
, finalizeHash
|
|
|
|
|
|
|
|
-- * single pass lazy bytestring interface for each algorithm
|
|
|
|
, hashMD5
|
|
|
|
, hashSHA1
|
|
|
|
-- * incremental interface for each algorithm
|
|
|
|
, initMD5
|
|
|
|
, updateMD5
|
|
|
|
, finalizeMD5
|
|
|
|
, initSHA1
|
|
|
|
, updateSHA1
|
|
|
|
, finalizeSHA1
|
|
|
|
|
2010-11-04 19:10:00 +00:00
|
|
|
-- * key exchange generic interface
|
2010-09-09 21:47:19 +00:00
|
|
|
, PublicKey(..)
|
|
|
|
, PrivateKey(..)
|
2010-11-04 19:10:00 +00:00
|
|
|
, kxEncrypt
|
|
|
|
, kxDecrypt
|
|
|
|
, KxError(..)
|
2010-09-09 21:47:19 +00:00
|
|
|
) where
|
|
|
|
|
2010-10-24 10:36:36 +00:00
|
|
|
import qualified Crypto.Hash.SHA1 as SHA1
|
|
|
|
import qualified Crypto.Hash.MD5 as MD5
|
2010-09-09 21:47:19 +00:00
|
|
|
import qualified Data.ByteString as B
|
2010-09-26 09:34:47 +00:00
|
|
|
import Data.ByteString (ByteString)
|
2010-11-04 19:10:00 +00:00
|
|
|
import qualified Crypto.Cipher.RSA as RSA
|
|
|
|
import Crypto.Random (CryptoRandomGen)
|
|
|
|
|
|
|
|
data PublicKey = PubRSA RSA.PublicKey
|
|
|
|
|
|
|
|
data PrivateKey = PrivRSA RSA.PrivateKey
|
|
|
|
|
|
|
|
instance Show PublicKey where
|
|
|
|
show (_) = "PublicKey(..)"
|
|
|
|
|
|
|
|
instance Show PrivateKey where
|
|
|
|
show (_) = "privateKey(..)"
|
|
|
|
|
|
|
|
data KxError = RSAError RSA.Error
|
|
|
|
deriving (Show)
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
data HashCtx =
|
|
|
|
SHA1 !SHA1.Ctx
|
|
|
|
| MD5 !MD5.Ctx
|
|
|
|
|
2010-11-04 19:10:00 +00:00
|
|
|
data KeyXchg =
|
|
|
|
KxRSA RSA.PublicKey RSA.PrivateKey
|
|
|
|
deriving (Show)
|
|
|
|
|
2010-09-09 21:47:19 +00:00
|
|
|
instance Show HashCtx where
|
|
|
|
show (SHA1 _) = "sha1"
|
|
|
|
show (MD5 _) = "md5"
|
|
|
|
|
|
|
|
data HashType = HashTypeSHA1 | HashTypeMD5
|
|
|
|
|
|
|
|
{- MD5 -}
|
|
|
|
|
|
|
|
initMD5 :: MD5.Ctx
|
|
|
|
initMD5 = MD5.init
|
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
updateMD5 :: MD5.Ctx -> ByteString -> MD5.Ctx
|
2010-09-09 21:47:19 +00:00
|
|
|
updateMD5 = MD5.update
|
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
finalizeMD5 :: MD5.Ctx -> ByteString
|
2010-09-09 21:47:19 +00:00
|
|
|
finalizeMD5 = MD5.finalize
|
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
hashMD5 :: ByteString -> ByteString
|
|
|
|
hashMD5 = MD5.hash
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
{- SHA1 -}
|
|
|
|
|
|
|
|
initSHA1 :: SHA1.Ctx
|
|
|
|
initSHA1 = SHA1.init
|
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
updateSHA1 :: SHA1.Ctx -> ByteString -> SHA1.Ctx
|
2010-09-09 21:47:19 +00:00
|
|
|
updateSHA1 = SHA1.update
|
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
finalizeSHA1 :: SHA1.Ctx -> ByteString
|
2010-09-09 21:47:19 +00:00
|
|
|
finalizeSHA1 = SHA1.finalize
|
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
hashSHA1 :: ByteString -> ByteString
|
|
|
|
hashSHA1 = SHA1.hash
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
{- generic Hashing -}
|
|
|
|
|
|
|
|
initHash :: HashType -> HashCtx
|
|
|
|
initHash HashTypeSHA1 = SHA1 (initSHA1)
|
|
|
|
initHash HashTypeMD5 = MD5 (initMD5)
|
|
|
|
|
|
|
|
updateHash :: HashCtx -> B.ByteString -> HashCtx
|
|
|
|
updateHash (SHA1 ctx) = SHA1 . updateSHA1 ctx
|
|
|
|
updateHash (MD5 ctx) = MD5 . updateMD5 ctx
|
|
|
|
|
|
|
|
finalizeHash :: HashCtx -> B.ByteString
|
|
|
|
finalizeHash (SHA1 ctx) = finalizeSHA1 ctx
|
|
|
|
finalizeHash (MD5 ctx) = finalizeMD5 ctx
|
|
|
|
|
2010-11-04 19:10:00 +00:00
|
|
|
{- key exchange methods encrypt and decrypt for each supported algorithm -}
|
|
|
|
generalizeRSAError :: Either RSA.Error a -> Either KxError a
|
|
|
|
generalizeRSAError (Left e) = Left (RSAError e)
|
|
|
|
generalizeRSAError (Right x) = Right x
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-11-04 19:10:00 +00:00
|
|
|
kxEncrypt :: CryptoRandomGen g => g -> PublicKey -> ByteString -> Either KxError (ByteString, g)
|
|
|
|
kxEncrypt g (PubRSA pk) b = generalizeRSAError $ RSA.encrypt g pk b
|
2010-09-26 09:34:47 +00:00
|
|
|
|
2010-11-04 19:10:00 +00:00
|
|
|
kxDecrypt :: PrivateKey -> ByteString -> Either KxError ByteString
|
|
|
|
kxDecrypt (PrivRSA pk) b = generalizeRSAError $ RSA.decrypt pk b
|