module OpenSSL.Utils
( failIfNull
, failIfNull_
, failIf
, failIf_
, raiseOpenSSLError
, toHex
, fromHex
, peekCStringCLen
)
where
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 :: forall a. Ptr a -> IO (Ptr a)
failIfNull Ptr a
ptr
= if Ptr a
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then
forall a. IO a
raiseOpenSSLError
else
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
ptr
failIfNull_ :: Ptr a -> IO ()
failIfNull_ :: forall a. Ptr a -> IO ()
failIfNull_ Ptr a
ptr
= forall a. Ptr a -> IO (Ptr a)
failIfNull Ptr a
ptr forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
failIf :: (a -> Bool) -> a -> IO a
failIf :: forall a. (a -> Bool) -> a -> IO a
failIf a -> Bool
f a
a
| a -> Bool
f a
a = forall a. IO a
raiseOpenSSLError
| Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return a
a
failIf_ :: (a -> Bool) -> a -> IO ()
failIf_ :: forall a. (a -> Bool) -> a -> IO ()
failIf_ a -> Bool
f a
a
= forall a. (a -> Bool) -> a -> IO a
failIf a -> Bool
f a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
raiseOpenSSLError :: IO a
raiseOpenSSLError :: forall a. IO a
raiseOpenSSLError = IO CULong
getError forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CULong -> IO String
errorString forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadFail m => String -> m a
fail
toHex :: (Num i, Bits i) => i -> String
toHex :: forall i. (Num i, Bits i) => i -> String
toHex = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Eq a, Num a) => a -> Char
hexByte forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall {b}. (Num b, Bits b) => b -> Maybe (b, b)
step where
step :: b -> Maybe (b, b)
step b
0 = forall a. Maybe a
Nothing
step b
i = forall a. a -> Maybe a
Just (b
i forall a. Bits a => a -> a -> a
.&. b
0xf, b
i forall a. Bits a => a -> Int -> a
`shiftR` Int
4)
hexByte :: a -> Char
hexByte a
0 = Char
'0'
hexByte a
1 = Char
'1'
hexByte a
2 = Char
'2'
hexByte a
3 = Char
'3'
hexByte a
4 = Char
'4'
hexByte a
5 = Char
'5'
hexByte a
6 = Char
'6'
hexByte a
7 = Char
'7'
hexByte a
8 = Char
'8'
hexByte a
9 = Char
'9'
hexByte a
10 = Char
'a'
hexByte a
11 = Char
'b'
hexByte a
12 = Char
'c'
hexByte a
13 = Char
'd'
hexByte a
14 = Char
'e'
hexByte a
15 = Char
'f'
hexByte a
_ = forall a. HasCallStack => a
undefined
fromHex :: (Num i, Bits i) => String -> i
fromHex :: forall i. (Num i, Bits i) => String -> i
fromHex = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}. (Bits a, Num a) => a -> Char -> a
step i
0 where
step :: a -> Char -> a
step a
acc Char
hexchar = (a
acc forall a. Bits a => a -> Int -> a
`shiftL` Int
4) forall a. Bits a => a -> a -> a
.|. forall {a}. Num a => Char -> a
byteHex Char
hexchar
byteHex :: Char -> a
byteHex Char
'0' = a
0
byteHex Char
'1' = a
1
byteHex Char
'2' = a
2
byteHex Char
'3' = a
3
byteHex Char
'4' = a
4
byteHex Char
'5' = a
5
byteHex Char
'6' = a
6
byteHex Char
'7' = a
7
byteHex Char
'8' = a
8
byteHex Char
'9' = a
9
byteHex Char
'a' = a
10
byteHex Char
'b' = a
11
byteHex Char
'c' = a
12
byteHex Char
'd' = a
13
byteHex Char
'e' = a
14
byteHex Char
'f' = a
15
byteHex Char
'A' = a
10
byteHex Char
'B' = a
11
byteHex Char
'C' = a
12
byteHex Char
'D' = a
13
byteHex Char
'E' = a
14
byteHex Char
'F' = a
15
byteHex Char
_ = forall a. HasCallStack => a
undefined
peekCStringCLen :: (Ptr CChar, CInt) -> IO String
peekCStringCLen :: (Ptr CChar, CInt) -> IO String
peekCStringCLen (Ptr CChar
p, CInt
n)
= CStringLen -> IO String
peekCStringLen (Ptr CChar
p, forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n)