From eba3661ee3007c5e9e5444020b38333ef60fb88b Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Wed, 3 Jul 2019 04:42:43 -0400
Subject: Big-num optimization.

---
 Data/OpenPGP.hs          | 13 ++-----------
 Data/OpenPGP/Internal.hs | 48 +++++++++++++++++++++++++++---------------------
 openpgp-util.cabal       |  3 ++-
 3 files changed, 31 insertions(+), 33 deletions(-)

diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs
index 6667f1a..8fef50a 100644
--- a/Data/OpenPGP.hs
+++ b/Data/OpenPGP.hs
@@ -1005,19 +1005,10 @@ instance BINARY_CLASS MPI where
 	put (MPI i)
 		| i >= 0 = do
 			put (bitl :: Word16)
-			putSomeByteString bytes
+			putSomeByteString $ B.fromStrict bytes
 		| otherwise = fail $ "MPI is less than 0: " ++ show i
 		where
-		(bytes, bitl)
-			| B.null bytes' = (B.singleton 0, 1)
-			| otherwise     =
-				(bytes', (fromIntegral (B.length bytes') - 1) * 8 + sigBit)
-
-		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
+		(bitl, bytes) = putBigNum i
 	get = do
 		length <- fmap fromIntegral (get :: Get Word16)
 		bytes <- getSomeByteString =<< assertProp (>0) ((length + 7) `div` 8)
diff --git a/Data/OpenPGP/Internal.hs b/Data/OpenPGP/Internal.hs
index 24330f1..175a62e 100644
--- a/Data/OpenPGP/Internal.hs
+++ b/Data/OpenPGP/Internal.hs
@@ -1,17 +1,20 @@
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns, MagicHash #-}
 module Data.OpenPGP.Internal where
 
 import           Data.Bits
-import qualified Data.ByteString          as BS
-import qualified Data.ByteString.Internal as BS
+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
 
 
+
 decode_s2k_count :: Word8 -> Word32
 decode_s2k_count c =  (16 + (fromIntegral c .&. 15)) `shiftL`
 	((fromIntegral c `shiftR` 4) + 6)
@@ -28,6 +31,7 @@ encode_s2k_count iterations
 		| 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
@@ -49,23 +53,25 @@ getBigNum bytes = unsafeDupablePerformIO $
                     go2 (p `plusPtr` 1) a'
         a <- go p 0
         go2 (castPtr e :: Ptr Word8) a
+-}
+getBigNum :: BS.ByteString -> Integer
+getBigNum bytes = unsafeDupablePerformIO $
+    let (fptr,offset,len) = BS.toForeignPtr bytes
+    in withForeignPtr fptr $ \ptr -> do
+        let Ptr addr = ptr `plusPtr` offset :: Ptr Word64
+            I# n = len
+        importIntegerFromAddr addr (int2Word# n) 1#
 
-{-
-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
+putBigNum :: Integer -> (Word16, BS.ByteString)
+putBigNum 0 = (1,BS.singleton 0)
+putBigNum i = ( (fromIntegral (BS.length bytes) - 1) * 8 + sigBit
+            , bytes )
+ where
+    sigBit = fromIntegral $ 8 - countLeadingZeros (BS.index bytes 0)
+    bytes = integerToBS i
 
-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]
--}
+integerToBS :: Integer -> BS.ByteString
+integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do
+        let Ptr addr = ptr
+        cnt <- exportIntegerToAddr i addr 1#
+        return ()
diff --git a/openpgp-util.cabal b/openpgp-util.cabal
index 28513ad..33b5ff6 100644
--- a/openpgp-util.cabal
+++ b/openpgp-util.cabal
@@ -148,7 +148,8 @@ library
                 cpu ==0.1.*,
                 vector >=0.9,
                 tagged >=0.4.2.1,
-                cereal >=0.3.0
+                cereal >=0.3.0,
+                integer-gmp
 
         if flag(cryptonite)
           build-depends:
-- 
cgit v1.2.3