-- | <https://tools.ietf.org/html/rfc4511#section-4.6 Modify> and
-- <https://tools.ietf.org/html/rfc4511#section-4.9 Modify DN> operations.
--
-- These operations come in four flavours:
--
--   * synchronous, exception throwing ('modify' / 'modifyDn')
--
--   * synchronous, returning 'Either' 'ResponseError' @()@
--     ('modifyEither' / 'modifyDnEither')
--
--   * asynchronous, 'IO' based ('modifyAsync' / 'modifyDnAsync')
--
--   * asynchronous, 'STM' based ('modifyAsyncSTM' / 'modifyDnAsyncSTM')
--
-- Of those, the first one ('modify' / 'modifyDn') is probably the most
-- useful for the typical usecase.
module Ldap.Client.Modify
  ( Operation(..)
  , modify
  , modifyEither
  , modifyAsync
  , modifyAsyncSTM
  , RelativeDn(..)
  , modifyDn
  , modifyDnEither
  , modifyDnAsync
  , modifyDnAsyncSTM
  , Async
  , wait
  , waitSTM
  ) where

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

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


-- | Type of modification being performed.
data Operation =
    Delete !Attr ![AttrValue]  -- ^ Delete values from the attribute. Deletes the attribute if the list is empty or all current values are listed.
  | Add !Attr ![AttrValue]     -- ^ Add values to the attribute, creating it if necessary.
  | Replace !Attr ![AttrValue] -- ^ Replace all existing values of the attribute with the new list. Deletes the attribute if the list is empty.
    deriving (Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Operation] -> ShowS
$cshowList :: [Operation] -> ShowS
show :: Operation -> String
$cshow :: Operation -> String
showsPrec :: Int -> Operation -> ShowS
$cshowsPrec :: Int -> Operation -> ShowS
Show, Operation -> Operation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c== :: Operation -> Operation -> Bool
Eq)

-- | Perform the Modify operation synchronously. Raises 'ResponseError' on failures.
modify :: Ldap -> Dn -> [Operation] -> IO ()
modify :: Ldap -> Dn -> [Operation] -> IO ()
modify Ldap
l Dn
dn [Operation]
as =
  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 -> [Operation] -> IO (Either ResponseError ())
modifyEither Ldap
l Dn
dn [Operation]
as

-- | Perform the Modify operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures.
modifyEither :: Ldap -> Dn -> [Operation] -> IO (Either ResponseError ())
modifyEither :: Ldap -> Dn -> [Operation] -> IO (Either ResponseError ())
modifyEither Ldap
l Dn
dn [Operation]
as =
  forall a. Async a -> IO (Either ResponseError a)
wait forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ldap -> Dn -> [Operation] -> IO (Async ())
modifyAsync Ldap
l Dn
dn [Operation]
as

-- | Perform the Modify operation asynchronously. Call 'Ldap.Client.wait' to wait
-- for its completion.
modifyAsync :: Ldap -> Dn -> [Operation] -> IO (Async ())
modifyAsync :: Ldap -> Dn -> [Operation] -> IO (Async ())
modifyAsync Ldap
l Dn
dn [Operation]
as =
  forall a. STM a -> IO a
atomically (Ldap -> Dn -> [Operation] -> STM (Async ())
modifyAsyncSTM Ldap
l Dn
dn [Operation]
as)

-- | Perform the Modify operation asynchronously.
--
-- Don't wait for its completion (with 'Ldap.Client.waitSTM') in the
-- same transaction you've performed it in.
modifyAsyncSTM :: Ldap -> Dn -> [Operation] -> STM (Async ())
modifyAsyncSTM :: Ldap -> Dn -> [Operation] -> STM (Async ())
modifyAsyncSTM Ldap
l Dn
dn [Operation]
xs =
  let req :: Request
req = Dn -> [Operation] -> Request
modifyRequest Dn
dn [Operation]
xs in forall a.
Ldap
-> (Response -> Either ResponseError a) -> Request -> STM (Async a)
sendRequest Ldap
l (Request -> Response -> Either ResponseError ()
modifyResult Request
req) Request
req

modifyRequest :: Dn -> [Operation] -> Request
modifyRequest :: Dn -> [Operation] -> Request
modifyRequest (Dn Text
dn) [Operation]
xs =
  LdapDn -> [(Operation, PartialAttribute)] -> Request
Type.ModifyRequest (LdapString -> LdapDn
Type.LdapDn (Text -> LdapString
Type.LdapString Text
dn)) (forall a b. (a -> b) -> [a] -> [b]
map Operation -> (Operation, PartialAttribute)
f [Operation]
xs)
 where
  f :: Operation -> (Operation, PartialAttribute)
