-- | <https://tools.ietf.org/html/rfc4511#section-4.2 Bind> operation.
--
-- This operation comes in four flavours:
--
--   * synchronous, exception throwing ('bind')
--
--   * synchronous, returning 'Either' 'ResponseError' @()@ ('bindEither')
--
--   * asynchronous, 'IO' based ('bindAsync')
--
--   * asynchronous, 'STM' based ('bindAsyncSTM')
--
-- Of those, the first one ('bind') is probably the most useful for the typical usecase.
module Ldap.Client.Bind
  ( Password(..)
  , bind
  , bindEither
  , bindAsync
  , bindAsyncSTM
  , externalBind
  , externalBindEither
  , externalBindAsync
  , externalBindAsyncSTM
  , Async
  , wait
  , waitSTM
  ) where

import           Control.Monad.STM (STM, atomically)
import           Data.ByteString (ByteString)
import           Data.Text (Text)
import           Data.List.NonEmpty (NonEmpty((:|)))

import qualified Ldap.Asn1.Type as Type
import           Ldap.Client.Internal


-- | User's password.
newtype Password = Password ByteString
    deriving (Int -> Password -> ShowS
[Password] -> ShowS
Password -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Password] -> ShowS
$cshowList :: [Password] -> ShowS
show :: Password -> String
$cshow :: Password -> String
showsPrec :: Int -> Password -> ShowS
$cshowsPrec :: Int -> Password -> ShowS
Show, Password -> Password -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Password -> Password -> Bool
$c/= :: Password -> Password -> Bool
== :: Password -> Password -> Bool
$c== :: Password -> Password -> Bool
Eq)

-- | Perform the Bind operation synchronously. Raises 'ResponseError' on failures.
bind :: Ldap -> Dn -> Password -> IO ()
bind :: Ldap -> Dn -> Password -> IO ()
bind Ldap
l Dn
username Password
password =
  forall e a. Exception e => Either e a -> IO a
raise forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ldap -> Dn -> Password -> IO (Either ResponseError ())
bindEither Ldap
l Dn
username Password
password

-- | Perform the Bind operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures.
bindEither :: Ldap -> Dn -> Password -> IO (Either ResponseError ())
bindEither :: Ldap -> Dn -> Password -> IO (Either ResponseError ())
bindEither Ldap
l Dn
username Password
password =
  forall a. Async a -> IO (Either ResponseError a)
wait forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ldap -> Dn -> Password -> IO (Async ())
bindAsync Ldap
l Dn
username Password
password

-- | Perform the Bind operation asynchronously. Call 'Ldap.Client.wait' to wait
-- for its completion.
bindAsync :: Ldap -> Dn -> Password -> IO (Async ())
bindAsync :: Ldap -> Dn -> Password -> IO (Async ())
bindAsync Ldap
l Dn
username Password
password =
  forall a. STM a -> IO a
atomically (Ldap -> Dn -> Password -> STM (Async ())
bindAsyncSTM Ldap
l Dn
username Password
password)

-- | Perform the Bind operation asynchronously.
--
-- Don't wait for its completion (with 'Ldap.Client.waitSTM') in the
-- same transaction you've performed it in.
bindAsyncSTM :: Ldap -> Dn -> Password -> STM (Async ())
bindAsyncSTM :: Ldap -> Dn -> Password -> STM (Async ())
bindAsyncSTM Ldap
l Dn
username Password
password =
  let req :: Request
req = Dn -> Password -> Request
bindRequest Dn
username Password
password in forall a.
Ldap
-> (Response -> Either ResponseError a) -> Request -> STM (Async a)
sendRequest Ldap
l (Request -> Response -> Either ResponseError ()
bindResult Request
req) Request
req

bindRequest :: Dn -> Password -> Request
bindRequest :: Dn -> Password -> Request
bindRequest (Dn Text
username) (Password ByteString
password) =
  Int8 -> LdapDn -> AuthenticationChoice -> Request
Type.BindRequest Int8
ldapVersion
                   (LdapString -> LdapDn
Type.LdapDn (Text -> LdapString
Type.LdapString Text
username))
                   (ByteString -> AuthenticationChoice
Type.Simple ByteString
password)
 where
  ldapVersion :: Int8
