openpgp-crypto-api (empty) → 0.3
raw patch · 16 files changed
+409/−0 lines, 16 filesdep +HUnitdep +QuickCheckdep +basesetup-changedbinary-added
Dependencies added: HUnit, QuickCheck, base, binary, bytestring, cereal, crypto-api, cryptocipher, cryptohash, openpgp, test-framework, test-framework-hunit, test-framework-quickcheck2, utf8-string
Files
- COPYING +13/−0
- Data/OpenPGP/CryptoAPI.hs +238/−0
- README +9/−0
- Setup.hs +3/−0
- openpgp-crypto-api.cabal +77/−0
- tests/data/000001-006.public_key binary
- tests/data/000016-006.public_key binary
- tests/data/000027-006.public_key binary
- tests/data/000035-006.public_key binary
- tests/data/compressedsig-bzip2.gpg binary
- tests/data/compressedsig-zlib.gpg binary
- tests/data/compressedsig.gpg binary
- tests/data/uncompressed-ops-dsa-sha384.txt.gpg binary
- tests/data/uncompressed-ops-dsa.gpg binary
- tests/data/uncompressed-ops-rsa.gpg binary
- tests/suite.hs +69/−0
+ COPYING view
@@ -0,0 +1,13 @@+Copyright © 2012, Stephen Paul Weber <singpolyma.net>++Permission to use, copy, modify, and/or distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ Data/OpenPGP/CryptoAPI.hs view
@@ -0,0 +1,238 @@+module Data.OpenPGP.CryptoAPI (fingerprint, sign, verify) where++import Numeric+import Data.Word+import Data.Char+import Data.Bits+import Data.List (find)+import Data.Binary+import Crypto.Classes hiding (hash,sign,verify)+import Crypto.Random (CryptoRandomGen)+import Crypto.Hash.MD5 (MD5)+import Crypto.Hash.SHA1 (SHA1)+import Crypto.Hash.RIPEMD160 (RIPEMD160)+import Crypto.Hash.SHA256 (SHA256)+import Crypto.Hash.SHA384 (SHA384)+import Crypto.Hash.SHA512 (SHA512)+import Crypto.Hash.SHA224 (SHA224)+import qualified Data.Serialize as Serialize (encode)+import qualified Crypto.Cipher.RSA as RSA+import qualified Crypto.Cipher.DSA as DSA+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LZ+import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString)++import qualified Data.OpenPGP as OpenPGP++-- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket+-- <http://tools.ietf.org/html/rfc4880#section-12.2>+fingerprint :: OpenPGP.Packet -> String+fingerprint p+ | OpenPGP.version p == 4 = snd $ hash OpenPGP.SHA1 material+ | OpenPGP.version p `elem` [2, 3] = snd $ hash OpenPGP.MD5 material+ | otherwise = error "Unsupported Packet version or type in fingerprint"+ where+ material = LZ.concat $ OpenPGP.fingerprint_material p++find_key :: OpenPGP.Message -> String -> Maybe OpenPGP.Packet+find_key = OpenPGP.find_key fingerprint++hash :: OpenPGP.HashAlgorithm -> LZ.ByteString -> (BS.ByteString, String)+hash OpenPGP.MD5 = hash_ (undefined :: MD5)+hash OpenPGP.SHA1 = hash_ (undefined :: SHA1)+hash OpenPGP.RIPEMD160 = hash_ (undefined :: RIPEMD160)+hash OpenPGP.SHA256 = hash_ (undefined :: SHA256)+hash OpenPGP.SHA384 = hash_ (undefined :: SHA384)+hash OpenPGP.SHA512 = hash_ (undefined :: SHA512)+hash OpenPGP.SHA224 = hash_ (undefined :: SHA224)+hash _ = error "Unsupported HashAlgorithm in hash"++hash_ :: (Hash c d) => d -> LZ.ByteString -> (BS.ByteString, String)+hash_ d bs = (hbs, map toUpper $ pad $ hexString $ BS.unpack hbs)+ where+ hbs = Serialize.encode $ hashFunc d bs+ pad s = replicate (len - length s) '0' ++ s+ len = (outputLength `for` d) `div` 8++hexString :: [Word8] -> String+hexString = foldr (pad `oo` showHex) ""+ where+ oo = (.) . (.)+ pad s | odd $ length s = '0':s+ | otherwise = s++-- http://tools.ietf.org/html/rfc3447#page-43+-- http://tools.ietf.org/html/rfc4880#section-5.2.2+emsa_pkcs1_v1_5_hash_padding :: OpenPGP.HashAlgorithm -> BS.ByteString+emsa_pkcs1_v1_5_hash_padding OpenPGP.MD5 = BS.pack [0x30, 0x20, 0x30, 0x0c, 0x06, 0x08, 0x2a, 0x86, 0x48, 0x86, 0xf7, 0x0d, 0x02, 0x05, 0x05, 0x00, 0x04, 0x10]+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA1 = BS.pack [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2b, 0x0e, 0x03, 0x02, 0x1a, 0x05, 0x00, 0x04, 0x14]+emsa_pkcs1_v1_5_hash_padding OpenPGP.RIPEMD160 = BS.pack [0x30, 0x21, 0x30, 0x09, 0x06, 0x05, 0x2B, 0x24, 0x03, 0x02, 0x01, 0x05, 0x00, 0x04, 0x14]+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA256 = BS.pack [0x30, 0x31, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x01, 0x05, 0x00, 0x04, 0x20]+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA384 = BS.pack [0x30, 0x41, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x02, 0x05, 0x00, 0x04, 0x30]+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA512 = BS.pack [0x30, 0x51, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x03, 0x05, 0x00, 0x04, 0x40]+emsa_pkcs1_v1_5_hash_padding OpenPGP.SHA224 = BS.pack [0x30, 0x31, 0x30, 0x0d, 0x06, 0x09, 0x60, 0x86, 0x48, 0x01, 0x65, 0x03, 0x04, 0x02, 0x04, 0x05, 0x00, 0x04, 0x1C]+emsa_pkcs1_v1_5_hash_padding _ =+ error "Unsupported HashAlgorithm in emsa_pkcs1_v1_5_hash_padding."++toStrictBS :: LZ.ByteString -> BS.ByteString+toStrictBS = BS.concat . LZ.toChunks++toLazyBS :: BS.ByteString -> LZ.ByteString+toLazyBS = LZ.fromChunks . (:[])++fromJustMPI :: Maybe OpenPGP.MPI -> Integer+fromJustMPI (Just (OpenPGP.MPI x)) = x+fromJustMPI _ = error "Not a Just MPI, Data.OpenPGP.CryptoAPI"++integerBytesize :: Integer -> Int+integerBytesize i = length (LZ.unpack $ encode (OpenPGP.MPI i)) - 2++keyParam :: Char -> OpenPGP.Packet -> Integer+keyParam c k = fromJustMPI $ lookup c (OpenPGP.key k)++privateRSAkey :: OpenPGP.Packet -> RSA.PrivateKey+privateRSAkey k =+ -- Invert p and q because u is pinv not qinv+ RSA.PrivateKey (integerBytesize n) n d q p+ (d `mod` (q-1))+ (d `mod` (p-1))+ (keyParam 'u' k)+ where+ d = keyParam 'd' k+ p = keyParam 'p' k+ q = keyParam 'q' k+ n = keyParam 'n' k++rsaKey :: OpenPGP.Packet -> RSA.PublicKey+rsaKey k =+ RSA.PublicKey (integerBytesize n) n (keyParam 'e' k)+ where+ n = keyParam 'n' k++privateDSAkey :: OpenPGP.Packet -> DSA.PrivateKey+privateDSAkey k = DSA.PrivateKey+ (keyParam 'p' k, keyParam 'g' k, keyParam 'q' k) (keyParam 'x' k)++dsaKey :: OpenPGP.Packet -> DSA.PublicKey+dsaKey k = DSA.PublicKey+ (keyParam 'p' k, keyParam 'g' k, keyParam 'q' k) (keyParam 'y' k)++-- | Verify a message signature+verify :: OpenPGP.Message -- ^ Keys that may have made the signature+ -> OpenPGP.Message -- ^ LiteralData message to verify+ -> Int -- ^ Index of signature to verify (0th, 1st, etc)+ -> Bool+verify keys message sigidx =+ case OpenPGP.key_algorithm sig of+ OpenPGP.DSA -> dsaVerify+ alg | alg `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> rsaVerify+ | otherwise -> error ("Unsupported key algorithm " ++ show alg)+ where+ dsaVerify = let k' = dsaKey k in+ case DSA.verify dsaSig (dsaTruncate k' . bhash) k' signature_over of+ Left _ -> False+ Right v -> v+ rsaVerify =+ case RSA.verify bhash padding (rsaKey k) signature_over rsaSig of+ Left _ -> False+ Right v -> v+ rsaSig = toStrictBS $ LZ.drop 2 $ encode (head $ OpenPGP.signature sig)+ dsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in+ (r, s)+ dsaTruncate (DSA.PublicKey (_,_,q) _) = BS.take (integerBytesize q)+ bhash = fst . hash hash_algo . toLazyBS+ padding = emsa_pkcs1_v1_5_hash_padding hash_algo+ hash_algo = OpenPGP.hash_algorithm sig+ signature_over = toStrictBS $ dta `LZ.append` OpenPGP.trailer sig+ Just k = OpenPGP.signature_issuer sig >>= find_key keys+ sig = sigs !! sigidx+ (sigs, (OpenPGP.LiteralDataPacket {OpenPGP.content = dta}):_) =+ OpenPGP.signatures_and_data message++-- | Sign data or key/userID pair.+sign :: (CryptoRandomGen g) =>+ OpenPGP.Message -- ^ SecretKeys, one of which will be used+ -> OpenPGP.Message -- ^ Message containing data or key to sign, and optional signature packet+ -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature+ -> String -- ^ KeyID of key to choose or @[]@ for first+ -> Integer -- ^ Timestamp for signature (unless sig supplied)+ -> g -- ^ Random number generator+ -> OpenPGP.Packet+sign keys message hsh keyid timestamp g =+ -- WARNING: this style of update is unsafe on most fields+ -- it is safe on signature and hash_head, though+ sig {+ OpenPGP.signature = map OpenPGP.MPI final,+ OpenPGP.hash_head = 0 -- TODO+ }+ where+ final = case OpenPGP.key_algorithm sig of+ OpenPGP.DSA -> [dsaR, dsaS]+ kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> [toNum rsaFinal]+ | otherwise ->+ error ("Unsupported key algorithm " ++ show kalgo ++ "in sign")+ Right ((dsaR,dsaS),_) = let k' = privateDSAkey k in+ DSA.sign g (dsaTruncate k' . bhash) k' dta+ Right rsaFinal = RSA.sign bhash padding (privateRSAkey k) dta+ dsaTruncate (DSA.PrivateKey (_,_,q) _) = BS.take (integerBytesize q)+ dta = toStrictBS $ case signOver of {+ OpenPGP.LiteralDataPacket {OpenPGP.content = c} -> c;+ _ -> LZ.concat $ OpenPGP.fingerprint_material signOver ++ [+ LZ.singleton 0xB4,+ encode (fromIntegral (length firstUserID) :: Word32),+ LZ.fromString firstUserID+ ]+ } `LZ.append` OpenPGP.trailer sig+ sig = findSigOrDefault (find OpenPGP.isSignaturePacket m)+ padding = emsa_pkcs1_v1_5_hash_padding hsh+ bhash = fst . hash hsh . toLazyBS+ toNum = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0++ -- Either a SignaturePacket was found, or we need to make one+ findSigOrDefault (Just s) =+ OpenPGP.signaturePacket+ (OpenPGP.version s)+ (OpenPGP.signature_type s)+ (OpenPGP.key_algorithm k) -- force to algo of key+ hsh -- force hash algorithm+ (OpenPGP.hashed_subpackets s)+ (OpenPGP.unhashed_subpackets s)+ (OpenPGP.hash_head s)+ (OpenPGP.signature s)+ findSigOrDefault Nothing = OpenPGP.signaturePacket+ 4+ defaultStype+ (OpenPGP.key_algorithm k) -- force to algo of key+ hsh+ ([+ -- Do we really need to pass in timestamp just for the default?+ OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,+ OpenPGP.IssuerPacket keyid'+ ] ++ (case signOver of+ OpenPGP.LiteralDataPacket {} -> []+ _ -> [] -- TODO: OpenPGP.KeyFlagsPacket [0x01, 0x02]+ ))+ []+ undefined+ undefined++ keyid' = reverse $ take 16 $ reverse $ fingerprint k+ Just k = find_key keys keyid++ Just (OpenPGP.UserIDPacket firstUserID) = find isUserID m++ defaultStype = case signOver of+ OpenPGP.LiteralDataPacket {OpenPGP.format = f} ->+ if f == 'b' then 0x00 else 0x01+ _ -> 0x13++ Just signOver = find isSignable m+ OpenPGP.Message m = message++ isSignable (OpenPGP.LiteralDataPacket {}) = True+ isSignable (OpenPGP.PublicKeyPacket {}) = True+ isSignable (OpenPGP.SecretKeyPacket {}) = True+ isSignable _ = False++ isUserID (OpenPGP.UserIDPacket {}) = True+ isUserID _ = False
+ README view
@@ -0,0 +1,9 @@+This is a wrapper around <http://hackage.haskell.org/package/crypto-api>+and related libraries that currently does fingerprint generation, signature+generation, and signature verification (for RSA and DSA keys).++It is indended to be used with <http://hackage.haskell.org/openpgp>++It is intended that you use qualified imports with this library.++> import qualified Data.OpenPGP.CryptoAPI as OpenPGP
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ openpgp-crypto-api.cabal view
@@ -0,0 +1,77 @@+name: openpgp-crypto-api+version: 0.3+cabal-version: >= 1.8+license: OtherLicense+license-file: COPYING+category: Cryptography+copyright: © 2012 Stephen Paul Weber+author: Stephen Paul Weber <singpolyma@singpolyma.net>+maintainer: Stephen Paul Weber <singpolyma@singpolyma.net>+stability: experimental+tested-with: GHC == 7.0.3+synopsis: Implement cryptography for OpenPGP using crypto-api compatible libraries+homepage: http://github.com/singpolyma/OpenPGP-CryptoAPI+bug-reports: http://github.com/singpolyma/OpenPGP-Haskell/issues+build-type: Simple+description:+ This is a wrapper around <http://hackage.haskell.org/package/crypto-api>+ and related libraries that currently does fingerprint generation, signature+ generation, and signature verification (for RSA and DSA keys).+ .+ It is indended to be used with <http://hackage.haskell.org/openpgp>+ .+ It is intended that you use qualified imports with this library.+ .+ > import qualified Data.OpenPGP.CryptoAPI as OpenPGP++extra-source-files:+ README,+ tests/suite.hs,+ tests/data/000001-006.public_key,+ tests/data/000016-006.public_key,+ tests/data/000027-006.public_key,+ tests/data/000035-006.public_key,+ tests/data/uncompressed-ops-dsa.gpg+ tests/data/uncompressed-ops-dsa-sha384.txt.gpg+ tests/data/uncompressed-ops-rsa.gpg+ tests/data/compressedsig.gpg+ tests/data/compressedsig-zlib.gpg+ tests/data/compressedsig-bzip2.gpg++library+ exposed-modules:+ Data.OpenPGP.CryptoAPI++ build-depends:+ base == 4.*,+ bytestring,+ utf8-string,+ binary,+ openpgp,+ crypto-api,+ cryptocipher,+ cryptohash,+ cereal++test-suite tests+ type: exitcode-stdio-1.0+ main-is: tests/suite.hs++ build-depends:+ base == 4.*,+ bytestring,+ utf8-string,+ binary,+ openpgp,+ crypto-api >= 0.9,+ cryptocipher,+ cryptohash,+ HUnit,+ QuickCheck >= 2.4.1.1,+ test-framework,+ test-framework-hunit,+ test-framework-quickcheck2++source-repository head+ type: git+ location: git://github.com/singpolyma/OpenPGP-CryptoAPI.git
+ tests/data/000001-006.public_key view
binary file changed (absent → 171 bytes)
+ tests/data/000016-006.public_key view
binary file changed (absent → 1201 bytes)
+ tests/data/000027-006.public_key view
binary file changed (absent → 421 bytes)
+ tests/data/000035-006.public_key view
binary file changed (absent → 143 bytes)
+ tests/data/compressedsig-bzip2.gpg view
binary file changed (absent → 442 bytes)
+ tests/data/compressedsig-zlib.gpg view
binary file changed (absent → 322 bytes)
+ tests/data/compressedsig.gpg view
binary file changed (absent → 324 bytes)
+ tests/data/uncompressed-ops-dsa-sha384.txt.gpg view
binary file changed (absent → 150 bytes)
+ tests/data/uncompressed-ops-dsa.gpg view
binary file changed (absent → 150 bytes)
+ tests/data/uncompressed-ops-rsa.gpg view
binary file changed (absent → 236 bytes)
+ tests/suite.hs view
@@ -0,0 +1,69 @@+import Test.Framework (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2+import Test.QuickCheck+import Test.HUnit hiding (Test)++import Crypto.Random+import Data.Binary+import qualified Data.OpenPGP as OpenPGP+import qualified Data.OpenPGP.CryptoAPI as OpenPGP+import qualified Data.ByteString.Lazy as LZ+import qualified Data.ByteString.Lazy.UTF8 as LZ (fromString)++instance Arbitrary OpenPGP.HashAlgorithm where+ arbitrary = elements [OpenPGP.MD5, OpenPGP.SHA1, OpenPGP.RIPEMD160, OpenPGP.SHA256, OpenPGP.SHA384, OpenPGP.SHA512, OpenPGP.SHA224]++testFingerprint :: FilePath -> String -> Assertion+testFingerprint fp kf = do+ bs <- LZ.readFile $ "tests/data/" ++ fp+ let (OpenPGP.Message [packet]) = decode bs+ assertEqual ("for " ++ fp) kf (OpenPGP.fingerprint packet)++testVerifyMessage :: FilePath -> FilePath -> Assertion+testVerifyMessage keyring message = do+ keys <- fmap decode $ LZ.readFile $ "tests/data/" ++ keyring+ m <- fmap decode $ LZ.readFile $ "tests/data/" ++ message+ let verification = OpenPGP.verify keys m 0+ assertEqual (keyring ++ " for " ++ message) True verification++prop_sign_and_verify :: (CryptoRandomGen g) => OpenPGP.Message -> g -> OpenPGP.HashAlgorithm -> String -> String -> Gen Bool+prop_sign_and_verify secring g halgo filename msg = do+ keyid <- elements ["FEF8AFA0F661C3EE","7F69FA376B020509"]+ let m = OpenPGP.LiteralDataPacket {+ OpenPGP.format = 'u',+ OpenPGP.filename = filename,+ OpenPGP.timestamp = 12341234,+ OpenPGP.content = LZ.fromString msg+ }+ let sig = OpenPGP.sign secring (OpenPGP.Message [m])+ halgo keyid 12341234 g+ return $ OpenPGP.verify secring (OpenPGP.Message [sig,m]) 0++tests :: (CryptoRandomGen g) => OpenPGP.Message -> g -> [Test]+tests secring rng =+ [+ testGroup "Fingerprint" [+ testCase "000001-006.public_key" (testFingerprint "000001-006.public_key" "421F28FEAAD222F856C8FFD5D4D54EA16F87040E"),+ testCase "000016-006.public_key" (testFingerprint "000016-006.public_key" "AF95E4D7BAC521EE9740BED75E9F1523413262DC"),+ testCase "000027-006.public_key" (testFingerprint "000027-006.public_key" "1EB20B2F5A5CC3BEAFD6E5CB7732CF988A63EA86"),+ testCase "000035-006.public_key" (testFingerprint "000035-006.public_key" "CB7933459F59C70DF1C3FBEEDEDC3ECF689AF56D")+ ],+ testGroup "Message verification" [+ testCase "uncompressed-ops-dsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa.gpg"),+ testCase "uncompressed-ops-dsa-sha384" (testVerifyMessage "pubring.gpg" "uncompressed-ops-dsa-sha384.txt.gpg"),+ testCase "uncompressed-ops-rsa" (testVerifyMessage "pubring.gpg" "uncompressed-ops-rsa.gpg"),+ testCase "compressedsig" (testVerifyMessage "pubring.gpg" "compressedsig.gpg"),+ testCase "compressedsig-zlib" (testVerifyMessage "pubring.gpg" "compressedsig-zlib.gpg"),+ testCase "compressedsig-bzip2" (testVerifyMessage "pubring.gpg" "compressedsig-bzip2.gpg")+ ],+ testGroup "Signing" [+ testProperty "Crypto signatures verify" (prop_sign_and_verify secring rng)+ ]+ ]++main :: IO ()+main = do+ rng <- newGenIO :: IO SystemRandom+ secring <- fmap decode $ LZ.readFile "tests/data/secring.gpg"+ defaultMain (tests secring rng)