f (Delete (Attr Text
k) [AttrValue]
vs) =
    (Operation
Type.Delete, AttributeDescription -> [AttributeValue] -> PartialAttribute
Type.PartialAttribute (LdapString -> AttributeDescription
Type.AttributeDescription (Text -> LdapString
Type.LdapString Text
k))
                                        (forall a b. (a -> b) -> [a] -> [b]
map AttrValue -> AttributeValue
Type.AttributeValue [AttrValue]
vs))
  f (Add (Attr Text
k) [AttrValue]
vs) =
    (Operation
Type.Add, AttributeDescription -> [AttributeValue] -> PartialAttribute
Type.PartialAttribute (LdapString -> AttributeDescription
Type.AttributeDescription (Text -> LdapString
Type.LdapString Text
k))
                                     (forall a b. (a -> b) -> [a] -> [b]
map AttrValue -> AttributeValue
Type.AttributeValue [AttrValue]
vs))
  f (Replace (Attr Text
k) [AttrValue]
vs) =
    (Operation
Type.Replace, AttributeDescription -> [AttributeValue] -> PartialAttribute
Type.PartialAttribute (LdapString -> AttributeDescription
Type.AttributeDescription (Text -> LdapString
Type.LdapString Text
k))
                                         (forall a b. (a -> b) -> [a] -> [b]
map AttrValue -> AttributeValue
Type.AttributeValue [AttrValue]
vs))

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


-- | A component of 'Dn'.
newtype RelativeDn = RelativeDn Text
    deriving (Int -> RelativeDn -> ShowS
[RelativeDn] -> ShowS
RelativeDn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelativeDn] -> ShowS
$cshowList :: [RelativeDn] -> ShowS
show :: RelativeDn -> String
$cshow :: RelativeDn -> String
showsPrec :: Int -> RelativeDn -> ShowS
$cshowsPrec :: Int -> RelativeDn -> ShowS
Show, RelativeDn -> RelativeDn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelativeDn -> RelativeDn -> Bool
$c/= :: RelativeDn -> RelativeDn -> Bool
== :: RelativeDn -> RelativeDn -> Bool
$c== :: RelativeDn -> RelativeDn -> Bool
Eq)

-- | Perform the Modify DN operation synchronously. Raises 'ResponseError' on failures.
modifyDn :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO ()
modifyDn :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO ()
modifyDn Ldap
l Dn
dn RelativeDn
rdn Bool
del Maybe Dn
new =
  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
-> RelativeDn
-> Bool
-> Maybe Dn
-> IO (Either ResponseError ())
modifyDnEither Ldap
l Dn
dn RelativeDn
rdn Bool
del Maybe Dn
new

-- | Perform the Modify DN operation synchronously. Returns @Left e@ where
-- @e@ is a 'ResponseError' on failures.
modifyDnEither :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO (Either ResponseError ())
modifyDnEither :: Ldap
-> Dn
-> RelativeDn
-> Bool
-> Maybe Dn
-> IO (Either ResponseError ())
modifyDnEither Ldap
l Dn
dn RelativeDn
rdn Bool
del Maybe Dn
new =
  forall a. Async a -> IO (Either ResponseError a)
wait forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO (Async ())
modifyDnAsync Ldap
l Dn
dn RelativeDn
rdn Bool
del Maybe Dn
new

-- | Perform the Modify DN operation asynchronously. Call 'Ldap.Client.wait' to wait
-- for its completion.
modifyDnAsync :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO (Async ())
modifyDnAsync :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> IO (Async ())
modifyDnAsync Ldap
l Dn
dn RelativeDn
rdn Bool
del Maybe Dn
new =
  forall a. STM a -> IO a
atomically (Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> STM (Async ())
modifyDnAsyncSTM Ldap
l Dn
dn RelativeDn
rdn Bool
del Maybe Dn
new)

-- | Perform the Modify DN operation asynchronously.
--
-- Don't wait for its completion (with 'Ldap.Client.waitSTM') in the
-- same transaction you've performed it in.
modifyDnAsyncSTM :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> STM (Async ())
modifyDnAsyncSTM :: Ldap -> Dn -> RelativeDn -> Bool -> Maybe Dn -> STM (Async ())
modifyDnAsyncSTM Ldap
l Dn
dn RelativeDn
rdn Bool
del Maybe Dn
new =
  let req :: Request
req = Dn -> RelativeDn -> Bool -> Maybe Dn -> Request
modifyDnRequest Dn
dn RelativeDn
rdn Bool
del Maybe Dn
new in forall a.
Ldap
-> (Response -> Either ResponseError a) -> Request -> STM (Async a)
sendRequest Ldap
l (Request -> Response -> Either ResponseError ()
modifyDnResult Request
req) Request
req

modifyDnRequest :: Dn -> RelativeDn -> Bool -> Maybe Dn -> Request
modifyDnRequest :: Dn -> RelativeDn -> Bool -> Maybe Dn -> Request
modifyDnRequest (Dn Text
dn) (RelativeDn Text
rdn) Bool
del Maybe Dn
new =
  LdapDn -> RelativeLdapDn -> Bool -> Maybe LdapDn -> Request
Type.ModifyDnRequest (LdapString -> LdapDn
Type.LdapDn (Text -> LdapString
Type.LdapString Text
dn))
                       (LdapString -> RelativeLdapDn
Type.RelativeLdapDn (Text -> LdapString
Type.LdapString Text
rdn))
                       Bool
del
                       (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Dn Text
dn') -> LdapString -> LdapDn
Type.LdapDn (Text -> LdapString
Type.LdapString Text
dn')) Maybe Dn
new)

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