summaryrefslogtreecommitdiff
path: root/Data/OpenPGP/Internal.hs
blob: 175a62e1f1de8ea4857a3ae22d69a20b38b8dd68 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
{-# 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           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)

encode_s2k_count :: Word32 -> Word8
encode_s2k_count iterations
	| iterations >= 65011712 = 255
	| decode_s2k_count result < iterations = result+1
	| otherwise = result
	where
	result = fromIntegral $ (fromIntegral c `shiftL` 4) .|. (count - 16)
	(count, c) = encode_s2k_count' (iterations `shiftR` 6) (0::Word8)
	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
-}
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#

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

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 ()