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 :: Ptr a -> IO (Ptr a)
failIfNull ptr :: Ptr a
ptr
= if Ptr a
ptr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr then
IO (Ptr a)
forall a. IO a
raiseOpenSSLError
else
Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
ptr
failIfNull_ :: Ptr a -> IO ()
failIfNull_ :: Ptr a -> IO ()
failIfNull_ ptr :: Ptr a
ptr
= Ptr a -> IO (Ptr a)
forall a. Ptr a -> IO (Ptr a)
failIfNull Ptr a
ptr IO (Ptr a) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
failIf :: (a -> Bool) -> a -> IO a
failIf :: (a -> Bool) -> a -> IO a
failIf f :: a -> Bool
f a :: a
a
| a -> Bool
f a
a = IO a
forall a. IO a
raiseOpenSSLError
| Bool
otherwise = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
failIf_ :: (a -> Bool) -> a -> IO ()
failIf_ :: (a -> Bool) -> a -> IO ()
failIf_ f :: a -> Bool
f a :: a
a
= (a -> Bool) -> a -> IO a
forall a. (a -> Bool) -> a -> IO a
failIf a -> Bool
f a
a IO a -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
raiseOpenSSLError :: IO a
raiseOpenSSLError :: IO a
raiseOpenSSLError = IO CULong
getError IO CULong -> (CULong -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CULong -> IO String
errorString IO String -> (String -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
toHex :: (Num i, Bits i) => i -> String
toHex :: i -> String
toHex = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (i -> String) -> i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Char) -> [i] -> String
forall a b. (a -> b) -> [a] -> [b]
map i -> Char
forall a. (Eq a, Num a) => a -> Char
hexByte ([i] -> String) -> (i -> [i]) -> i -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (i -> Maybe (i, i)) -> i -> [i]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr i -> Maybe (i, i)
forall b. (Num b, Bits b) => b -> Maybe (b, b)
step where
step :: b -> Maybe (b, b)
step 0 = Maybe (b, b)
forall a. Maybe a
Nothing
step i :: b
i = (b, b) -> Maybe (b, b)
forall a. a -> Maybe a
Just (b
i b -> b -> b
forall a. Bits a => a -> a -> a
.&. 0xf, b
i b -> Int -> b
forall a. Bits a => a -> Int -> a
`shiftR` 4)
hexByte :: a -> Char
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 _ = Char
forall a. HasCallStack => a
undefined
fromHex :: (Num i, Bits i) => String -> i
fromHex :: String -> i
fromHex = (i -> Char -> i) -> i -> String -> i
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl i -> Char -> i
forall a. (Bits a, Num a) => a -> Char -> a
step 0 where
step :: a -> Char -> a
step acc :: a
acc hexchar :: Char
hexchar = (a
acc a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` 4) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Char -> a
forall p. Num p => Char -> p
byteHex Char
hexchar
byteHex :: Char -> p
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 _ = p
forall a. HasCallStack => a
undefined
peekCStringCLen :: (Ptr CChar, CInt) -> IO String
peekCStringCLen :: (Ptr CChar, CInt) -> IO String
peekCStringCLen (p :: Ptr CChar
p, n :: CInt
n)
= CStringLen -> IO String
peekCStringLen (Ptr CChar
p, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
n)