{-# LANGUAGE OverloadedStrings #-}
-- | <https://tools.ietf.org/html/rfc4511#section-4.12 Extended> operation.
--
-- This operation comes in four flavours:
--
--   * synchronous, exception throwing ('extended')
--
--   * synchronous, returning 'Either' 'ResponseError' @()@ ('extendedEither')
--
--   * asynchronous, 'IO' based ('extendedAsync')
--
--   * asynchronous, 'STM' based ('extendedAsyncSTM')
--
-- Of those, the first one ('extended') is probably the most useful for the typical usecase.
module Ldap.Client.Extended
  ( -- * Extended Operation
    Oid(..)
  , extended
  , extendedEither
  , extendedAsync
  , extendedAsyncSTM
    -- * StartTLS Operation
  , startTls
  , startTlsEither
  , startTlsAsync
  , startTlsAsyncSTM
    -- * OIDs
  , noticeOfDisconnectionOid
  , startTlsOid
  , Async
  , wait
  , waitSTM
  ) where

import           Control.Monad ((<=<))
import           Control.Monad.STM (STM, atomically)
import           Data.ByteString (ByteString)
import           Data.List.NonEmpty (NonEmpty((:|)))
import           Data.String (IsString(fromString))
import           Data.Text (Text)

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


-- | Globally unique LDAP object identifier.
newtype Oid = Oid Text
    deriving (Int -> Oid -> ShowS
[Oid] -> ShowS
Oid -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Oid] -> ShowS
$cshowList :: [Oid] -> ShowS
show :: Oid -> String
$cshow :: Oid -> String
showsPrec :: Int -> Oid -> ShowS
$cshowsPrec :: Int -> Oid -> ShowS
Show, Oid -> Oid -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Oid -> Oid -> Bool
$c/= :: Oid -> Oid -> Bool
== :: Oid -> Oid -> Bool
$c== :: Oid -> Oid -> Bool
Eq)

instance IsString Oid where
  fromString :: String -> Oid
fromString =
    Text -> Oid
Oid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString

-- | Perform the Extended operation synchronously. Raises 'ResponseError' on failures.
extended :: Ldap -> Oid -> Maybe ByteString -> IO ()
extended :: Ldap -> Oid -> Maybe ByteString -> IO ()
extended Ldap
l Oid
oid Maybe ByteString
mv =
  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 -> Oid -> Maybe ByteString -> IO (Either ResponseError ())
extendedEither Ldap
l Oid
oid Maybe ByteString
mv

-- | Perform the Extended operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures.
extendedEither :: Ldap -> Oid -> Maybe ByteString -> IO (Either ResponseError ())
extendedEither :: Ldap -> Oid -> Maybe ByteString -> IO (Either ResponseError ())
extendedEither Ldap
l Oid
oid Maybe ByteString
mv =
  forall a. Async a -> IO (Either ResponseError a)
wait forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ldap -> Oid -> Maybe ByteString -> IO (Async ())
extendedAsync Ldap
l Oid
oid Maybe ByteString
mv

-- | Perform the Extended operation asynchronously. Call 'Ldap.Client.wait' to wait
-- for its completion.
extendedAsync :: Ldap -> Oid -> Maybe ByteString -> IO (Async ())
extendedAsync :: Ldap -> Oid -> Maybe ByteString -> IO (Async ())
extendedAsync Ldap
l Oid
oid Maybe ByteString
mv =
  forall a. STM a -> IO a
atomically (Ldap -> Oid -> Maybe ByteString -> STM (Async ())
extendedAsyncSTM Ldap
l Oid
oid Maybe ByteString
mv)

-- | Perform the Extended operation asynchronously.
--
-- Don't wait for its completion (with 'Ldap.Client.waitSTM') in the
-- same transaction you've performed it in.
extendedAsyncSTM :: Ldap -> Oid -> Maybe ByteString -> STM (Async ())
extendedAsyncSTM :: Ldap -> Oid -> Maybe ByteString -> STM (Async ())
extendedAsyncSTM Ldap
l Oid
oid Maybe ByteString
mv =
  let req :: Request
req = Oid -> Maybe ByteString -> Request
extendedRequest Oid
oid Maybe ByteString
mv in forall a.
Ldap
-> (Response -> Either ResponseError a) -> Request -> STM (Async a)
sendRequest Ldap
l (Request -> Response -> Either ResponseError ()
extendedResult Request
req) Request
req

extendedRequest :: Oid -> Maybe ByteString -> Request
extendedRequest :: Oid -> Maybe ByteString -> Request
extendedRequest (Oid Text
oid) =
  LdapOid -> Maybe ByteString -> Request
Type.ExtendedRequest (Text -> LdapOid
Type.LdapOid Text
oid)

extendedResult :: Request -> Response -> Either ResponseError ()
extendedResult :: Request -> Response -> Either ResponseError ()
extendedResult Request
req (Type.ExtendedResponse
                     (Type.LdapResult ResultCode
code (Type.LdapDn (Type.LdapString Text
dn))
                                           (Type.LdapString Text
msg) Maybe ReferralUris
_) Maybe LdapOid
_ 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)
extendedResult Request
req Response
res = forall a b. a -> Either a b
Left (Request -> Response -> ResponseError
ResponseInvalid Request
req Response
res)


-- | An example of @Extended Operation@, cf. 'extended'.
startTls :: Ldap -> IO ()
startTls :: Ldap -> IO ()
startTls =
  forall e a. Exception e => Either e a -> IO a
raise forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ldap -> IO (Either ResponseError ())
startTlsEither

-- | An example of @Extended Operation@, cf. 'extendedEither'.
startTlsEither :: Ldap -> IO (Either ResponseError ())
startTlsEither :: Ldap -> IO (Either ResponseError ())
startTlsEither =
  forall a. Async a -> IO (Either ResponseError a)
wait forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Ldap -> IO (Async ())
startTlsAsync

-- | An example of @Extended Operation@, cf. 'extendedAsync'.
startTlsAsync :: Ldap -> IO (Async ())
startTlsAsync :: Ldap -> IO (Async ())
startTlsAsync =
  forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ldap -> STM (Async ())
startTlsAsyncSTM

-- | An example of @Extended Operation@, cf. 'extendedAsyncSTM'.
startTlsAsyncSTM :: Ldap -> STM (Async ())
startTlsAsyncSTM :: Ldap -> STM (Async ())
startTlsAsyncSTM Ldap
l =
  Ldap -> Oid -> Maybe ByteString -> STM (Async ())
extendedAsyncSTM Ldap
l Oid
startTlsOid forall a. Maybe a
Nothing

noticeOfDisconnectionOid :: Oid
noticeOfDisconnectionOid :: Oid
noticeOfDisconnectionOid = Oid
"1.3.6.1.4.1.1466.20036"

startTlsOid :: Oid
startTlsOid :: Oid
startTlsOid = Oid
"1.3.6.1.4.1.1466.20037"