diff --git a/Data/X509.hs b/Data/X509.hs --- a/Data/X509.hs +++ b/Data/X509.hs @@ -61,6 +61,7 @@ import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding import qualified Data.ByteString as B +import qualified Data.ByteArray as BA import Data.X509.Cert import Data.X509.Ext @@ -73,8 +74,7 @@ import Data.X509.PrivateKey import Data.X509.AlgorithmIdentifier -import qualified Crypto.Hash.MD5 as MD5 -import qualified Crypto.Hash.SHA1 as SHA1 +import Crypto.Hash -- | A Signed Certificate type SignedCertificate = SignedExact Certificate @@ -103,7 +103,7 @@ -- OpenSSL algorithm is odd, and has been replicated here somewhat. -- only lower the case of ascii character. hashDN :: DistinguishedName -> B.ByteString -hashDN = shorten . SHA1.hash . encodeASN1' DER . flip toASN1 [] . DistinguishedNameInner . dnLowerUTF8 +hashDN = shorten . hashWith SHA1 . encodeASN1' DER . flip toASN1 [] . DistinguishedNameInner . dnLowerUTF8 where dnLowerUTF8 (DistinguishedName l) = DistinguishedName $ map (second toLowerUTF8) l toLowerUTF8 (ASN1CharacterString _ s) = ASN1CharacterString UTF8 (B.map asciiToLower s) asciiToLower c @@ -114,8 +114,8 @@ -- | Create an openssl style old hash of distinguished name hashDN_old :: DistinguishedName -> B.ByteString -hashDN_old = shorten . MD5.hash . encodeASN1' DER . flip toASN1 [] +hashDN_old = shorten . hashWith MD5 . encodeASN1' DER . flip toASN1 [] -shorten :: B.ByteString -> B.ByteString +shorten :: Digest a -> B.ByteString shorten b = B.pack $ map i [3,2,1,0] - where i n = B.index b n + where i n = BA.index b n diff --git a/Data/X509/Internal.hs b/Data/X509/Internal.hs --- a/Data/X509/Internal.hs +++ b/Data/X509/Internal.hs @@ -26,6 +26,7 @@ type ErrT = ExceptT #else import Control.Monad.Error +runErrT :: ErrorT e m a -> m (Either e a) runErrT = runErrorT type ErrT = ErrorT #endif diff --git a/Data/X509/OID.hs b/Data/X509/OID.hs new file mode 100644 --- /dev/null +++ b/Data/X509/OID.hs @@ -0,0 +1,63 @@ +-- | +-- Module : Data.X509.OID +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +module Data.X509.OID + ( OIDTable + , lookupByOID + , lookupOID + , curvesOIDTable + ) where + +import Control.Applicative +import Crypto.PubKey.ECC.Types +import Data.ASN1.OID +import Data.List (find) + +type OIDTable a = [(a,OID)] + +lookupByOID :: OIDTable a -> OID -> Maybe a +lookupByOID table oid = fst <$> find ((==) oid . snd) table + +lookupOID :: Eq a => OIDTable a -> a -> Maybe OID +lookupOID table a = lookup a table + +curvesOIDTable :: OIDTable CurveName +curvesOIDTable = + [ (SEC_p112r1, [1,3,132,0,6]) + , (SEC_p112r2, [1,3,132,0,7]) + , (SEC_p128r1, [1,3,132,0,28]) + , (SEC_p128r2, [1,3,132,0,29]) + , (SEC_p160k1, [1,3,132,0,9]) + , (SEC_p160r1, [1,3,132,0,8]) + , (SEC_p160r2, [1,3,132,0,30]) + , (SEC_p192k1, [1,3,132,0,31]) + , (SEC_p192r1, [1,2,840,10045,3,1,1]) + , (SEC_p224k1, [1,3,132,0,32]) + , (SEC_p224r1, [1,3,132,0,33]) + , (SEC_p256k1, [1,3,132,0,10]) + , (SEC_p256r1, [1,2,840,10045,3,1,7]) + , (SEC_p384r1, [1,3,132,0,34]) + , (SEC_p521r1, [1,3,132,0,35]) + , (SEC_t113r1, [1,3,132,0,4]) + , (SEC_t113r2, [1,3,132,0,5]) + , (SEC_t131r1, [1,3,132,0,22]) + , (SEC_t131r2, [1,3,132,0,23]) + , (SEC_t163k1, [1,3,132,0,1]) + , (SEC_t163r1, [1,3,132,0,2]) + , (SEC_t163r2, [1,3,132,0,15]) + , (SEC_t193r1, [1,3,132,0,24]) + , (SEC_t193r2, [1,3,132,0,25]) + , (SEC_t233k1, [1,3,132,0,26]) + , (SEC_t233r1, [1,3,132,0,27]) + , (SEC_t239k1, [1,3,132,0,3]) + , (SEC_t283k1, [1,3,132,0,16]) + , (SEC_t283r1, [1,3,132,0,17]) + , (SEC_t409k1, [1,3,132,0,36]) + , (SEC_t409r1, [1,3,132,0,37]) + , (SEC_t571k1, [1,3,132,0,38]) + , (SEC_t571r1, [1,3,132,0,39]) + ] diff --git a/Data/X509/PrivateKey.hs b/Data/X509/PrivateKey.hs --- a/Data/X509/PrivateKey.hs +++ b/Data/X509/PrivateKey.hs @@ -13,8 +13,8 @@ ) where import Data.X509.AlgorithmIdentifier -import qualified Crypto.Types.PubKey.RSA as RSA -import qualified Crypto.Types.PubKey.DSA as DSA +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.DSA as DSA -- | Private key types known and used in X.509 data PrivKey = @@ -26,3 +26,4 @@ privkeyToAlg :: PrivKey -> PubKeyALG privkeyToAlg (PrivKeyRSA _) = PubKeyALG_RSA privkeyToAlg (PrivKeyDSA _) = PubKeyALG_DSA + diff --git a/Data/X509/PublicKey.hs b/Data/X509/PublicKey.hs --- a/Data/X509/PublicKey.hs +++ b/Data/X509/PublicKey.hs @@ -17,12 +17,15 @@ import Data.ASN1.BinaryEncoding import Data.ASN1.BitArray +import Data.Bits + import Data.X509.Internal +import Data.X509.OID import Data.X509.AlgorithmIdentifier -import qualified Crypto.Types.PubKey.RSA as RSA -import qualified Crypto.Types.PubKey.DSA as DSA -import qualified Crypto.Types.PubKey.ECC as ECC +import qualified Crypto.PubKey.RSA.Types as RSA +import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.Types as ECC import Data.Word import qualified Data.ByteString as B @@ -48,7 +51,7 @@ fromASN1 (Start Sequence:Start Sequence:OID pkalg:xs) | pkalg == getObjectID PubKeyALG_RSA = case removeNull xs of - End Sequence:BitString bits:End Sequence:xs2 -> decodeASN1Err "RSA" bits xs2 (toPubKeyRSA . fromASN1) + End Sequence:BitString bits:End Sequence:xs2 -> decodeASN1Err "RSA" bits xs2 (toPubKeyRSA . rsaPubFromASN1) _ -> Left ("fromASN1: X509.PubKey: unknown RSA format: " ++ show xs) | pkalg == getObjectID PubKeyALG_DSA = case xs of @@ -67,7 +70,7 @@ | pkalg == getObjectID PubKeyALG_ECDSA = case xs of OID curveOid:End Sequence:BitString bits:End Sequence:xs2 -> - case fromObjectID curveOid of + case lookupByOID curvesOIDTable curveOid of Just curveName -> Right (PubKeyECDSA curveName (bitArrayGetData bits), xs2) Nothing -> Left ("fromASN1: X509.Pubkey: ECDSA unknown curve " ++ show curveOid) _ -> Left "fromASN1: X509.PubKey: unknown ECDSA format" @@ -100,7 +103,7 @@ pkalg = OID $ getObjectID $ pubkeyToAlg key encodeInner (PubKeyRSA pubkey) = asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray bits 0] - where bits = encodeASN1' DER $ asn1Container Sequence [IntVal (RSA.public_n pubkey), IntVal (RSA.public_e pubkey)] + where bits = encodeASN1' DER $ rsaPubToASN1 pubkey [] encodeInner (PubKeyDSA pubkey) = asn1Container Sequence ([pkalg] ++ dsaseq) ++ [BitString $ toBitArray bits 0] where @@ -118,3 +121,55 @@ encodeInner (PubKeyDH _) = error "encodeInner: unimplemented public key DH" encodeInner (PubKeyUnknown _ l) = asn1Container Sequence [pkalg,Null] ++ [BitString $ toBitArray l 0] + +rsaPubToASN1 :: RSA.PublicKey -> [ASN1] -> [ASN1] +rsaPubToASN1 pubkey xs = + Start Sequence : IntVal (RSA.public_n pubkey) : IntVal (RSA.public_e pubkey) : End Sequence : xs + +rsaPubFromASN1 :: [ASN1] -> Either String (RSA.PublicKey, [ASN1]) +rsaPubFromASN1 (Start Sequence:IntVal smodulus:IntVal pubexp:End Sequence:xs) = + Right (pub, xs) + where + pub = RSA.PublicKey { RSA.public_size = calculate_modulus modulus 1 + , RSA.public_n = modulus + , RSA.public_e = pubexp + } + calculate_modulus n i = if (2 ^ (i * 8)) > n then i else calculate_modulus n (i+1) + -- some bad implementation will not serialize ASN.1 integer properly, leading + -- to negative modulus. if that's the case, we correct it. + modulus = toPositive smodulus + +rsaPubFromASN1 ( Start Sequence + : IntVal ver + : Start Sequence + : OID oid + : Null + : End Sequence + : OctetString bs + : xs + ) + | ver /= 0 = Left "rsaPubFromASN1: Invalid version, expecting 0" + | oid /= [1,2,840,113549,1,1,1] = + Left "rsaPubFromASN1: invalid OID" + | otherwise = + let inner = either strError rsaPubFromASN1 $ decodeASN1' BER bs + strError = Left . ("fromASN1: RSA.PublicKey: " ++) . show + in either Left (\(k, _) -> Right (k, xs)) inner +rsaPubFromASN1 _ = + Left "fromASN1: RSA.PublicKey: unexpected format" + +-- some bad implementation will not serialize ASN.1 integer properly, leading +-- to negative modulus. +toPositive :: Integer -> Integer +toPositive int + | int < 0 = uintOfBytes $ bytesOfInt int + | otherwise = int + where + uintOfBytes = foldl (\acc n -> (acc `shiftL` 8) + fromIntegral n) 0 + bytesOfInt :: Integer -> [Word8] + bytesOfInt n = if testBit (head nints) 7 then nints else 0xff : nints + where nints = reverse $ plusOne $ reverse $ map complement $ bytesOfUInt (abs n) + plusOne [] = [1] + plusOne (x:xs) = if x == 0xff then 0 : plusOne xs else (x+1) : xs + bytesOfUInt x = reverse (list x) + where list i = if i <= 0xff then [fromIntegral i] else (fromIntegral i .&. 0xff) : list (i `shiftR` 8) diff --git a/Tests/Tests.hs b/Tests/Tests.hs --- a/Tests/Tests.hs +++ b/Tests/Tests.hs @@ -12,8 +12,8 @@ import Data.List (nub, sort) import Data.ASN1.Types import Data.X509 -import qualified Crypto.Types.PubKey.RSA as RSA -import qualified Crypto.Types.PubKey.DSA as DSA +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.DSA as DSA import Data.Hourglass diff --git a/x509.cabal b/x509.cabal --- a/x509.cabal +++ b/x509.cabal @@ -1,5 +1,5 @@ Name: x509 -Version: 1.5.1 +Version: 1.6.0 Description: X509 reader and writer License: BSD3 License-file: LICENSE @@ -16,6 +16,7 @@ Library Build-Depends: base >= 3 && < 5 , bytestring + , memory , mtl , containers , directory @@ -26,8 +27,7 @@ , asn1-types >= 0.3.0 && < 0.4 , asn1-encoding >= 0.9 && < 0.10 , asn1-parse >= 0.9 && < 0.10 - , crypto-pubkey-types >= 0.4.2.1 && < 0.5 - , cryptohash >= 0.9 && < 0.12 + , cryptonite Exposed-modules: Data.X509 Other-modules: Data.X509.Internal Data.X509.CertificateChain @@ -39,6 +39,7 @@ Data.X509.Ext Data.X509.ExtensionRaw Data.X509.CRL + Data.X509.OID Data.X509.Signed ghc-options: -Wall @@ -54,7 +55,7 @@ , hourglass , asn1-types , x509 - , crypto-pubkey-types + , cryptonite ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures source-repository head