More big-num changes.

3 files changed, 58 insertions, 10 deletions

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 74223b2..6667f1a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -1005,9 +1005,7 @@ instance BINARY_CLASS MPI where
         put (MPI i)
                 | i >= 0 = do
                         put (bitl :: Word16)
-                        flip fix (B.length bytes - 1) $ \loop j -> do
-                                put (B.index bytes j)
-                                when (j /= 0) $ loop (j - 1)
+                        putSomeByteString bytes
                 | otherwise = fail $ "MPI is less than 0: " ++ show i
                 where
                 (bytes, bitl)
@@ -1015,16 +1013,15 @@ instance BINARY_CLASS MPI where
                         | otherwise     =
                                 (bytes', (fromIntegral (B.length bytes') - 1) * 8 + sigBit)
 
-                sigBit = fst $ until ((==0) . snd)
-                        (first (+1) . second (`shiftR` 1)) (0,B.last bytes)
-                bytes' = B.unfoldr (\x ->
+                sigBit = fromIntegral $ 8 - countLeadingZeros (B.index bytes 0)
+                bytes' = B.reverse $ B.unfoldr (\x ->
                                 if x == 0 then Nothing else
                                         Just (fromIntegral x, x `shiftR` 8)
                         ) i
         get = do
                 length <- fmap fromIntegral (get :: Get Word16)
                 bytes <- getSomeByteString =<< assertProp (>0) ((length + 7) `div` 8)
-                return $ MPI $ B.foldl (\a b -> (a `shiftL` 8) + fromIntegral b) 0 bytes
+                return $ MPI $ getBigNum (B.toStrict bytes)
 
 listUntilEnd :: (BINARY_CLASS a) => Get [a]
 listUntilEnd = do
diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs
index b2bd506..24330f1 100644
--- a/Data/OpenPGP/Internal.hs
+++ b/Data/OpenPGP/Internal.hs
@@ -1,7 +1,16 @@
+{-# LANGUAGE BangPatterns #-}
 module Data.OpenPGP.Internal where
 
-import Data.Word
-import Data.Bits
+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           System.Endian
+import           System.IO.Unsafe
+
 
 decode_s2k_count :: Word8 -> Word32
 decode_s2k_count c =  (16 + (fromIntegral c .&. 15)) `shiftL`
@@ -18,3 +27,45 @@ encode_s2k_count iterations
         encode_s2k_count' count c
                 | count < 32 = (count, c)
                 | otherwise = encode_s2k_count' (count `shiftR` 1) (c+1)
+
+getBigNum :: BS.ByteString -> Integer
+getBigNum bytes = unsafeDupablePerformIO $
+    let (fptr,offset,len) = BS.toForeignPtr bytes
+    in withForeignPtr fptr $ \ptr -> do
+        let p = ptr `plusPtr` offset :: Ptr Word64
+            e = p `plusPtr` (len .&. complement 7)
+            e2 = e `plusPtr` (len .&. 7)
+            go !p !a
+                | p==e      = return a
+                | otherwise = do
+                    w64 <- fromBE64 <$> peek p
+                    let a' = (a `shiftL` 64) + fromIntegral w64
+                    go (p `plusPtr` 8) a'
+            go2 !p !a
+                | p==e2     = return a
+                | otherwise = do
+                    w8 <- peek p
+                    let a' = a * 256 + fromIntegral w8
+                    go2 (p `plusPtr` 1) a'
+        a <- go p 0
+        go2 (castPtr e :: Ptr Word8) a
+
+{-
+unchunk :: L.ByteString -> BS.ByteString
+unchunk b = L.toStrict $ foldr reappend L.empty $ L.toChunks b
+
+reappend :: BS.ByteString -> BS.ByteString -> Maybe BS.ByteString
+reappend a b =
+    let (ap,ao,al) = BS.toForeignPtr a
+        (bp,bo,bl) = BS.toForeignPtr b
+    in if ap == bp && ao+al == bo
+        then Just $ BS.PS ap ao (al+bl)
+        else Nothing
+
+reconsChunk :: S.ByteString -> L.ByteString -> L.ByteString
+reconsChunk b bs = case L.toChunks bs of
+    (c:cs) -> case reappend b c of
+        Just x  -> L.fromChunks (x:cs)
+        Nothing -> L.fromChunks (b:c:cs)
+    _      -> L.fromChunks [b]
+-}
diff --git a/Data/OpenPGP/Util.hs b/Data/OpenPGP/Util.hs
index 6b1ebb1..1f9277d 100644
--- a/Data/OpenPGP/Util.hs
+++ b/Data/OpenPGP/Util.hs
@@ -1,4 +1,4 @@
-module Data.OpenPGP.Util 
+module Data.OpenPGP.Util
     ( fingerprint
     , decryptSecretKey
     , encryptSecretKey