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
|
module OpenSSL.Utils
( failIfNull
, failIfNull_
, failIf
, failIf_
, raiseOpenSSLError
, clearErrorStack
, toHex
, fromHex
, peekCStringCLen
)
where
import Control.Monad
import Foreign.C.String
import Foreign.C.Types
import Foreign.Ptr
import OpenSSL.ERR
import Data.Bits
import Data.List
failIfNull :: Ptr a -> IO (Ptr a)
failIfNull ptr
= if ptr == nullPtr then
raiseOpenSSLError
else
return ptr
failIfNull_ :: Ptr a -> IO ()
failIfNull_ ptr
= failIfNull ptr >> return ()
failIf :: (a -> Bool) -> a -> IO a
failIf f a
| f a = raiseOpenSSLError
| otherwise = return a
failIf_ :: (a -> Bool) -> a -> IO ()
failIf_ f a
= failIf f a >> return ()
raiseOpenSSLError :: IO a
raiseOpenSSLError = getError >>= errorString >>= fail
clearErrorStack :: IO ()
clearErrorStack = do
e <- getError
when (e /= 0) clearErrorStack
-- | Convert an integer to a hex string
toHex :: (Num i, Bits i) => i -> String
toHex = reverse . map hexByte . unfoldr step where
step 0 = Nothing
step i = Just (i .&. 0xf, i `shiftR` 4)
hexByte 0 = '0'
hexByte 1 = '1'
hexByte 2 = '2'
hexByte 3 = '3'
hexByte 4 = '4'
hexByte 5 = '5'
hexByte 6 = '6'
hexByte 7 = '7'
hexByte 8 = '8'
hexByte 9 = '9'
hexByte 10 = 'a'
hexByte 11 = 'b'
hexByte 12 = 'c'
hexByte 13 = 'd'
hexByte 14 = 'e'
hexByte 15 = 'f'
hexByte _ = undefined
-- | Convert a hex string to an integer
fromHex :: (Num i, Bits i) => String -> i
fromHex = foldl step 0 where
step acc hexchar = (acc `shiftL` 4) .|. byteHex hexchar
byteHex '0' = 0
byteHex '1' = 1
byteHex '2' = 2
byteHex '3' = 3
byteHex '4' = 4
byteHex '5' = 5
byteHex '6' = 6
byteHex '7' = 7
byteHex '8' = 8
byteHex '9' = 9
byteHex 'a' = 10
byteHex 'b' = 11
byteHex 'c' = 12
byteHex 'd' = 13
byteHex 'e' = 14
byteHex 'f' = 15
byteHex 'A' = 10
byteHex 'B' = 11
byteHex 'C' = 12
byteHex 'D' = 13
byteHex 'E' = 14
byteHex 'F' = 15
byteHex _ = undefined
peekCStringCLen :: (Ptr CChar, CInt) -> IO String
peekCStringCLen (p, n)
= peekCStringLen (p, fromIntegral n)
|
