diff options
author | Joe Crayne <joe@jerkface.net> | 2019-07-03 00:56:26 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2019-07-03 00:56:26 -0400 |
commit | 660d5f111fee62ded78ffb622b063e4818c32928 (patch) | |
tree | b856d4a994fec4078465712cbe0549678a08f72e /Data | |
parent | 72cbb1771ee7a36726eda569ada2a98e00066b86 (diff) |
Optimized big-num serialization.
Diffstat (limited to 'Data')
-rw-r--r-- | Data/OpenPGP.hs | 14 |
1 files changed, 8 insertions, 6 deletions
diff --git a/Data/OpenPGP.hs b/Data/OpenPGP.hs index 0e1150f..74223b2 100644 --- a/Data/OpenPGP.hs +++ b/Data/OpenPGP.hs | |||
@@ -69,6 +69,7 @@ import Numeric | |||
69 | import Control.Monad | 69 | import Control.Monad |
70 | import Control.Arrow | 70 | import Control.Arrow |
71 | import Control.Applicative | 71 | import Control.Applicative |
72 | import Data.Function | ||
72 | import Data.Monoid | 73 | import Data.Monoid |
73 | import Data.Bits | 74 | import Data.Bits |
74 | import Data.Word | 75 | import Data.Word |
@@ -287,7 +288,7 @@ instance BINARY_CLASS Packet where | |||
287 | get = do | 288 | get = do |
288 | tag <- get | 289 | tag <- get |
289 | let (t, l) = | 290 | let (t, l) = |
290 | if (tag .&. 64) /= 0 then | 291 | if testBit tag 6 then |
291 | (tag .&. 63, parse_new_length) | 292 | (tag .&. 63, parse_new_length) |
292 | else | 293 | else |
293 | ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False) | 294 | ((tag `shiftR` 2) .&. 15, (,) <$> parse_old_length tag <*> pure False) |
@@ -1004,7 +1005,9 @@ instance BINARY_CLASS MPI where | |||
1004 | put (MPI i) | 1005 | put (MPI i) |
1005 | | i >= 0 = do | 1006 | | i >= 0 = do |
1006 | put (bitl :: Word16) | 1007 | put (bitl :: Word16) |
1007 | putSomeByteString bytes | 1008 | flip fix (B.length bytes - 1) $ \loop j -> do |
1009 | put (B.index bytes j) | ||
1010 | when (j /= 0) $ loop (j - 1) | ||
1008 | | otherwise = fail $ "MPI is less than 0: " ++ show i | 1011 | | otherwise = fail $ "MPI is less than 0: " ++ show i |
1009 | where | 1012 | where |
1010 | (bytes, bitl) | 1013 | (bytes, bitl) |
@@ -1013,16 +1016,15 @@ instance BINARY_CLASS MPI where | |||
1013 | (bytes', (fromIntegral (B.length bytes') - 1) * 8 + sigBit) | 1016 | (bytes', (fromIntegral (B.length bytes') - 1) * 8 + sigBit) |
1014 | 1017 | ||
1015 | sigBit = fst $ until ((==0) . snd) | 1018 | sigBit = fst $ until ((==0) . snd) |
1016 | (first (+1) . second (`shiftR` 1)) (0,B.index bytes 0) | 1019 | (first (+1) . second (`shiftR` 1)) (0,B.last bytes) |
1017 | bytes' = B.reverse $ B.unfoldr (\x -> | 1020 | bytes' = B.unfoldr (\x -> |
1018 | if x == 0 then Nothing else | 1021 | if x == 0 then Nothing else |
1019 | Just (fromIntegral x, x `shiftR` 8) | 1022 | Just (fromIntegral x, x `shiftR` 8) |
1020 | ) i | 1023 | ) i |
1021 | get = do | 1024 | get = do |
1022 | length <- fmap fromIntegral (get :: Get Word16) | 1025 | length <- fmap fromIntegral (get :: Get Word16) |
1023 | bytes <- getSomeByteString =<< assertProp (>0) ((length + 7) `div` 8) | 1026 | bytes <- getSomeByteString =<< assertProp (>0) ((length + 7) `div` 8) |
1024 | return (MPI (B.foldl (\a b -> | 1027 | return $ MPI $ B.foldl (\a b -> (a `shiftL` 8) + fromIntegral b) 0 bytes |
1025 | a `shiftL` 8 .|. fromIntegral b) 0 bytes)) | ||
1026 | 1028 | ||
1027 | listUntilEnd :: (BINARY_CLASS a) => Get [a] | 1029 | listUntilEnd :: (BINARY_CLASS a) => Get [a] |
1028 | listUntilEnd = do | 1030 | listUntilEnd = do |