ldapVersion = Int8
3

bindResult :: Request -> Response -> Either ResponseError ()
bindResult :: Request -> Response -> Either ResponseError ()
bindResult Request
req (Type.BindResponse (Type.LdapResult ResultCode
code (Type.LdapDn (Type.LdapString Text
dn))
                                                        (Type.LdapString Text
msg) Maybe ReferralUris
_) Maybe ByteString
_ :| [])
  | ResultCode
Type.Success <- ResultCode
code = forall a b. b -> Either a b
Right ()
  | Bool
otherwise = forall a b. a -> Either a b
Left (Request -> ResultCode -> Dn -> Text -> ResponseError
ResponseErrorCode Request
req ResultCode
code (Text -> Dn
Dn Text
dn) Text
msg)
bindResult Request
req Response
res = forall a b. a -> Either a b
Left (Request -> Response -> ResponseError
ResponseInvalid Request
req Response
res)

-- | Perform a SASL EXTERNAL Bind operation synchronously. Raises 'ResponseError' on failures.
externalBind :: Ldap -> Dn -> Maybe Text -> IO ()
externalBind :: Ldap -> Dn -> Maybe Text -> IO ()
externalBind Ldap
l Dn
username Maybe Text
mCredentials =
  forall e a. Exception e => Either e a -> IO a
raise forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ldap -> Dn -> Maybe Text -> IO (Either ResponseError ())
externalBindEither Ldap
l Dn
username Maybe Text
mCredentials

-- | Perform a SASL EXTERNAL Bind operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures.
externalBindEither :: Ldap -> Dn -> Maybe Text -> IO (Either ResponseError ())
externalBindEither :: Ldap -> Dn -> Maybe Text -> IO (Either ResponseError ())
externalBindEither Ldap
l Dn
username Maybe Text
mCredentials =
  forall a. Async a -> IO (Either ResponseError a)
wait forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ldap -> Dn -> Maybe Text -> IO (Async ())
externalBindAsync Ldap
l Dn
username Maybe Text
mCredentials

-- | Perform the SASL EXTERNAL Bind operation asynchronously. Call 'Ldap.Client.wait' to wait
-- for its completion.
externalBindAsync :: Ldap -> Dn -> Maybe Text -> IO (Async ())
externalBindAsync :: Ldap -> Dn -> Maybe Text -> IO (Async ())
externalBindAsync Ldap
l Dn
username Maybe Text
mCredentials =
  forall a. STM a -> IO a
atomically (Ldap -> Dn -> Maybe Text -> STM (Async ())
externalBindAsyncSTM Ldap
l Dn
username Maybe Text
mCredentials)

-- | Perform the SASL EXTERNAL Bind operation asynchronously.
--
-- Don't wait for its completion (with 'Ldap.Client.waitSTM') in the
-- same transaction you've performed it in.
externalBindAsyncSTM :: Ldap -> Dn -> Maybe Text -> STM (Async ())
externalBindAsyncSTM :: Ldap -> Dn -> Maybe Text -> STM (Async ())
externalBindAsyncSTM Ldap
l Dn
username Maybe Text
mCredentials =
  let req :: Request
req = Dn -> Maybe Text -> Request
externalBindRequest Dn
username Maybe Text
mCredentials in forall a.
Ldap
-> (Response -> Either ResponseError a) -> Request -> STM (Async a)
sendRequest Ldap
l (Request -> Response -> Either ResponseError ()
bindResult Request
req) Request
req

externalBindRequest :: Dn -> Maybe Text -> Request
externalBindRequest :: Dn -> Maybe Text -> Request
externalBindRequest (Dn Text
username) Maybe Text
mCredentials =
  Int8 -> LdapDn -> AuthenticationChoice -> Request
Type.BindRequest Int8
ldapVersion
                   (LdapString -> LdapDn
Type.LdapDn (Text -> LdapString
Type.LdapString Text
username))
                   (SaslMechanism -> Maybe Text -> AuthenticationChoice
Type.Sasl SaslMechanism
Type.External Maybe Text
mCredentials)
 where
  ldapVersion :: Int8
ldapVersion = Int8
3