Refactor toward draft-ietf-openpgp-rfc4880bis-09.

9 files changed, 89 insertions, 65 deletions

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 4133f38..f05f83e 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -129,9 +129,6 @@ compress algo = toStrictBS . lazyCompress algo . toLazyBS
 decompress :: CompressionAlgorithm -> B.ByteString -> B.ByteString
 decompress algo = toStrictBS . lazyDecompress algo . toLazyBS
 
-toStrictBS :: LZ.ByteString -> B.ByteString
-toStrictBS = B.concat . LZ.toChunks
-
 toLazyBS :: B.ByteString -> LZ.ByteString
 toLazyBS = LZ.fromChunks . (:[])
 
@@ -194,10 +191,6 @@ pad l s = replicate (l - length s) '0' ++ s
 padBS :: Int -> B.ByteString -> B.ByteString
 padBS l s = B.replicate (fromIntegral l - B.length s) 0 `B.append` s
 
-checksum :: B.ByteString -> Word16
-checksum = fromIntegral .
-        B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer)
-
 data Packet =
         AsymmetricSessionKeyPacket {
                 version        :: Word8,
diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs
index a4cdc10..a62923a 100644
--- a/Data/OpenPGP/Internal.hs
+++ b/Data/OpenPGP/Internal.hs
@@ -1,17 +1,47 @@
-{-# LANGUAGE BangPatterns, MagicHash #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP          #-}
+{-# LANGUAGE MagicHash    #-}
 module Data.OpenPGP.Internal where
 
-import           Data.Bits
-import qualified Data.ByteString           as BS
-import qualified Data.ByteString.Internal  as BS
-import           Data.Word
-import           Foreign.ForeignPtr
-import           Foreign.Ptr
-import           Foreign.Storable
-import           GHC.Exts
-import           GHC.Integer.GMP.Internals
-import           System.Endian
-import           System.IO.Unsafe
+import Data.Bits
+import qualified Data.ByteString          as BS
+import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString.Lazy     as BL
+import Data.Char
+import Data.Int
+import Data.Word
+import Foreign.ForeignPtr
+import Foreign.Ptr
+import Foreign.Storable
+import GHC.Exts
+import GHC.Integer.GMP.Internals
+import System.Endian
+import System.IO.Unsafe
+import Numeric (showHex)
+
+#if defined(VERSION_cryptonite)
+import qualified Data.ByteArray as Bytes
+import Crypto.Hash.Algorithms
+import Crypto.Hash
+import Crypto.Error
+#else
+import qualified Data.Byteable as Vincent
+import Crypto.Hash.SHA1 as SHA1
+#endif
+
+#ifdef CEREAL
+import qualified Data.ByteString      as B
+import qualified Data.ByteString.UTF8 as B (fromString, toString)
+import Data.Serialize
+#define BINARY_CLASS Serialize
+#else
+import Data.Binary
+import Data.Binary.Get
+import Data.Binary.Put
+import qualified Data.ByteString.Lazy      as B
+import qualified Data.ByteString.Lazy.UTF8 as B (fromString, toString)
+#define BINARY_CLASS Binary
+#endif
 
 
 
@@ -91,3 +121,35 @@ integerToLE i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \p
         let Ptr addr = ptr
         cnt <- exportIntegerToAddr i addr 0#
         return ()
+
+toStrictBS :: B.ByteString -> BS.ByteString
+toStrictBS = BS.concat . B.toChunks
+
+checksum :: B.ByteString -> Word16
+checksum = fromIntegral .
+        B.foldl (\c i -> (c + fromIntegral i) `mod` 65536) (0::Integer)
+
+
+checksumForKey :: Word8 {- s2k_usage byte -} -> (Int64, B.ByteString -> BS.ByteString)
+checksumForKey 254 = (20, sha1 . toStrictBS)
+ where
+#if defined(VERSION_cryptonite)
+    sha1 x = Bytes.convert (hash x :: Digest SHA1)
+#else
+    sha1 = SHA1.hash
+#endif
+checksumForKey _   = (2, toStrictBS . encode . checksum)
+                    -- Words16s are written as 2 bytes in big-endian (network) order
+
+hexString :: [Word8] -> String
+hexString = foldr (pad `oo` showHex) ""
+        where
+        pad s | odd $ length s = '0':s
+              | otherwise = s
+
+        oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c
+        oo = (.) . (.)
+
+hexify :: BS.ByteString -> String
+hexify = map toUpper . hexString . BS.unpack
+
diff --git a/Data/OpenPGP/Util/Base.hs b/Data/OpenPGP/Util/Base.hs
index b43427c..431c12c 100644
--- a/Data/OpenPGP/Util/Base.hs
+++ b/Data/OpenPGP/Util/Base.hs
@@ -76,9 +76,6 @@ ecdsaKey k = Vincent.ECDSA.PublicKey curve (Vincent.ECDSA.Point x y)
     curve = curveFromOID (keyParam 'c' k)
 
 
-toStrictBS :: LZ.ByteString -> BS.ByteString
-toStrictBS = BS.concat . LZ.toChunks
-
 toLazyBS :: BS.ByteString -> LZ.ByteString
 toLazyBS = LZ.fromChunks . (:[])
 
diff --git a/Data/OpenPGP/Util/Cv25519.hs b/Data/OpenPGP/Util/Cv25519.hs
index abf1ba6..bc1cacb 100644
--- a/Data/OpenPGP/Util/Cv25519.hs
+++ b/Data/OpenPGP/Util/Cv25519.hs
@@ -67,19 +67,6 @@ privateCv25519Key k@SecretKeyPacket { key_algorithm = ECC, symmetric_algorithm =
         CryptoPassed cv25519sec -> Just cv25519sec
         CryptoFailed err        -> Nothing
 
-hexify = map toUpper . hexString . BS.unpack
-
-
-
-hexString :: [Word8] -> String
-hexString = foldr (pad `oo` showHex) ""
-        where
-        pad s | odd $ length s = '0':s
-              | otherwise = s
-
-        oo :: (b -> c) -> (a -> a1 -> b) -> a -> a1 -> c
-        oo = (.) . (.)
-
 cv25519Key :: [(Char,MPI)] -> Maybe Cv25519.PublicKey
 cv25519Key k = do
     MPI flag <- lookup 'f' k
diff --git a/Data/OpenPGP/Util/Decrypt.hs b/Data/OpenPGP/Util/Decrypt.hs
index 84bead5..637d754 100644
--- a/Data/OpenPGP/Util/Decrypt.hs
+++ b/Data/OpenPGP/Util/Decrypt.hs
@@ -14,7 +14,7 @@ import Data.OpenPGP.Util.Base
 
 -- decryption codec for withS2K
 simpleUnCFB :: (Vincent.BlockCipher k) => k -> Vincent.IV k -> LZ.ByteString -> LZ.ByteString
-simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . toStrictBS)
+simpleUnCFB k iv = padThenUnpad k (toLazyBS . Vincent.cfbDecrypt k iv . LZ.toStrict)
 
 withS2K' :: OpenPGP.SymmetricAlgorithm -> Maybe OpenPGP.S2K -> LZ.ByteString
             -> (forall b. Vincent.BlockCipher b => b -> x) -> x
@@ -29,7 +29,7 @@ string2key ms2k s = cipher
     where
 #if defined(VERSION_cryptonite)
     CryptoPassed cipher = Vincent.cipherInit k
-    k = toStrictBS $ LZ.take ksize $ maybe s (\s2k -> OpenPGP.string2key hashBySymbol s2k s) ms2k
+    k = LZ.toStrict $ LZ.take ksize $ maybe s (\s2k -> OpenPGP.string2key hashBySymbol s2k s) ms2k
 #else
     cipher = Vincent.cipherInit k
     Right k = Vincent.makeKey $ toStrictBS $
diff --git a/Data/OpenPGP/Util/DecryptSecretKey.hs b/Data/OpenPGP/Util/DecryptSecretKey.hs
index 57dd8c3..9f9e42a 100644
--- a/Data/OpenPGP/Util/DecryptSecretKey.hs
+++ b/Data/OpenPGP/Util/DecryptSecretKey.hs
@@ -4,10 +4,11 @@
 module Data.OpenPGP.Util.DecryptSecretKey where
 
 import qualified Data.OpenPGP as OpenPGP
-import Data.OpenPGP.Internal (decode_s2k_count)
+import Data.OpenPGP.Internal (decode_s2k_count,checksumForKey)
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LZ
-import Data.Word (Word16)
+import Data.Word
+import Data.Int
 import Data.Maybe
 import Control.Monad (foldM)
 import Data.Binary (get,Binary,Get,encode,put)
@@ -53,7 +54,7 @@ data Enciphered =
 withIV :: forall k. (Vincent.BlockCipher k) => (Vincent.IV k -> LZ.ByteString -> LZ.ByteString) -> Enciphered -> LZ.ByteString
 withIV f (EncipheredWithIV s) = f iv bs
     where
-    Just iv = Vincent.makeIV (toStrictBS ivbs)
+    Just iv = Vincent.makeIV (LZ.toStrict ivbs)
     (ivbs,bs) = LZ.splitAt (fromIntegral ivlen) s
 #if defined(VERSION_cryptonite)
     ivlen = Bytes.length (Vincent.nullIV :: Vincent.IV k)
@@ -64,6 +65,7 @@ withIV f (EncipheredWithIV s) = f iv bs
 #endif
 withIV f (EncipheredZeroIV s) = f Vincent.nullIV s
 
+
 decryptSecretKey ::
     BS.ByteString           -- ^ Passphrase
     -> OpenPGP.Packet       -- ^ Encrypted SecretKeyPacket
@@ -74,7 +76,7 @@ decryptSecretKey pass k@(OpenPGP.SecretKeyPacket {
         OpenPGP.version = 4, OpenPGP.key_algorithm = kalgo,
         OpenPGP.s2k = s2k, OpenPGP.symmetric_algorithm = salgo,
         OpenPGP.key = existing, OpenPGP.encrypted_data = encd
-    }) | chkF material == toStrictBS chk =
+    }) | chkF material == LZ.toStrict chk =
         fmap (\m -> k {
             OpenPGP.s2k_useage = 0,
             OpenPGP.symmetric_algorithm = OpenPGP.Unencrypted,
@@ -87,18 +89,9 @@ decryptSecretKey pass k@(OpenPGP.SecretKeyPacket {
         (foldM (\m f -> do {mpi <- get; return $ (f,mpi):m}) existing
         (OpenPGP.secret_key_fields kalgo)) material
     (material, chk) = LZ.splitAt (LZ.length decd - chkSize) decd
-    (chkSize, chkF)
-        | OpenPGP.s2k_useage k == 254 = (20, sha1 . toStrictBS)
-        | otherwise = (2, toStrictBS . encode . checksum . toStrictBS)
-        -- Words16s are written as 2 bytes in big-endian (network) order
+    (chkSize, chkF) = checksumForKey (OpenPGP.s2k_useage k)
     decd = withS2K simpleUnCFB salgo (Just s2k) (toLazyBS pass) (EncipheredWithIV encd)
 
-#if defined(VERSION_cryptonite)
-    sha1 x = Bytes.convert (hash x :: Digest SHA1)
-#else
-    sha1 = SHA1.hash
-#endif
-
 decryptSecretKey _ _ = Nothing
 
 checksum :: BS.ByteString -> Word16
@@ -133,7 +126,7 @@ withS2K codec OpenPGP.CAST5 s2k s    = withIV $ codec (string2key s2k s :: Thoma
 withS2K codec algo _ _ = error $ "Unsupported symmetric algorithm : " ++ show algo ++ " in Data.OpenPGP.CryptoAPI.withS2K"
 
 simpleCFB :: forall k g. (Vincent.BlockCipher k, RG g) => g -> k -> LZ.ByteString -> (LZ.ByteString, g)
-simpleCFB g k bs = ( padThenUnpad k (LZ.fromChunks . (ivbs:) . (:[]) . Vincent.cfbEncrypt k iv . toStrictBS) bs
+simpleCFB g k bs = ( padThenUnpad k (LZ.fromChunks . (ivbs:) . (:[]) . Vincent.cfbEncrypt k iv . LZ.toStrict) bs
                    , g' )
  where
     Just iv = Vincent.makeIV ivbs
@@ -180,7 +173,7 @@ encryptSecretKey passphrase s2k salgo plain = do
     -- two-octet checksum is required.
     s2k_usage_octet = 255
     -- chkSize = 2
-    chkF = toStrictBS . encode . checksum . toStrictBS
+    chkF = LZ.toStrict . encode . checksum . LZ.toStrict
 
 
     -- k = string2key s2k passphrase -- OpenPGP.string2key hashBySymbol s2k passphrase
diff --git a/Data/OpenPGP/Util/Fingerprint.hs b/Data/OpenPGP/Util/Fingerprint.hs
index cda25f6..955748d 100644
--- a/Data/OpenPGP/Util/Fingerprint.hs
+++ b/Data/OpenPGP/Util/Fingerprint.hs
@@ -2,6 +2,7 @@
 module Data.OpenPGP.Util.Fingerprint (fingerprint,fingerprintv,Fingerprint(..),hex) where
 
 import qualified Data.OpenPGP as OpenPGP
+import Data.OpenPGP.Internal
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LZ
 import Data.Char (toUpper)
@@ -28,15 +29,6 @@ instance Show Fingerprint where
 
 hex :: Fingerprint -> String
 hex (Fingerprint bs) = hexify bs
-  where
-    hexify = map toUpper . hexString . BS.unpack
-
-    hexString :: [Word8] -> String
-    hexString = foldr (pad `oo` showHex) ""
-        where
-        pad s | odd $ length s = '0':s
-              | otherwise = s
-
 
 -- | Generate a key fingerprint from a PublicKeyPacket or SecretKeyPacket
 -- <http://tools.ietf.org/html/rfc4880#section-12.2>
diff --git a/Data/OpenPGP/Util/Sign.hs b/Data/OpenPGP/Util/Sign.hs
index b9c6435..a074dcb 100644
--- a/Data/OpenPGP/Util/Sign.hs
+++ b/Data/OpenPGP/Util/Sign.hs
@@ -113,7 +113,7 @@ unsafeSign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [s
     (Right rsaFinal,_) = Vincent.RSA.signSafer g desc (privateRSAkey k) dta
 #endif
     dsaTruncate (Vincent.DSA.PrivateKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q)
-    dta     = toStrictBS $ encode over `LZ.append` OpenPGP.trailer sig
+    dta     = LZ.toStrict $ encode over `LZ.append` OpenPGP.trailer sig
     sig     = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over)
     -- padding = emsa_pkcs1_v1_5_hash_padding hsh
     desc = hashAlgoDesc hsh
diff --git a/Data/OpenPGP/Util/Verify.hs b/Data/OpenPGP/Util/Verify.hs
index 66db2ab..52e9005 100644
--- a/Data/OpenPGP/Util/Verify.hs
+++ b/Data/OpenPGP/Util/Verify.hs
@@ -46,7 +46,7 @@ verify keys over =
     over {OpenPGP.signatures_over = mapMaybe (uncurry $ verifyOne keys) sigs}
     where
     sigs :: [(OpenPGP.Packet,BS.ByteString)]
-    sigs = map (\s -> (s, toStrictBS $ encode over `LZ.append` OpenPGP.trailer s))
+    sigs = map (\s -> (s, LZ.toStrict $ encode over `LZ.append` OpenPGP.trailer s))
         (OpenPGP.signatures_over over)
 
 verifyOne :: OpenPGP.Message -> OpenPGP.Packet -> BS.ByteString -> Maybe OpenPGP.Packet
@@ -93,7 +93,7 @@ verifyOne keys sig over = fmap (const sig) $ maybeKey >>= verification >>= guard
 #else
     rsaVerify k = Just $ Vincent.RSA.verify desc (rsaKey k) over rsaSig
 #endif
-    [rsaSig] = map (toStrictBS . LZ.drop 2 . encode) (OpenPGP.signature sig)
+    [rsaSig] = map (LZ.toStrict . LZ.drop 2 . encode) (OpenPGP.signature sig)
     dsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in
         Vincent.DSA.Signature r s
     ecdsaSig = let [OpenPGP.MPI r, OpenPGP.MPI s] = OpenPGP.signature sig in