module Network.Protocol.SASL.GNU
(
headerVersion
, libraryVersion
, checkVersion
, SASL
, runSASL
, setCallback
, runCallback
, Mechanism (..)
, clientMechanisms
, clientSupports
, clientSuggestMechanism
, serverMechanisms
, serverSupports
, Session
, runClient
, runServer
, mechanismName
, Property (..)
, setProperty
, getProperty
, getPropertyFast
, Progress (..)
, step
, step64
, encode
, decode
, Error (..)
, catch
, handle
, try
, throw
, toBase64
, fromBase64
, md5
, sha1
, hmacMD5
, hmacSHA1
, nonce
, random
) where
import Prelude hiding (catch)
import Data.Maybe (fromMaybe)
import Control.Applicative (Applicative, pure, (<*>), (<$>))
import qualified Control.Exception as E
import Control.Monad (ap, when, unless, (<=<))
import Control.Monad.Loops (unfoldrM)
import Control.Monad.IO.Class (MonadIO, liftIO)
import qualified Control.Monad.Trans.Reader as R
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as B
import qualified Data.ByteString.Char8 as Char8
import Data.Char (isDigit)
import Data.String (IsString, fromString)
import qualified Foreign as F
import qualified Foreign.C as F
import System.IO.Unsafe (unsafePerformIO)
import qualified Text.ParserCombinators.ReadP as P
headerVersion :: (Integer, Integer, Integer)
= (Integer
major, Integer
minor, Integer
patch) where
major :: Integer
major = CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
hsgsasl_VERSION_MAJOR
minor :: Integer
minor = CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
hsgsasl_VERSION_MINOR
patch :: Integer
patch = CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
hsgsasl_VERSION_PATCH
libraryVersion :: IO (Integer, Integer, Integer)
libraryVersion :: IO (Integer, Integer, Integer)
libraryVersion = IO (Integer, Integer, Integer)
io where
parseVersion :: String -> Maybe (Integer, Integer, Integer)
parseVersion str :: String
str = case ReadP (Integer, Integer, Integer)
-> ReadS (Integer, Integer, Integer)
forall a. ReadP a -> ReadS a
P.readP_to_S ReadP (Integer, Integer, Integer)
parser String
str of
[] -> Maybe (Integer, Integer, Integer)
forall a. Maybe a
Nothing
((parsed :: (Integer, Integer, Integer)
parsed, _):_) -> (Integer, Integer, Integer) -> Maybe (Integer, Integer, Integer)
forall a. a -> Maybe a
Just (Integer, Integer, Integer)
parsed
parser :: ReadP (Integer, Integer, Integer)
parser = do
String
majorS <- (Char -> Bool) -> ReadP String
P.munch1 Char -> Bool
isDigit
Char
_ <- Char -> ReadP Char
P.char '.'
String
minorS <- (Char -> Bool) -> ReadP String
P.munch1 Char -> Bool
isDigit
Char
_ <- Char -> ReadP Char
P.char '.'
String
patchS <- (Char -> Bool) -> ReadP String
P.munch1 Char -> Bool
isDigit
ReadP ()
eof
(Integer, Integer, Integer) -> ReadP (Integer, Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Integer
forall a. Read a => String -> a
read String
majorS, String -> Integer
forall a. Read a => String -> a
read String
minorS, String -> Integer
forall a. Read a => String -> a
read String
patchS)
io :: IO (Integer, Integer, Integer)
io = do
CString
cstr <- CString -> IO CString
gsasl_check_version CString
forall a. Ptr a
F.nullPtr
Maybe String
maybeStr <- (CString -> IO String) -> CString -> IO (Maybe String)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
F.maybePeek CString -> IO String
F.peekCString CString
cstr
(Integer, Integer, Integer) -> IO (Integer, Integer, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer, Integer, Integer) -> IO (Integer, Integer, Integer))
-> (Integer, Integer, Integer) -> IO (Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$ (Integer, Integer, Integer)
-> Maybe (Integer, Integer, Integer) -> (Integer, Integer, Integer)
forall a. a -> Maybe a -> a
fromMaybe (String -> (Integer, Integer, Integer)
forall a. HasCallStack => String -> a
error (String -> (Integer, Integer, Integer))
-> String -> (Integer, Integer, Integer)
forall a b. (a -> b) -> a -> b
$ "Invalid version string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show Maybe String
maybeStr)
(Maybe String
maybeStr Maybe String
-> (String -> Maybe (Integer, Integer, Integer))
-> Maybe (Integer, Integer, Integer)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe (Integer, Integer, Integer)
parseVersion)
eof :: ReadP ()
eof = do
String
s <- ReadP String
P.look
Bool -> ReadP () -> ReadP ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) ReadP ()
forall a. ReadP a
P.pfail
checkVersion :: IO Bool
checkVersion :: IO Bool
checkVersion = (CInt -> Bool) -> IO CInt -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1) IO CInt
hsgsasl_check_version
newtype Context = Context (F.Ptr Context)
newtype SASL a = SASL { SASL a -> ReaderT Context IO a
unSASL :: R.ReaderT Context IO a }
instance Functor SASL where
fmap :: (a -> b) -> SASL a -> SASL b
fmap f :: a -> b
f = ReaderT Context IO b -> SASL b
forall a. ReaderT Context IO a -> SASL a
SASL (ReaderT Context IO b -> SASL b)
-> (SASL a -> ReaderT Context IO b) -> SASL a -> SASL b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> ReaderT Context IO a -> ReaderT Context IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ReaderT Context IO a -> ReaderT Context IO b)
-> (SASL a -> ReaderT Context IO a)
-> SASL a
-> ReaderT Context IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SASL a -> ReaderT Context IO a
forall a. SASL a -> ReaderT Context IO a
unSASL
instance Applicative SASL where
pure :: a -> SASL a
pure = ReaderT Context IO a -> SASL a
forall a. ReaderT Context IO a -> SASL a
SASL (ReaderT Context IO a -> SASL a)
-> (a -> ReaderT Context IO a) -> a -> SASL a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
<*> :: SASL (a -> b) -> SASL a -> SASL b
(<*>) = SASL (a -> b) -> SASL a -> SASL b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad SASL where
return :: a -> SASL a
return = ReaderT Context IO a -> SASL a
forall a. ReaderT Context IO a -> SASL a
SASL (ReaderT Context IO a -> SASL a)
-> (a -> ReaderT Context IO a) -> a -> SASL a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
>>= :: SASL a -> (a -> SASL b) -> SASL b
(>>=) sasl :: SASL a
sasl f :: a -> SASL b
f = ReaderT Context IO b -> SASL b
forall a. ReaderT Context IO a -> SASL a
SASL (ReaderT Context IO b -> SASL b) -> ReaderT Context IO b -> SASL b
forall a b. (a -> b) -> a -> b
$ SASL a -> ReaderT Context IO a
forall a. SASL a -> ReaderT Context IO a
unSASL SASL a
sasl ReaderT Context IO a
-> (a -> ReaderT Context IO b) -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SASL b -> ReaderT Context IO b
forall a. SASL a -> ReaderT Context IO a
unSASL (SASL b -> ReaderT Context IO b)
-> (a -> SASL b) -> a -> ReaderT Context IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SASL b
f
instance MonadIO SASL where
liftIO :: IO a -> SASL a
liftIO = ReaderT Context IO a -> SASL a
forall a. ReaderT Context IO a -> SASL a
SASL (ReaderT Context IO a -> SASL a)
-> (IO a -> ReaderT Context IO a) -> IO a -> SASL a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT Context IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
runSASL :: SASL a -> IO a
runSASL :: SASL a -> IO a
runSASL = (Context -> IO a) -> IO a
forall a. (Context -> IO a) -> IO a
withContext ((Context -> IO a) -> IO a)
-> (SASL a -> Context -> IO a) -> SASL a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Context IO a -> Context -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (ReaderT Context IO a -> Context -> IO a)
-> (SASL a -> ReaderT Context IO a) -> SASL a -> Context -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SASL a -> ReaderT Context IO a
forall a. SASL a -> ReaderT Context IO a
unSASL
withContext :: (Context -> IO a) -> IO a
withContext :: (Context -> IO a) -> IO a
withContext = IO Context -> (Context -> IO ()) -> (Context -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO Context
newContext Context -> IO ()
freeContext where
newContext :: IO Context
newContext = (Ptr (Ptr Context) -> IO Context) -> IO Context
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr (Ptr Context) -> IO Context) -> IO Context)
-> (Ptr (Ptr Context) -> IO Context) -> IO Context
forall a b. (a -> b) -> a -> b
$ \pCtxt :: Ptr (Ptr Context)
pCtxt -> do
Ptr (Ptr Context) -> IO CInt
gsasl_init Ptr (Ptr Context)
pCtxt IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
Ptr Context -> Context
Context (Ptr Context -> Context) -> IO (Ptr Context) -> IO Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Ptr (Ptr Context) -> IO (Ptr Context)
forall a. Storable a => Ptr a -> IO a
F.peek Ptr (Ptr Context)
pCtxt
freeContext :: Context -> IO ()
freeContext (Context ctx :: Ptr Context
ctx) = do
Ptr CallbackHook
hook <- Ptr Context -> IO (Ptr CallbackHook)
forall a. Ptr Context -> IO (Ptr a)
gsasl_callback_hook_get Ptr Context
ctx
Ptr Context -> IO ()
gsasl_done Ptr Context
ctx
Ptr CallbackHook -> IO ()
freeCallbackHook Ptr CallbackHook
hook
getContext :: SASL (F.Ptr Context)
getContext :: SASL (Ptr Context)
getContext = ReaderT Context IO (Ptr Context) -> SASL (Ptr Context)
forall a. ReaderT Context IO a -> SASL a
SASL (ReaderT Context IO (Ptr Context) -> SASL (Ptr Context))
-> ReaderT Context IO (Ptr Context) -> SASL (Ptr Context)
forall a b. (a -> b) -> a -> b
$ do
Context ptr :: Ptr Context
ptr <- ReaderT Context IO Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
Ptr Context -> ReaderT Context IO (Ptr Context)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Context
ptr
bracketSASL :: (F.Ptr Context -> IO a) -> (a -> IO b) -> (a -> IO c) -> SASL c
bracketSASL :: (Ptr Context -> IO a) -> (a -> IO b) -> (a -> IO c) -> SASL c
bracketSASL before :: Ptr Context -> IO a
before after :: a -> IO b
after thing :: a -> IO c
thing = do
Ptr Context
ctx <- SASL (Ptr Context)
getContext
IO c -> SASL c
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO c -> SASL c) -> IO c -> SASL c
forall a b. (a -> b) -> a -> b
$ IO a -> (a -> IO b) -> (a -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Ptr Context -> IO a
before Ptr Context
ctx) a -> IO b
after a -> IO c
thing
newtype Mechanism = Mechanism B.ByteString
deriving (Int -> Mechanism -> String -> String
[Mechanism] -> String -> String
Mechanism -> String
(Int -> Mechanism -> String -> String)
-> (Mechanism -> String)
-> ([Mechanism] -> String -> String)
-> Show Mechanism
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Mechanism] -> String -> String
$cshowList :: [Mechanism] -> String -> String
show :: Mechanism -> String
$cshow :: Mechanism -> String
showsPrec :: Int -> Mechanism -> String -> String
$cshowsPrec :: Int -> Mechanism -> String -> String
Show, Mechanism -> Mechanism -> Bool
(Mechanism -> Mechanism -> Bool)
-> (Mechanism -> Mechanism -> Bool) -> Eq Mechanism
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mechanism -> Mechanism -> Bool
$c/= :: Mechanism -> Mechanism -> Bool
== :: Mechanism -> Mechanism -> Bool
$c== :: Mechanism -> Mechanism -> Bool
Eq)
instance IsString Mechanism where
fromString :: String -> Mechanism
fromString = ByteString -> Mechanism
Mechanism (ByteString -> Mechanism)
-> (String -> ByteString) -> String -> Mechanism
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
clientMechanisms :: SASL [Mechanism]
clientMechanisms :: SASL [Mechanism]
clientMechanisms = (Ptr Context -> IO CString)
-> (CString -> IO ())
-> (CString -> IO [Mechanism])
-> SASL [Mechanism]
forall a b c.
(Ptr Context -> IO a) -> (a -> IO b) -> (a -> IO c) -> SASL c
bracketSASL Ptr Context -> IO CString
io CString -> IO ()
forall a. Ptr a -> IO ()
gsasl_free CString -> IO [Mechanism]
splitMechListPtr where
io :: Ptr Context -> IO CString
io ctx :: Ptr Context
ctx = (Ptr CString -> IO CString) -> IO CString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO CString) -> IO CString)
-> (Ptr CString -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \pStr :: Ptr CString
pStr -> do
Ptr Context -> Ptr CString -> IO CInt
gsasl_client_mechlist Ptr Context
ctx Ptr CString
pStr IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
pStr
clientSupports :: Mechanism -> SASL Bool
clientSupports :: Mechanism -> SASL Bool
clientSupports (Mechanism name :: ByteString
name) = do
Ptr Context
ctx <- SASL (Ptr Context)
getContext
IO Bool -> SASL Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> SASL Bool) -> IO Bool -> SASL Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \pName :: CString
pName -> do
CInt
cres <- Ptr Context -> CString -> IO CInt
gsasl_client_support_p Ptr Context
ctx CString
pName
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CInt
cres CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1
clientSuggestMechanism :: [Mechanism] -> SASL (Maybe Mechanism)
clientSuggestMechanism :: [Mechanism] -> SASL (Maybe Mechanism)
clientSuggestMechanism mechs :: [Mechanism]
mechs = do
let bytes :: ByteString
bytes = ByteString -> [ByteString] -> ByteString
B.intercalate (String -> ByteString
Char8.pack " ") [ByteString
x | Mechanism x :: ByteString
x <- [Mechanism]
mechs]
Ptr Context
ctx <- SASL (Ptr Context)
getContext
IO (Maybe Mechanism) -> SASL (Maybe Mechanism)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Mechanism) -> SASL (Maybe Mechanism))
-> IO (Maybe Mechanism) -> SASL (Maybe Mechanism)
forall a b. (a -> b) -> a -> b
$ ByteString
-> (CString -> IO (Maybe Mechanism)) -> IO (Maybe Mechanism)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
bytes ((CString -> IO (Maybe Mechanism)) -> IO (Maybe Mechanism))
-> (CString -> IO (Maybe Mechanism)) -> IO (Maybe Mechanism)
forall a b. (a -> b) -> a -> b
$
(CString -> IO Mechanism) -> CString -> IO (Maybe Mechanism)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
F.maybePeek ((ByteString -> Mechanism) -> IO ByteString -> IO Mechanism
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Mechanism
Mechanism (IO ByteString -> IO Mechanism)
-> (CString -> IO ByteString) -> CString -> IO Mechanism
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO ByteString
B.packCString) (CString -> IO (Maybe Mechanism))
-> (CString -> IO CString) -> CString -> IO (Maybe Mechanism)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=<
Ptr Context -> CString -> IO CString
gsasl_client_suggest_mechanism Ptr Context
ctx
serverMechanisms :: SASL [Mechanism]
serverMechanisms :: SASL [Mechanism]
serverMechanisms = (Ptr Context -> IO CString)
-> (CString -> IO ())
-> (CString -> IO [Mechanism])
-> SASL [Mechanism]
forall a b c.
(Ptr Context -> IO a) -> (a -> IO b) -> (a -> IO c) -> SASL c
bracketSASL Ptr Context -> IO CString
io CString -> IO ()
forall a. Ptr a -> IO ()
gsasl_free CString -> IO [Mechanism]
splitMechListPtr where
io :: Ptr Context -> IO CString
io ctx :: Ptr Context
ctx = (Ptr CString -> IO CString) -> IO CString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO CString) -> IO CString)
-> (Ptr CString -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \pStr :: Ptr CString
pStr -> do
Ptr Context -> Ptr CString -> IO CInt
gsasl_server_mechlist Ptr Context
ctx Ptr CString
pStr IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
pStr
serverSupports :: Mechanism -> SASL Bool
serverSupports :: Mechanism -> SASL Bool
serverSupports (Mechanism name :: ByteString
name) = do
Ptr Context
ctx <- SASL (Ptr Context)
getContext
IO Bool -> SASL Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> SASL Bool) -> IO Bool -> SASL Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
name ((CString -> IO Bool) -> IO Bool)
-> (CString -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \pName :: CString
pName -> do
CInt
cres <- Ptr Context -> CString -> IO CInt
gsasl_server_support_p Ptr Context
ctx CString
pName
Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CInt
cres CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== 1
splitMechListPtr :: F.CString -> IO [Mechanism]
splitMechListPtr :: CString -> IO [Mechanism]
splitMechListPtr ptr :: CString
ptr = ((CString, CString, Int, Bool)
-> IO (Maybe (Mechanism, (CString, CString, Int, Bool))))
-> (CString, CString, Int, Bool) -> IO [Mechanism]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe (b, a))) -> a -> m [b]
unfoldrM (CString, CString, Int, Bool)
-> IO (Maybe (Mechanism, (CString, CString, Int, Bool)))
forall b c b b.
(Storable b, Eq b, Num b, Num c) =>
(CString, Ptr b, Int, Bool)
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
step' (CString
ptr, CString
ptr, 0, Bool
True) where
step' :: (CString, Ptr b, Int, Bool)
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
step' (_, _, _, False) = Maybe (Mechanism, (Ptr b, Ptr b, c, Bool))
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Mechanism, (Ptr b, Ptr b, c, Bool))
forall a. Maybe a
Nothing
step' (p_0 :: CString
p_0, p_i :: Ptr b
p_i, i :: Int
i, _) = Ptr b -> IO b
forall a. Storable a => Ptr a -> IO a
F.peek Ptr b
p_i IO b
-> (b -> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool))))
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \chr :: b
chr -> let
p_i' :: Ptr b
p_i' = Ptr b -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
F.plusPtr Ptr b
p_i 1
peek :: Bool -> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
peek continue :: Bool
continue = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
then (CString, Ptr b, Int, Bool)
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
step' (CString
forall a. Ptr a
p_i', Ptr b
forall a. Ptr a
p_i', 0, Bool
continue)
else do
ByteString
bytes <- CStringLen -> IO ByteString
B.packCStringLen (CString
p_0, Int
i)
Maybe (Mechanism, (Ptr b, Ptr b, c, Bool))
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool))
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool))))
-> Maybe (Mechanism, (Ptr b, Ptr b, c, Bool))
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
forall a b. (a -> b) -> a -> b
$ (Mechanism, (Ptr b, Ptr b, c, Bool))
-> Maybe (Mechanism, (Ptr b, Ptr b, c, Bool))
forall a. a -> Maybe a
Just (ByteString -> Mechanism
Mechanism ByteString
bytes, (Ptr b
forall a. Ptr a
p_i', Ptr b
forall a. Ptr a
p_i', 0, Bool
continue))
in case b
chr of
0x00 -> Bool -> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
peek Bool
False
0x20 -> Bool -> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
peek Bool
True
_ -> (CString, Ptr b, Int, Bool)
-> IO (Maybe (Mechanism, (Ptr b, Ptr b, c, Bool)))
step' (CString
p_0, Ptr b
forall a. Ptr a
p_i', Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, Bool
True)
newtype SessionCtx = SessionCtx (F.Ptr SessionCtx)
newtype Session a = Session { Session a -> ReaderT SessionCtx IO a
unSession :: R.ReaderT SessionCtx IO a }
instance Functor Session where
fmap :: (a -> b) -> Session a -> Session b
fmap f :: a -> b
f = ReaderT SessionCtx IO b -> Session b
forall a. ReaderT SessionCtx IO a -> Session a
Session (ReaderT SessionCtx IO b -> Session b)
-> (Session a -> ReaderT SessionCtx IO b) -> Session a -> Session b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> ReaderT SessionCtx IO a -> ReaderT SessionCtx IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ReaderT SessionCtx IO a -> ReaderT SessionCtx IO b)
-> (Session a -> ReaderT SessionCtx IO a)
-> Session a
-> ReaderT SessionCtx IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session a -> ReaderT SessionCtx IO a
forall a. Session a -> ReaderT SessionCtx IO a
unSession
instance Applicative Session where
pure :: a -> Session a
pure = ReaderT SessionCtx IO a -> Session a
forall a. ReaderT SessionCtx IO a -> Session a
Session (ReaderT SessionCtx IO a -> Session a)
-> (a -> ReaderT SessionCtx IO a) -> a -> Session a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT SessionCtx IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
<*> :: Session (a -> b) -> Session a -> Session b
(<*>) = Session (a -> b) -> Session a -> Session b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance Monad Session where
return :: a -> Session a
return = ReaderT SessionCtx IO a -> Session a
forall a. ReaderT SessionCtx IO a -> Session a
Session (ReaderT SessionCtx IO a -> Session a)
-> (a -> ReaderT SessionCtx IO a) -> a -> Session a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ReaderT SessionCtx IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
>>= :: Session a -> (a -> Session b) -> Session b
(>>=) m :: Session a
m f :: a -> Session b
f = ReaderT SessionCtx IO b -> Session b
forall a. ReaderT SessionCtx IO a -> Session a
Session (ReaderT SessionCtx IO b -> Session b)
-> ReaderT SessionCtx IO b -> Session b
forall a b. (a -> b) -> a -> b
$ Session a -> ReaderT SessionCtx IO a
forall a. Session a -> ReaderT SessionCtx IO a
unSession Session a
m ReaderT SessionCtx IO a
-> (a -> ReaderT SessionCtx IO b) -> ReaderT SessionCtx IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Session b -> ReaderT SessionCtx IO b
forall a. Session a -> ReaderT SessionCtx IO a
unSession (Session b -> ReaderT SessionCtx IO b)
-> (a -> Session b) -> a -> ReaderT SessionCtx IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Session b
f
instance MonadIO Session where
liftIO :: IO a -> Session a
liftIO = ReaderT SessionCtx IO a -> Session a
forall a. ReaderT SessionCtx IO a -> Session a
Session (ReaderT SessionCtx IO a -> Session a)
-> (IO a -> ReaderT SessionCtx IO a) -> IO a -> Session a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT SessionCtx IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
type SessionProc = F.Ptr Context -> F.CString -> F.Ptr (F.Ptr SessionCtx) -> IO F.CInt
runSession :: SessionProc -> Mechanism -> Session a -> SASL (Either Error a)
runSession :: SessionProc -> Mechanism -> Session a -> SASL (Either Error a)
runSession start :: SessionProc
start (Mechanism mech :: ByteString
mech) session :: Session a
session = (Ptr Context -> IO (Either Error SessionCtx))
-> (Either Error SessionCtx -> IO ())
-> (Either Error SessionCtx -> IO (Either Error a))
-> SASL (Either Error a)
forall a b c.
(Ptr Context -> IO a) -> (a -> IO b) -> (a -> IO c) -> SASL c
bracketSASL Ptr Context -> IO (Either Error SessionCtx)
newSession Either Error SessionCtx -> IO ()
forall a. Either a SessionCtx -> IO ()
freeSession Either Error SessionCtx -> IO (Either Error a)
io where
newSession :: Ptr Context -> IO (Either Error SessionCtx)
newSession ctx :: Ptr Context
ctx =
ByteString
-> (CString -> IO (Either Error SessionCtx))
-> IO (Either Error SessionCtx)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
mech ((CString -> IO (Either Error SessionCtx))
-> IO (Either Error SessionCtx))
-> (CString -> IO (Either Error SessionCtx))
-> IO (Either Error SessionCtx)
forall a b. (a -> b) -> a -> b
$ \pMech :: CString
pMech ->
(Ptr (Ptr SessionCtx) -> IO (Either Error SessionCtx))
-> IO (Either Error SessionCtx)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr (Ptr SessionCtx) -> IO (Either Error SessionCtx))
-> IO (Either Error SessionCtx))
-> (Ptr (Ptr SessionCtx) -> IO (Either Error SessionCtx))
-> IO (Either Error SessionCtx)
forall a b. (a -> b) -> a -> b
$ \pSessionCtx :: Ptr (Ptr SessionCtx)
pSessionCtx -> (SASLException -> IO (Either Error SessionCtx))
-> IO (Either Error SessionCtx) -> IO (Either Error SessionCtx)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
E.handle SASLException -> IO (Either Error SessionCtx)
forall (m :: * -> *) b.
Monad m =>
SASLException -> m (Either Error b)
noSession (IO (Either Error SessionCtx) -> IO (Either Error SessionCtx))
-> IO (Either Error SessionCtx) -> IO (Either Error SessionCtx)
forall a b. (a -> b) -> a -> b
$ do
SessionProc
start Ptr Context
ctx CString
pMech Ptr (Ptr SessionCtx)
pSessionCtx IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
SessionCtx -> Either Error SessionCtx
forall a b. b -> Either a b
Right (SessionCtx -> Either Error SessionCtx)
-> (Ptr SessionCtx -> SessionCtx)
-> Ptr SessionCtx
-> Either Error SessionCtx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr SessionCtx -> SessionCtx
SessionCtx (Ptr SessionCtx -> Either Error SessionCtx)
-> IO (Ptr SessionCtx) -> IO (Either Error SessionCtx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr (Ptr SessionCtx) -> IO (Ptr SessionCtx)
forall a. Storable a => Ptr a -> IO a
F.peek Ptr (Ptr SessionCtx)
pSessionCtx
noSession :: SASLException -> m (Either Error b)
noSession (SASLException err :: Error
err) = Either Error b -> m (Either Error b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error b -> m (Either Error b))
-> Either Error b -> m (Either Error b)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error b
forall a b. a -> Either a b
Left Error
err
freeSession :: Either a SessionCtx -> IO ()
freeSession (Left _) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
freeSession (Right (SessionCtx ptr :: Ptr SessionCtx
ptr)) = Ptr SessionCtx -> IO ()
gsasl_finish Ptr SessionCtx
ptr
io :: Either Error SessionCtx -> IO (Either Error a)
io (Left err :: Error
err) = Either Error a -> IO (Either Error a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error a -> IO (Either Error a))
-> Either Error a -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error a
forall a b. a -> Either a b
Left Error
err
io (Right sctx :: SessionCtx
sctx) = IO (Either Error a)
-> (SASLException -> IO (Either Error a)) -> IO (Either Error a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
(a -> Either Error a
forall a b. b -> Either a b
Right (a -> Either Error a) -> IO a -> IO (Either Error a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT SessionCtx IO a -> SessionCtx -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (Session a -> ReaderT SessionCtx IO a
forall a. Session a -> ReaderT SessionCtx IO a
unSession Session a
session) SessionCtx
sctx)
(\(SASLException err :: Error
err) -> Either Error a -> IO (Either Error a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error a -> IO (Either Error a))
-> Either Error a -> IO (Either Error a)
forall a b. (a -> b) -> a -> b
$ Error -> Either Error a
forall a b. a -> Either a b
Left Error
err)
runClient :: Mechanism -> Session a -> SASL (Either Error a)
runClient :: Mechanism -> Session a -> SASL (Either Error a)
runClient = SessionProc -> Mechanism -> Session a -> SASL (Either Error a)
forall a.
SessionProc -> Mechanism -> Session a -> SASL (Either Error a)
runSession SessionProc
gsasl_client_start
runServer :: Mechanism -> Session a -> SASL (Either Error a)
runServer :: Mechanism -> Session a -> SASL (Either Error a)
runServer = SessionProc -> Mechanism -> Session a -> SASL (Either Error a)
forall a.
SessionProc -> Mechanism -> Session a -> SASL (Either Error a)
runSession SessionProc
gsasl_server_start
getSessionContext :: Session (F.Ptr SessionCtx)
getSessionContext :: Session (Ptr SessionCtx)
getSessionContext = ReaderT SessionCtx IO (Ptr SessionCtx) -> Session (Ptr SessionCtx)
forall a. ReaderT SessionCtx IO a -> Session a
Session (ReaderT SessionCtx IO (Ptr SessionCtx)
-> Session (Ptr SessionCtx))
-> ReaderT SessionCtx IO (Ptr SessionCtx)
-> Session (Ptr SessionCtx)
forall a b. (a -> b) -> a -> b
$ do
SessionCtx sctx :: Ptr SessionCtx
sctx <- ReaderT SessionCtx IO SessionCtx
forall (m :: * -> *) r. Monad m => ReaderT r m r
R.ask
Ptr SessionCtx -> ReaderT SessionCtx IO (Ptr SessionCtx)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr SessionCtx
sctx
mechanismName :: Session Mechanism
mechanismName :: Session Mechanism
mechanismName = do
Ptr SessionCtx
sctx <- Session (Ptr SessionCtx)
getSessionContext
IO Mechanism -> Session Mechanism
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Mechanism -> Session Mechanism)
-> IO Mechanism -> Session Mechanism
forall a b. (a -> b) -> a -> b
$ do
CString
cstr <- Ptr SessionCtx -> IO CString
gsasl_mechanism_name Ptr SessionCtx
sctx
ByteString -> Mechanism
Mechanism (ByteString -> Mechanism) -> IO ByteString -> IO Mechanism
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` CString -> IO ByteString
B.packCString CString
cstr
bracketSession :: (F.Ptr SessionCtx -> IO a) -> (a -> IO b) -> (a -> IO c) -> Session c
bracketSession :: (Ptr SessionCtx -> IO a) -> (a -> IO b) -> (a -> IO c) -> Session c
bracketSession before :: Ptr SessionCtx -> IO a
before after :: a -> IO b
after thing :: a -> IO c
thing = do
Ptr SessionCtx
sctx <- Session (Ptr SessionCtx)
getSessionContext
IO c -> Session c
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO c -> Session c) -> IO c -> Session c
forall a b. (a -> b) -> a -> b
$ IO a -> (a -> IO b) -> (a -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Ptr SessionCtx -> IO a
before Ptr SessionCtx
sctx) a -> IO b
after a -> IO c
thing
data Error
= UnknownMechanism
| MechanismCalledTooManyTimes
| MallocError
| Base64Error
| CryptoError
| SASLPrepError
| MechanismParseError
| AuthenticationError
| IntegrityError
| NoClientCode
| NoServerCode
| NoCallback
| NoAnonymousToken
| NoAuthID
| NoAuthzID
| NoPassword
| NoPasscode
| NoPIN
| NoService
| NoHostname
| GSSAPI_ReleaseBufferError
| GSSAPI_ImportNameError
| GSSAPI_InitSecContextError
| GSSAPI_AcceptSecContextError
| GSSAPI_UnwrapError
| GSSAPI_WrapError
| GSSAPI_AquireCredError
| GSSAPI_DisplayNameError
| GSSAPI_UnsupportedProtectionError
| GSSAPI_EncapsulateTokenError
| GSSAPI_DecapsulateTokenError
| GSSAPI_InquireMechForSASLNameError
| GSSAPI_TestOIDSetMemberError
| GSSAPI_ReleaseOIDSetError
| KerberosV5_InitError
| KerberosV5_InternalError
| SecurID_ServerNeedAdditionalPasscode
| SecurID_ServerNeedNewPIN
instance Show Error where
show :: Error -> String
show = Error -> String
strError
strError :: Error -> String
strError :: Error -> String
strError err :: Error
err = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ CInt -> IO CString
gsasl_strerror (Error -> CInt
cFromError Error
err) IO CString -> (CString -> IO String) -> IO String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CString -> IO String
F.peekCString
newtype SASLException = SASLException Error deriving (Int -> SASLException -> String -> String
[SASLException] -> String -> String
SASLException -> String
(Int -> SASLException -> String -> String)
-> (SASLException -> String)
-> ([SASLException] -> String -> String)
-> Show SASLException
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [SASLException] -> String -> String
$cshowList :: [SASLException] -> String -> String
show :: SASLException -> String
$cshow :: SASLException -> String
showsPrec :: Int -> SASLException -> String -> String
$cshowsPrec :: Int -> SASLException -> String -> String
Show)
instance E.Exception SASLException
cFromError :: Error -> F.CInt
cFromError :: Error -> CInt
cFromError e :: Error
e = case Error
e of
UnknownMechanism -> 2
MechanismCalledTooManyTimes -> 3
MallocError -> 7
Base64Error -> 8
CryptoError -> 9
SASLPrepError -> 29
MechanismParseError -> 30
AuthenticationError -> 31
IntegrityError -> 33
NoClientCode -> 35
NoServerCode -> 36
NoCallback -> 51
NoAnonymousToken -> 52
NoAuthID -> 53
NoAuthzID -> 54
NoPassword -> 55
NoPasscode -> 56
NoPIN -> 57
NoService -> 58
NoHostname -> 59
GSSAPI_ReleaseBufferError -> 37
GSSAPI_ImportNameError -> 38
GSSAPI_InitSecContextError -> 39
GSSAPI_AcceptSecContextError -> 40
GSSAPI_UnwrapError -> 41
GSSAPI_WrapError -> 42
GSSAPI_AquireCredError -> 43
GSSAPI_DisplayNameError -> 44
GSSAPI_UnsupportedProtectionError -> 45
GSSAPI_EncapsulateTokenError -> 60
GSSAPI_DecapsulateTokenError -> 61
GSSAPI_InquireMechForSASLNameError -> 62
GSSAPI_TestOIDSetMemberError -> 63
GSSAPI_ReleaseOIDSetError -> 64
KerberosV5_InitError -> 46
KerberosV5_InternalError -> 47
SecurID_ServerNeedAdditionalPasscode -> 48
SecurID_ServerNeedNewPIN -> 49
cToError :: F.CInt -> Error
cToError :: CInt -> Error
cToError x :: CInt
x = case CInt
x of
2 -> Error
UnknownMechanism
3 -> Error
MechanismCalledTooManyTimes
7 -> Error
MallocError
8 -> Error
Base64Error
9 -> Error
CryptoError
29 -> Error
SASLPrepError
30 -> Error
MechanismParseError
31 -> Error
AuthenticationError
33 -> Error
IntegrityError
35 -> Error
NoClientCode
36 -> Error
NoServerCode
51 -> Error
NoCallback
52 -> Error
NoAnonymousToken
53 -> Error
NoAuthID
54 -> Error
NoAuthzID
55 -> Error
NoPassword
56 -> Error
NoPasscode
57 -> Error
NoPIN
58 -> Error
NoService
59 -> Error
NoHostname
37 -> Error
GSSAPI_ReleaseBufferError
38 -> Error
GSSAPI_ImportNameError
39 -> Error
GSSAPI_InitSecContextError
40 -> Error
GSSAPI_AcceptSecContextError
41 -> Error
GSSAPI_UnwrapError
42 -> Error
GSSAPI_WrapError
43 -> Error
GSSAPI_AquireCredError
44 -> Error
GSSAPI_DisplayNameError
45 -> Error
GSSAPI_UnsupportedProtectionError
60 -> Error
GSSAPI_EncapsulateTokenError
61 -> Error
GSSAPI_DecapsulateTokenError
62 -> Error
GSSAPI_InquireMechForSASLNameError
63 -> Error
GSSAPI_TestOIDSetMemberError
64 -> Error
GSSAPI_ReleaseOIDSetError
46 -> Error
KerberosV5_InitError
47 -> Error
KerberosV5_InternalError
48 -> Error
SecurID_ServerNeedAdditionalPasscode
49 -> Error
SecurID_ServerNeedNewPIN
_ -> String -> Error
forall a. HasCallStack => String -> a
error (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$ "Unknown GNU SASL return code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x
throw :: Error -> Session a
throw :: Error -> Session a
throw = IO a -> Session a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Session a) -> (Error -> IO a) -> Error -> Session a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SASLException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (SASLException -> IO a)
-> (Error -> SASLException) -> Error -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> SASLException
SASLException
catch :: Session a -> (Error -> Session a) -> Session a
catch :: Session a -> (Error -> Session a) -> Session a
catch m :: Session a
m f :: Error -> Session a
f = do
SessionCtx
sctx <- Ptr SessionCtx -> SessionCtx
SessionCtx (Ptr SessionCtx -> SessionCtx)
-> Session (Ptr SessionCtx) -> Session SessionCtx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Session (Ptr SessionCtx)
getSessionContext
ReaderT SessionCtx IO a -> Session a
forall a. ReaderT SessionCtx IO a -> Session a
Session (ReaderT SessionCtx IO a -> Session a)
-> (IO a -> ReaderT SessionCtx IO a) -> IO a -> Session a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT SessionCtx IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Session a) -> IO a -> Session a
forall a b. (a -> b) -> a -> b
$ IO a -> (SASLException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
(ReaderT SessionCtx IO a -> SessionCtx -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (Session a -> ReaderT SessionCtx IO a
forall a. Session a -> ReaderT SessionCtx IO a
unSession Session a
m) SessionCtx
sctx)
(\(SASLException err :: Error
err) -> ReaderT SessionCtx IO a -> SessionCtx -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (Session a -> ReaderT SessionCtx IO a
forall a. Session a -> ReaderT SessionCtx IO a
unSession (Error -> Session a
f Error
err)) SessionCtx
sctx)
handle :: (Error -> Session a) -> Session a -> Session a
handle :: (Error -> Session a) -> Session a -> Session a
handle = (Session a -> (Error -> Session a) -> Session a)
-> (Error -> Session a) -> Session a -> Session a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Session a -> (Error -> Session a) -> Session a
forall a. Session a -> (Error -> Session a) -> Session a
catch
try :: Session a -> Session (Either Error a)
try :: Session a -> Session (Either Error a)
try m :: Session a
m = Session (Either Error a)
-> (Error -> Session (Either Error a)) -> Session (Either Error a)
forall a. Session a -> (Error -> Session a) -> Session a
catch ((a -> Either Error a) -> Session a -> Session (Either Error a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either Error a
forall a b. b -> Either a b
Right Session a
m) (Either Error a -> Session (Either Error a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error a -> Session (Either Error a))
-> (Error -> Either Error a) -> Error -> Session (Either Error a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error a
forall a b. a -> Either a b
Left)
data Property
= PropertyAuthID
| PropertyAuthzID
| PropertyPassword
| PropertyAnonymousToken
| PropertyService
| PropertyHostname
| PropertyGSSAPIDisplayName
| PropertyPasscode
| PropertySuggestedPIN
| PropertyPIN
| PropertyRealm
| PropertyDigestMD5HashedPassword
| PropertyQOPS
| PropertyQOP
| PropertyScramIter
| PropertyScramSalt
| PropertyScramSaltedPassword
| ValidateSimple
| ValidateExternal
| ValidateAnonymous
| ValidateGSSAPI
| ValidateSecurID
deriving (Int -> Property -> String -> String
[Property] -> String -> String
Property -> String
(Int -> Property -> String -> String)
-> (Property -> String)
-> ([Property] -> String -> String)
-> Show Property
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Property] -> String -> String
$cshowList :: [Property] -> String -> String
show :: Property -> String
$cshow :: Property -> String
showsPrec :: Int -> Property -> String -> String
$cshowsPrec :: Int -> Property -> String -> String
Show, Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c== :: Property -> Property -> Bool
Eq)
cFromProperty :: Property -> F.CInt
cFromProperty :: Property -> CInt
cFromProperty x :: Property
x = case Property
x of
PropertyAuthID -> 1
PropertyAuthzID -> 2
PropertyPassword -> 3
PropertyAnonymousToken -> 4
PropertyService -> 5
PropertyHostname -> 6
PropertyGSSAPIDisplayName -> 7
PropertyPasscode -> 8
PropertySuggestedPIN -> 9
PropertyPIN -> 10
PropertyRealm -> 11
PropertyDigestMD5HashedPassword -> 12
PropertyQOPS -> 13
PropertyQOP -> 14
PropertyScramIter -> 15
PropertyScramSalt -> 16
PropertyScramSaltedPassword -> 17
ValidateSimple -> 500
ValidateExternal -> 501
ValidateAnonymous -> 502
ValidateGSSAPI -> 503
ValidateSecurID -> 504
cToProperty :: F.CInt -> Property
cToProperty :: CInt -> Property
cToProperty x :: CInt
x = case CInt
x of
1 -> Property
PropertyAuthID
2 -> Property
PropertyAuthzID
3 -> Property
PropertyPassword
4 -> Property
PropertyAnonymousToken
5 -> Property
PropertyService
6 -> Property
PropertyHostname
7 -> Property
PropertyGSSAPIDisplayName
8 -> Property
PropertyPasscode
9 -> Property
PropertySuggestedPIN
10 -> Property
PropertyPIN
11 -> Property
PropertyRealm
12 -> Property
PropertyDigestMD5HashedPassword
13 -> Property
PropertyQOPS
14 -> Property
PropertyQOP
15 -> Property
PropertyScramIter
16 -> Property
PropertyScramSalt
17 -> Property
PropertyScramSaltedPassword
500 -> Property
ValidateSimple
501 -> Property
ValidateExternal
502 -> Property
ValidateAnonymous
503 -> Property
ValidateGSSAPI
504 -> Property
ValidateSecurID
_ -> String -> Property
forall a. HasCallStack => String -> a
error (String -> Property) -> String -> Property
forall a b. (a -> b) -> a -> b
$ "Unknown GNU SASL property code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
x
setProperty :: Property -> B.ByteString -> Session ()
setProperty :: Property -> ByteString -> Session ()
setProperty prop :: Property
prop bytes :: ByteString
bytes = do
Ptr SessionCtx
sctx <- Session (Ptr SessionCtx)
getSessionContext
IO () -> Session ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Session ()) -> IO () -> Session ()
forall a b. (a -> b) -> a -> b
$
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
bytes ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
Ptr SessionCtx -> CInt -> CString -> IO ()
gsasl_property_set Ptr SessionCtx
sctx (Property -> CInt
cFromProperty Property
prop)
getProperty :: Property -> Session (Maybe B.ByteString)
getProperty :: Property -> Session (Maybe ByteString)
getProperty prop :: Property
prop = do
Ptr SessionCtx
sctx <- Session (Ptr SessionCtx)
getSessionContext
IO (Maybe ByteString) -> Session (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> Session (Maybe ByteString))
-> IO (Maybe ByteString) -> Session (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ do
CString
cstr <- Ptr SessionCtx -> CInt -> IO CString
gsasl_property_get Ptr SessionCtx
sctx (Property -> CInt
cFromProperty Property
prop)
if CString
cstr CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
F.nullPtr
then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> IO ByteString -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> IO ByteString
B.packCString CString
cstr
else do
IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SessionCtx -> IO ()
checkCallbackException Ptr SessionCtx
sctx
Maybe ByteString -> IO (Maybe ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
getPropertyFast :: Property -> Session (Maybe B.ByteString)
getPropertyFast :: Property -> Session (Maybe ByteString)
getPropertyFast prop :: Property
prop = do
Ptr SessionCtx
sctx <- Session (Ptr SessionCtx)
getSessionContext
IO (Maybe ByteString) -> Session (Maybe ByteString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> Session (Maybe ByteString))
-> IO (Maybe ByteString) -> Session (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$
Ptr SessionCtx -> CInt -> IO CString
gsasl_property_fast Ptr SessionCtx
sctx (Property -> CInt
cFromProperty Property
prop) IO CString
-> (CString -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
(CString -> IO ByteString) -> CString -> IO (Maybe ByteString)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
F.maybePeek CString -> IO ByteString
B.packCString
type CallbackFn = F.Ptr Context -> F.Ptr SessionCtx -> F.CInt -> IO F.CInt
data CallbackHook = CallbackHook (F.FunPtr CallbackFn) (Property -> Session Progress)
newCallbackHook :: (Property -> Session Progress) -> IO (F.Ptr CallbackHook, F.FunPtr CallbackFn)
newCallbackHook :: (Property -> Session Progress)
-> IO (Ptr CallbackHook, FunPtr CallbackFn)
newCallbackHook cb :: Property -> Session Progress
cb = IO (FunPtr CallbackFn)
-> (FunPtr CallbackFn -> IO ())
-> (FunPtr CallbackFn -> IO (Ptr CallbackHook, FunPtr CallbackFn))
-> IO (Ptr CallbackHook, FunPtr CallbackFn)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError
(CallbackFn -> IO (FunPtr CallbackFn)
wrapCallbackImpl ((Property -> Session Progress) -> CallbackFn
callbackImpl Property -> Session Progress
cb))
FunPtr CallbackFn -> IO ()
forall a. FunPtr a -> IO ()
F.freeHaskellFunPtr
(\funPtr :: FunPtr CallbackFn
funPtr -> let hook :: CallbackHook
hook = FunPtr CallbackFn -> (Property -> Session Progress) -> CallbackHook
CallbackHook FunPtr CallbackFn
funPtr Property -> Session Progress
cb in IO (StablePtr CallbackHook)
-> (StablePtr CallbackHook -> IO ())
-> (StablePtr CallbackHook
-> IO (Ptr CallbackHook, FunPtr CallbackFn))
-> IO (Ptr CallbackHook, FunPtr CallbackFn)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracketOnError
(CallbackHook -> IO (StablePtr CallbackHook)
forall a. a -> IO (StablePtr a)
F.newStablePtr CallbackHook
hook)
StablePtr CallbackHook -> IO ()
forall a. StablePtr a -> IO ()
F.freeStablePtr
(\stablePtr :: StablePtr CallbackHook
stablePtr -> let
hookPtr :: Ptr b
hookPtr = Ptr () -> Ptr b
forall a b. Ptr a -> Ptr b
F.castPtr (StablePtr CallbackHook -> Ptr ()
forall a. StablePtr a -> Ptr ()
F.castStablePtrToPtr StablePtr CallbackHook
stablePtr)
in (Ptr CallbackHook, FunPtr CallbackFn)
-> IO (Ptr CallbackHook, FunPtr CallbackFn)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr CallbackHook
forall a. Ptr a
hookPtr, FunPtr CallbackFn
funPtr)))
freeCallbackHook :: F.Ptr CallbackHook -> IO ()
freeCallbackHook :: Ptr CallbackHook -> IO ()
freeCallbackHook ptr :: Ptr CallbackHook
ptr = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Ptr CallbackHook
ptr Ptr CallbackHook -> Ptr CallbackHook -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CallbackHook
forall a. Ptr a
F.nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let stablePtr :: StablePtr a
stablePtr = Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
F.castPtrToStablePtr (Ptr () -> StablePtr a) -> Ptr () -> StablePtr a
forall a b. (a -> b) -> a -> b
$ Ptr CallbackHook -> Ptr ()
forall a b. Ptr a -> Ptr b
F.castPtr Ptr CallbackHook
ptr
CallbackHook
hook <- StablePtr CallbackHook -> IO CallbackHook
forall a. StablePtr a -> IO a
F.deRefStablePtr StablePtr CallbackHook
forall a. StablePtr a
stablePtr
StablePtr Any -> IO ()
forall a. StablePtr a -> IO ()
F.freeStablePtr StablePtr Any
forall a. StablePtr a
stablePtr
let (CallbackHook funPtr :: FunPtr CallbackFn
funPtr _) = CallbackHook
hook
FunPtr CallbackFn -> IO ()
forall a. FunPtr a -> IO ()
F.freeHaskellFunPtr FunPtr CallbackFn
funPtr
callbackImpl :: (Property -> Session Progress) -> CallbackFn
callbackImpl :: (Property -> Session Progress) -> CallbackFn
callbackImpl cb :: Property -> Session Progress
cb _ sctx :: Ptr SessionCtx
sctx cProp :: CInt
cProp = let
globalIO :: a
globalIO = String -> a
forall a. HasCallStack => String -> a
error "globalIO is not implemented"
sessionIO :: IO CInt
sessionIO = do
let session :: Session Progress
session = Property -> Session Progress
cb (Property -> Session Progress) -> Property -> Session Progress
forall a b. (a -> b) -> a -> b
$ CInt -> Property
cToProperty CInt
cProp
Progress -> CInt
cFromProgress (Progress -> CInt) -> IO Progress -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT SessionCtx IO Progress -> SessionCtx -> IO Progress
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
R.runReaderT (Session Progress -> ReaderT SessionCtx IO Progress
forall a. Session a -> ReaderT SessionCtx IO a
unSession Session Progress
session) (Ptr SessionCtx -> SessionCtx
SessionCtx Ptr SessionCtx
sctx)
onError :: SASLException -> IO F.CInt
onError :: SASLException -> IO CInt
onError (SASLException err :: Error
err) = CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> IO CInt) -> CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ Error -> CInt
cFromError Error
err
onException :: E.SomeException -> IO F.CInt
onException :: SomeException -> IO CInt
onException exc :: SomeException
exc = do
StablePtr SomeException
stablePtr <- SomeException -> IO (StablePtr SomeException)
forall a. a -> IO (StablePtr a)
F.newStablePtr SomeException
exc
Ptr SessionCtx -> Ptr () -> IO ()
forall a. Ptr SessionCtx -> Ptr a -> IO ()
gsasl_session_hook_set Ptr SessionCtx
sctx (Ptr () -> IO ()) -> Ptr () -> IO ()
forall a b. (a -> b) -> a -> b
$ StablePtr SomeException -> Ptr ()
forall a. StablePtr a -> Ptr ()
F.castStablePtrToPtr StablePtr SomeException
stablePtr
CInt -> IO CInt
forall (m :: * -> *) a. Monad m => a -> m a
return (-1)
catchErrors :: IO CInt -> IO CInt
catchErrors io :: IO CInt
io = IO CInt -> [Handler CInt] -> IO CInt
forall a. IO a -> [Handler a] -> IO a
E.catches IO CInt
io [(SASLException -> IO CInt) -> Handler CInt
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler SASLException -> IO CInt
onError, (SomeException -> IO CInt) -> Handler CInt
forall a e. Exception e => (e -> IO a) -> Handler a
E.Handler SomeException -> IO CInt
onException]
in IO CInt -> IO CInt
catchErrors (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ if Ptr SessionCtx
sctx Ptr SessionCtx -> Ptr SessionCtx -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr SessionCtx
forall a. Ptr a
F.nullPtr then IO CInt
forall a. a
globalIO else IO CInt
sessionIO
foreign import ccall "wrapper"
wrapCallbackImpl :: CallbackFn -> IO (F.FunPtr CallbackFn)
checkCallbackException :: F.Ptr SessionCtx -> IO ()
checkCallbackException :: Ptr SessionCtx -> IO ()
checkCallbackException sctx :: Ptr SessionCtx
sctx = do
Ptr ()
hook <- Ptr SessionCtx -> IO (Ptr ())
forall a. Ptr SessionCtx -> IO (Ptr a)
gsasl_session_hook_get Ptr SessionCtx
sctx
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr ()
hook Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ()
forall a. Ptr a
F.nullPtr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let stable :: StablePtr a
stable = Ptr () -> StablePtr a
forall a. Ptr () -> StablePtr a
F.castPtrToStablePtr Ptr ()
hook
SomeException
exc <- StablePtr SomeException -> IO SomeException
forall a. StablePtr a -> IO a
F.deRefStablePtr StablePtr SomeException
forall a. StablePtr a
stable
StablePtr Any -> IO ()
forall a. StablePtr a -> IO ()
F.freeStablePtr StablePtr Any
forall a. StablePtr a
stable
SomeException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (SomeException
exc :: E.SomeException)
setCallback :: (Property -> Session Progress) -> SASL ()
setCallback :: (Property -> Session Progress) -> SASL ()
setCallback cb :: Property -> Session Progress
cb = do
Ptr Context
ctx <- SASL (Ptr Context)
getContext
IO () -> SASL ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> SASL ()) -> IO () -> SASL ()
forall a b. (a -> b) -> a -> b
$ do
Ptr CallbackHook -> IO ()
freeCallbackHook (Ptr CallbackHook -> IO ()) -> IO (Ptr CallbackHook) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr Context -> IO (Ptr CallbackHook)
forall a. Ptr Context -> IO (Ptr a)
gsasl_callback_hook_get Ptr Context
ctx
(hook :: Ptr CallbackHook
hook, cbPtr :: FunPtr CallbackFn
cbPtr) <- (Property -> Session Progress)
-> IO (Ptr CallbackHook, FunPtr CallbackFn)
newCallbackHook Property -> Session Progress
cb
Ptr Context -> Ptr CallbackHook -> IO ()
forall a. Ptr Context -> Ptr a -> IO ()
gsasl_callback_hook_set Ptr Context
ctx Ptr CallbackHook
hook
Ptr Context -> FunPtr CallbackFn -> IO ()
gsasl_callback_set Ptr Context
ctx FunPtr CallbackFn
cbPtr
runCallback :: Property -> Session Progress
runCallback :: Property -> Session Progress
runCallback prop :: Property
prop = do
Ptr Context
ctx <- (Ptr SessionCtx -> Ptr Context)
-> Session (Ptr SessionCtx) -> Session (Ptr Context)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Ptr SessionCtx -> Ptr Context
forall a b. Ptr a -> Ptr b
F.castPtr Session (Ptr SessionCtx)
getSessionContext
Ptr ()
hookPtr <- IO (Ptr ()) -> Session (Ptr ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr ()) -> Session (Ptr ()))
-> IO (Ptr ()) -> Session (Ptr ())
forall a b. (a -> b) -> a -> b
$ Ptr Context -> IO (Ptr ())
forall a. Ptr Context -> IO (Ptr a)
gsasl_callback_hook_get Ptr Context
ctx
Bool -> Session () -> Session ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Ptr ()
hookPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
F.nullPtr) (Session () -> Session ()) -> Session () -> Session ()
forall a b. (a -> b) -> a -> b
$ Error -> Session ()
forall a. Error -> Session a
throw Error
NoCallback
CallbackHook
hook <- IO CallbackHook -> Session CallbackHook
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CallbackHook -> Session CallbackHook)
-> IO CallbackHook -> Session CallbackHook
forall a b. (a -> b) -> a -> b
$ StablePtr CallbackHook -> IO CallbackHook
forall a. StablePtr a -> IO a
F.deRefStablePtr (StablePtr CallbackHook -> IO CallbackHook)
-> StablePtr CallbackHook -> IO CallbackHook
forall a b. (a -> b) -> a -> b
$ Ptr () -> StablePtr CallbackHook
forall a. Ptr () -> StablePtr a
F.castPtrToStablePtr Ptr ()
hookPtr
let (CallbackHook _ cb :: Property -> Session Progress
cb) = CallbackHook
hook
Property -> Session Progress
cb Property
prop
data Progress = Complete | NeedsMore
deriving (Int -> Progress -> String -> String
[Progress] -> String -> String
Progress -> String
(Int -> Progress -> String -> String)
-> (Progress -> String)
-> ([Progress] -> String -> String)
-> Show Progress
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Progress] -> String -> String
$cshowList :: [Progress] -> String -> String
show :: Progress -> String
$cshow :: Progress -> String
showsPrec :: Int -> Progress -> String -> String
$cshowsPrec :: Int -> Progress -> String -> String
Show, Progress -> Progress -> Bool
(Progress -> Progress -> Bool)
-> (Progress -> Progress -> Bool) -> Eq Progress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Progress -> Progress -> Bool
$c/= :: Progress -> Progress -> Bool
== :: Progress -> Progress -> Bool
$c== :: Progress -> Progress -> Bool
Eq)
cFromProgress :: Progress -> F.CInt
cFromProgress :: Progress -> CInt
cFromProgress x :: Progress
x = case Progress
x of
Complete -> 0
NeedsMore -> 1
step :: B.ByteString -> Session (B.ByteString, Progress)
step :: ByteString -> Session (ByteString, Progress)
step input :: ByteString
input = (Ptr SessionCtx -> IO (CString, CSize, Progress))
-> ((CString, CSize, Progress) -> IO ())
-> ((CString, CSize, Progress) -> IO (ByteString, Progress))
-> Session (ByteString, Progress)
forall a b c.
(Ptr SessionCtx -> IO a) -> (a -> IO b) -> (a -> IO c) -> Session c
bracketSession Ptr SessionCtx -> IO (CString, CSize, Progress)
get (CString, CSize, Progress) -> IO ()
forall a b c. (Ptr a, b, c) -> IO ()
free (CString, CSize, Progress) -> IO (ByteString, Progress)
forall a b. Integral a => (CString, a, b) -> IO (ByteString, b)
peek where
get :: Ptr SessionCtx -> IO (CString, CSize, Progress)
get sctx :: Ptr SessionCtx
sctx =
ByteString
-> (CStringLen -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
input ((CStringLen -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress))
-> (CStringLen -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress)
forall a b. (a -> b) -> a -> b
$ \(pInput :: CString
pInput, inputLen :: Int
inputLen) ->
(Ptr CString -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress))
-> (Ptr CString -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress)
forall a b. (a -> b) -> a -> b
$ \pOutput :: Ptr CString
pOutput ->
(Ptr CSize -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CSize -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress))
-> (Ptr CSize -> IO (CString, CSize, Progress))
-> IO (CString, CSize, Progress)
forall a b. (a -> b) -> a -> b
$ \pOutputLen :: Ptr CSize
pOutputLen -> do
CInt
rc <- Ptr SessionCtx
-> CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt
gsasl_step Ptr SessionCtx
sctx CString
pInput (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inputLen) Ptr CString
pOutput Ptr CSize
pOutputLen
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SessionCtx -> IO ()
checkCallbackException Ptr SessionCtx
sctx
Progress
progress <- CInt -> IO Progress
checkStepRC CInt
rc
CSize
cstrLen <- Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
F.peek Ptr CSize
pOutputLen
CString
cstr <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
pOutput
(CString, CSize, Progress) -> IO (CString, CSize, Progress)
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
cstr, CSize
cstrLen, Progress
progress)
free :: (Ptr a, b, c) -> IO ()
free (cstr :: Ptr a
cstr, _, _) = Ptr a -> IO ()
forall a. Ptr a -> IO ()
gsasl_free Ptr a
cstr
peek :: (CString, a, b) -> IO (ByteString, b)
peek (cstr :: CString
cstr, cstrLen :: a
cstrLen, progress :: b
progress) = do
ByteString
output <- CStringLen -> IO ByteString
B.packCStringLen (CString
cstr, a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
cstrLen)
(ByteString, b) -> IO (ByteString, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
output, b
progress)
step64 :: B.ByteString -> Session (B.ByteString, Progress)
step64 :: ByteString -> Session (ByteString, Progress)
step64 input :: ByteString
input = (Ptr SessionCtx -> IO (CString, Progress))
-> ((CString, Progress) -> IO ())
-> ((CString, Progress) -> IO (ByteString, Progress))
-> Session (ByteString, Progress)
forall a b c.
(Ptr SessionCtx -> IO a) -> (a -> IO b) -> (a -> IO c) -> Session c
bracketSession Ptr SessionCtx -> IO (CString, Progress)
get (CString, Progress) -> IO ()
forall a b. (Ptr a, b) -> IO ()
free (CString, Progress) -> IO (ByteString, Progress)
forall b. (CString, b) -> IO (ByteString, b)
peek where
get :: Ptr SessionCtx -> IO (CString, Progress)
get sctx :: Ptr SessionCtx
sctx =
ByteString
-> (CString -> IO (CString, Progress)) -> IO (CString, Progress)
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
input ((CString -> IO (CString, Progress)) -> IO (CString, Progress))
-> (CString -> IO (CString, Progress)) -> IO (CString, Progress)
forall a b. (a -> b) -> a -> b
$ \pInput :: CString
pInput ->
(Ptr CString -> IO (CString, Progress)) -> IO (CString, Progress)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO (CString, Progress)) -> IO (CString, Progress))
-> (Ptr CString -> IO (CString, Progress))
-> IO (CString, Progress)
forall a b. (a -> b) -> a -> b
$ \pOutput :: Ptr CString
pOutput -> do
CInt
rc <- Ptr SessionCtx -> CString -> Ptr CString -> IO CInt
gsasl_step64 Ptr SessionCtx
sctx CString
pInput Ptr CString
pOutput
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SessionCtx -> IO ()
checkCallbackException Ptr SessionCtx
sctx
Progress
progress <- CInt -> IO Progress
checkStepRC CInt
rc
CString
cstr <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
pOutput
(CString, Progress) -> IO (CString, Progress)
forall (m :: * -> *) a. Monad m => a -> m a
return (CString
cstr, Progress
progress)
free :: (Ptr a, b) -> IO ()
free (cstr :: Ptr a
cstr, _) = Ptr a -> IO ()
forall a. Ptr a -> IO ()
gsasl_free Ptr a
cstr
peek :: (CString, b) -> IO (ByteString, b)
peek (cstr :: CString
cstr, progress :: b
progress) = do
ByteString
output <- CString -> IO ByteString
B.packCString CString
cstr
(ByteString, b) -> IO (ByteString, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
output, b
progress)
checkStepRC :: F.CInt -> IO Progress
checkStepRC :: CInt -> IO Progress
checkStepRC x :: CInt
x = case CInt
x of
0 -> Progress -> IO Progress
forall (m :: * -> *) a. Monad m => a -> m a
return Progress
Complete
1 -> Progress -> IO Progress
forall (m :: * -> *) a. Monad m => a -> m a
return Progress
NeedsMore
_ -> SASLException -> IO Progress
forall e a. Exception e => e -> IO a
E.throwIO (Error -> SASLException
SASLException (CInt -> Error
cToError CInt
x))
encodeDecodeHelper :: (F.Storable a, Integral a, Num t) =>
(F.Ptr SessionCtx -> F.Ptr F.CChar -> t -> F.Ptr (F.Ptr F.CChar) -> F.Ptr a -> IO F.CInt)
-> B.ByteString
-> Session B.ByteString
encodeDecodeHelper :: (Ptr SessionCtx -> CString -> t -> Ptr CString -> Ptr a -> IO CInt)
-> ByteString -> Session ByteString
encodeDecodeHelper f :: Ptr SessionCtx -> CString -> t -> Ptr CString -> Ptr a -> IO CInt
f input :: ByteString
input = do
Ptr SessionCtx
sctx <- Session (Ptr SessionCtx)
getSessionContext
IO ByteString -> Session ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Session ByteString)
-> IO ByteString -> Session ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
input ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(cstr :: CString
cstr, cstrLen :: Int
cstrLen) ->
(Ptr CString -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO ByteString) -> IO ByteString)
-> (Ptr CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pOutput :: Ptr CString
pOutput ->
(Ptr a -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr a -> IO ByteString) -> IO ByteString)
-> (Ptr a -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pOutputLen :: Ptr a
pOutputLen -> do
CInt
rc <- Ptr SessionCtx -> CString -> t -> Ptr CString -> Ptr a -> IO CInt
f Ptr SessionCtx
sctx CString
cstr (Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cstrLen) Ptr CString
pOutput Ptr a
pOutputLen
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SessionCtx -> IO ()
checkCallbackException Ptr SessionCtx
sctx
CInt -> IO ()
checkRC CInt
rc
CString
output <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
pOutput
Int
outputLen <- a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int) -> IO a -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
F.peek Ptr a
pOutputLen
ByteString
outputBytes <- CStringLen -> IO ByteString
B.packCStringLen (CString
output, Int
outputLen)
CString -> IO ()
forall a. Ptr a -> IO ()
gsasl_free CString
output
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
outputBytes
encode :: B.ByteString -> Session B.ByteString
encode :: ByteString -> Session ByteString
encode = (Ptr SessionCtx
-> CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt)
-> ByteString -> Session ByteString
forall a t.
(Storable a, Integral a, Num t) =>
(Ptr SessionCtx -> CString -> t -> Ptr CString -> Ptr a -> IO CInt)
-> ByteString -> Session ByteString
encodeDecodeHelper Ptr SessionCtx
-> CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt
gsasl_encode
decode :: B.ByteString -> Session B.ByteString
decode :: ByteString -> Session ByteString
decode = (Ptr SessionCtx
-> CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt)
-> ByteString -> Session ByteString
forall a t.
(Storable a, Integral a, Num t) =>
(Ptr SessionCtx -> CString -> t -> Ptr CString -> Ptr a -> IO CInt)
-> ByteString -> Session ByteString
encodeDecodeHelper Ptr SessionCtx
-> CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt
gsasl_decode
base64Helper :: (F.Storable a, Integral a, Num t) =>
(F.Ptr F.CChar -> t -> F.Ptr (F.Ptr F.CChar) -> F.Ptr a -> IO F.CInt)
-> B.ByteString
-> B.ByteString
base64Helper :: (CString -> t -> Ptr CString -> Ptr a -> IO CInt)
-> ByteString -> ByteString
base64Helper f :: CString -> t -> Ptr CString -> Ptr a -> IO CInt
f input :: ByteString
input = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
input ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(pIn :: CString
pIn, inLen :: Int
inLen) ->
(Ptr CString -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO ByteString) -> IO ByteString)
-> (Ptr CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pOut :: Ptr CString
pOut ->
(Ptr a -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr a -> IO ByteString) -> IO ByteString)
-> (Ptr a -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pOutLen :: Ptr a
pOutLen -> do
CString -> t -> Ptr CString -> Ptr a -> IO CInt
f CString
pIn (Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen) Ptr CString
pOut Ptr a
pOutLen IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
a
outLen <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
F.peek Ptr a
pOutLen
CString
outPtr <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
pOut
CStringLen -> IO ByteString
B.packCStringLen (CString
outPtr, a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
outLen)
toBase64 :: B.ByteString -> B.ByteString
toBase64 :: ByteString -> ByteString
toBase64 = (CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt)
-> ByteString -> ByteString
forall a t.
(Storable a, Integral a, Num t) =>
(CString -> t -> Ptr CString -> Ptr a -> IO CInt)
-> ByteString -> ByteString
base64Helper CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt
gsasl_base64_to
fromBase64 :: B.ByteString -> B.ByteString
fromBase64 :: ByteString -> ByteString
fromBase64 = (CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt)
-> ByteString -> ByteString
forall a t.
(Storable a, Integral a, Num t) =>
(CString -> t -> Ptr CString -> Ptr a -> IO CInt)
-> ByteString -> ByteString
base64Helper CString -> CSize -> Ptr CString -> Ptr CSize -> IO CInt
gsasl_base64_from
md5 :: B.ByteString -> B.ByteString
md5 :: ByteString -> ByteString
md5 input :: ByteString
input = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
input ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(pIn :: CString
pIn, inLen :: Int
inLen) ->
(Ptr CString -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO ByteString) -> IO ByteString)
-> (Ptr CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pOut :: Ptr CString
pOut ->
Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
F.allocaBytes 16 ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \outBuf :: CString
outBuf -> do
Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr CString
pOut CString
outBuf
CString -> CSize -> Ptr CString -> IO CInt
gsasl_md5 CString
pIn (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen) Ptr CString
pOut IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
CStringLen -> IO ByteString
B.packCStringLen (CString
outBuf, 16)
sha1 :: B.ByteString -> B.ByteString
sha1 :: ByteString -> ByteString
sha1 input :: ByteString
input = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
input ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(pIn :: CString
pIn, inLen :: Int
inLen) ->
(Ptr CString -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO ByteString) -> IO ByteString)
-> (Ptr CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pOut :: Ptr CString
pOut -> do
CString -> CSize -> Ptr CString -> IO CInt
gsasl_sha1 CString
pIn (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen) Ptr CString
pOut IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
CString
outBuf <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
F.peek Ptr CString
pOut
ByteString
ret <- CStringLen -> IO ByteString
B.packCStringLen (CString
outBuf, 20)
CString -> IO ()
forall a. Ptr a -> IO ()
F.free CString
outBuf
ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
ret
hmacMD5 :: B.ByteString
-> B.ByteString
-> B.ByteString
hmacMD5 :: ByteString -> ByteString -> ByteString
hmacMD5 key :: ByteString
key input :: ByteString
input = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(pKey :: CString
pKey, keyLen :: Int
keyLen) ->
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
input ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(pIn :: CString
pIn, inLen :: Int
inLen) ->
(Ptr CString -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO ByteString) -> IO ByteString)
-> (Ptr CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pOut :: Ptr CString
pOut ->
Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
F.allocaBytes 16 ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \outBuf :: CString
outBuf -> do
Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr CString
pOut CString
outBuf
CString -> CSize -> CString -> CSize -> Ptr CString -> IO CInt
gsasl_hmac_md5 CString
pKey (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyLen) CString
pIn (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen) Ptr CString
pOut IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
CStringLen -> IO ByteString
B.packCStringLen (CString
outBuf, 16)
hmacSHA1 :: B.ByteString
-> B.ByteString
-> B.ByteString
hmacSHA1 :: ByteString -> ByteString -> ByteString
hmacSHA1 key :: ByteString
key input :: ByteString
input = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
key ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(pKey :: CString
pKey, keyLen :: Int
keyLen) ->
ByteString -> (CStringLen -> IO ByteString) -> IO ByteString
forall a. ByteString -> (CStringLen -> IO a) -> IO a
B.unsafeUseAsCStringLen ByteString
input ((CStringLen -> IO ByteString) -> IO ByteString)
-> (CStringLen -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \(pIn :: CString
pIn, inLen :: Int
inLen) ->
(Ptr CString -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
F.alloca ((Ptr CString -> IO ByteString) -> IO ByteString)
-> (Ptr CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \pOut :: Ptr CString
pOut ->
Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
F.allocaBytes 20 ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \outBuf :: CString
outBuf -> do
Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
F.poke Ptr CString
pOut CString
outBuf
CString -> CSize -> CString -> CSize -> Ptr CString -> IO CInt
gsasl_hmac_sha1 CString
pKey (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyLen) CString
pIn (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
inLen) Ptr CString
pOut IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
CStringLen -> IO ByteString
B.packCStringLen (CString
outBuf, 20)
nonce :: Integer -> IO B.ByteString
nonce :: Integer -> IO ByteString
nonce size :: Integer
size = Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
F.allocaBytes (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
size) ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \buf :: CString
buf -> do
CString -> CSize -> IO CInt
gsasl_nonce CString
buf (Integer -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size) IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
CStringLen -> IO ByteString
B.packCStringLen (CString
buf, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size)
random :: Integer -> IO B.ByteString
random :: Integer -> IO ByteString
random size :: Integer
size = Int -> (CString -> IO ByteString) -> IO ByteString
forall a b. Int -> (Ptr a -> IO b) -> IO b
F.allocaBytes (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
size) ((CString -> IO ByteString) -> IO ByteString)
-> (CString -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \buf :: CString
buf -> do
CString -> CSize -> IO CInt
gsasl_random CString
buf (Integer -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size) IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CInt -> IO ()
checkRC
CStringLen -> IO ByteString
B.packCStringLen (CString
buf, Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size)
checkRC :: F.CInt -> IO ()
checkRC :: CInt -> IO ()
checkRC x :: CInt
x = case CInt
x of
0 -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> SASLException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO (Error -> SASLException
SASLException (CInt -> Error
cToError CInt
x))
foreign import ccall "hsgsasl_VERSION_MAJOR"
hsgsasl_VERSION_MAJOR :: F.CInt
foreign import ccall "hsgsasl_VERSION_MINOR"
hsgsasl_VERSION_MINOR :: F.CInt
foreign import ccall "hsgsasl_VERSION_PATCH"
hsgsasl_VERSION_PATCH :: F.CInt
foreign import ccall "hsgsasl_check_version"
hsgsasl_check_version :: IO F.CInt
foreign import ccall "gsasl.h gsasl_init"
gsasl_init :: F.Ptr (F.Ptr Context) -> IO F.CInt
foreign import ccall "gsasl.h gsasl_done"
gsasl_done :: F.Ptr Context -> IO ()
foreign import ccall "gsasl.h gsasl_check_version"
gsasl_check_version :: F.CString -> IO F.CString
foreign import ccall "gsasl.h gsasl_callback_set"
gsasl_callback_set :: F.Ptr Context -> F.FunPtr CallbackFn -> IO ()
foreign import ccall "gsasl.h gsasl_callback_hook_get"
gsasl_callback_hook_get :: F.Ptr Context -> IO (F.Ptr a)
foreign import ccall "gsasl.h gsasl_callback_hook_set"
gsasl_callback_hook_set :: F.Ptr Context -> F.Ptr a -> IO ()
foreign import ccall "gsasl.h gsasl_session_hook_get"
gsasl_session_hook_get :: F.Ptr SessionCtx -> IO (F.Ptr a)
foreign import ccall "gsasl.h gsasl_session_hook_set"
gsasl_session_hook_set :: F.Ptr SessionCtx -> F.Ptr a -> IO ()
foreign import ccall "gsasl.h gsasl_property_set"
gsasl_property_set :: F.Ptr SessionCtx -> F.CInt -> F.CString -> IO ()
foreign import ccall safe "gsasl.h gsasl_property_get"
gsasl_property_get :: F.Ptr SessionCtx -> F.CInt -> IO F.CString
foreign import ccall "gsasl.h gsasl_property_fast"
gsasl_property_fast :: F.Ptr SessionCtx -> F.CInt -> IO F.CString
foreign import ccall "gsasl.h gsasl_client_mechlist"
gsasl_client_mechlist :: F.Ptr Context -> F.Ptr F.CString -> IO F.CInt
foreign import ccall "gsasl.h gsasl_client_support_p"
gsasl_client_support_p :: F.Ptr Context -> F.CString -> IO F.CInt
foreign import ccall "gsasl.h gsasl_client_suggest_mechanism"
gsasl_client_suggest_mechanism :: F.Ptr Context -> F.CString -> IO F.CString
foreign import ccall "gsasl.h gsasl_server_mechlist"
gsasl_server_mechlist :: F.Ptr Context -> F.Ptr F.CString -> IO F.CInt
foreign import ccall "gsasl.h gsasl_server_support_p"
gsasl_server_support_p :: F.Ptr Context -> F.CString -> IO F.CInt
foreign import ccall safe "gsasl.h gsasl_client_start"
gsasl_client_start :: SessionProc
foreign import ccall safe "gsasl.h gsasl_server_start"
gsasl_server_start :: SessionProc
foreign import ccall safe "gsasl.h gsasl_step"
gsasl_step :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall safe "gsasl.h gsasl_step64"
gsasl_step64 :: F.Ptr SessionCtx -> F.CString -> F.Ptr F.CString -> IO F.CInt
foreign import ccall safe "gsasl.h gsasl_finish"
gsasl_finish :: F.Ptr SessionCtx -> IO ()
foreign import ccall safe "gsasl.h gsasl_encode"
gsasl_encode :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall safe "gsasl.h gsasl_decode"
gsasl_decode :: F.Ptr SessionCtx -> F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall "gsasl.h gsasl_mechanism_name"
gsasl_mechanism_name :: F.Ptr SessionCtx -> IO F.CString
foreign import ccall "gsasl.h gsasl_strerror"
gsasl_strerror :: F.CInt -> IO F.CString
foreign import ccall "gsasl.h gsasl_base64_to"
gsasl_base64_to :: F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall "gsasl.h gsasl_base64_from"
gsasl_base64_from :: F.CString -> F.CSize -> F.Ptr F.CString -> F.Ptr F.CSize -> IO F.CInt
foreign import ccall "gsasl.h gsasl_md5"
gsasl_md5 :: F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt
foreign import ccall "gsasl.h gsasl_sha1"
gsasl_sha1 :: F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt
foreign import ccall "gsasl.h gsasl_hmac_md5"
gsasl_hmac_md5 :: F.CString -> F.CSize -> F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt
foreign import ccall "gsasl.h gsasl_hmac_sha1"
gsasl_hmac_sha1 :: F.CString -> F.CSize -> F.CString -> F.CSize -> F.Ptr F.CString -> IO F.CInt
foreign import ccall "gsasl.h gsasl_nonce"
gsasl_nonce :: F.CString -> F.CSize -> IO F.CInt
foreign import ccall "gsasl.h gsasl_random"
gsasl_random :: F.CString -> F.CSize -> IO F.CInt
foreign import ccall "gsasl.h gsasl_free"
gsasl_free :: F.Ptr a -> IO ()