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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
{-# 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 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
decode_s2k_count :: Word8 -> Word32
decode_s2k_count c = shiftL (16 + (fromIntegral c .&. 15))
((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
-- big-endian
integerToBS :: Integer -> BS.ByteString
integerToBS i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do
let Ptr addr = ptr
cnt <- exportIntegerToAddr i addr 1# -- 1# for big-endian (use 0# for little-endian)
return ()
getBigNumLE :: BS.ByteString -> Integer
getBigNumLE 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) 0#
-- little-endian
integerToLE :: Integer -> BS.ByteString
integerToLE i = BS.unsafeCreate (I# (word2Int# (sizeInBaseInteger i 256#))) $ \ptr -> do
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
|
