{-# LINE 1 "LDAP/Modify.hsc" #-}
{- -*- Mode: haskell; -*-
Haskell LDAP Interface
Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>

This code is under a 3-clause BSD license; see COPYING for details.
-}

{- |
   Module     : LDAP.Modify
   Copyright  : Copyright (C) 2005 John Goerzen
   License    : BSD

   Maintainer : John Goerzen,
   Maintainer : jgoerzen\@complete.org
   Stability  : provisional
   Portability: portable

LDAP changes

Written by John Goerzen, jgoerzen\@complete.org
-}

module LDAP.Modify (-- * Basics
                    LDAPModOp(..), LDAPMod(..),
                    ldapAdd, ldapModify, ldapDelete,
                    -- * Utilities
                    list2ldm, pairs2ldm
                   )
where

import LDAP.Utils
import LDAP.Types
import LDAP.TypesLL
import LDAP.Data
import Foreign
import Foreign.C.String

{-# LINE 38 "LDAP/Modify.hsc" #-}
import Foreign.C.Types(CInt(..))

{-# LINE 40 "LDAP/Modify.hsc" #-}
import LDAP.Result
import Control.Exception(finally)
import Data.Bits



data LDAPMod = LDAPMod {LDAPMod -> LDAPModOp
modOp :: LDAPModOp -- ^ Type of operation to perform
                       ,LDAPMod -> String
modType :: String -- ^ Name of attribute to edit
                       ,LDAPMod -> [String]
modVals :: [String] -- ^ New values
                       }
             deriving (LDAPMod -> LDAPMod -> Bool
(LDAPMod -> LDAPMod -> Bool)
-> (LDAPMod -> LDAPMod -> Bool) -> Eq LDAPMod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LDAPMod -> LDAPMod -> Bool
== :: LDAPMod -> LDAPMod -> Bool
$c/= :: LDAPMod -> LDAPMod -> Bool
/= :: LDAPMod -> LDAPMod -> Bool
Eq, Int -> LDAPMod -> ShowS
[LDAPMod] -> ShowS
LDAPMod -> String
(Int -> LDAPMod -> ShowS)
-> (LDAPMod -> String) -> ([LDAPMod] -> ShowS) -> Show LDAPMod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LDAPMod -> ShowS
showsPrec :: Int -> LDAPMod -> ShowS
$cshow :: LDAPMod -> String
show :: LDAPMod -> String
$cshowList :: [LDAPMod] -> ShowS
showList :: [LDAPMod] -> ShowS
Show)

ldapModify :: LDAP              -- ^ LDAP connection object
           -> String            -- ^ DN to modify
           -> [LDAPMod]         -- ^ Changes to make
           -> IO ()
ldapModify :: LDAP -> String -> [LDAPMod] -> IO ()
ldapModify = String
-> (LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt)
-> LDAP
-> String
-> [LDAPMod]
-> IO ()
genericChange String
"ldapModify" LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt
ldap_modify_s

ldapAdd :: LDAP                 -- ^ LDAP connection object
        -> String               -- ^ DN to add
        -> [LDAPMod]            -- ^ Items to add
        -> IO ()
ldapAdd :: LDAP -> String -> [LDAPMod] -> IO ()
ldapAdd = String
-> (LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt)
-> LDAP
-> String
-> [LDAPMod]
-> IO ()
genericChange String
"ldapAdd" LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt
ldap_add_s

genericChange :: String
-> (LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt)
-> LDAP
-> String
-> [LDAPMod]
-> IO ()
genericChange String
name LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt
func LDAP
ld String
dn [LDAPMod]
changelist =
    LDAP -> (LDAPPtr -> IO ()) -> IO ()
forall a. LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr LDAP
ld (\LDAPPtr
cld ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
dn (\CString
cdn ->
    [LDAPMod] -> (Ptr (Ptr CLDAPMod) -> IO ()) -> IO ()
forall a. [LDAPMod] -> (Ptr (Ptr CLDAPMod) -> IO a) -> IO a
withCLDAPModArr0 [LDAPMod]
changelist (\Ptr (Ptr CLDAPMod)
cmods ->
    do String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLE String
name LDAP
ld (IO LDAPInt -> IO LDAPInt) -> IO LDAPInt -> IO LDAPInt
forall a b. (a -> b) -> a -> b
$ LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt
func LDAPPtr
cld CString
cdn Ptr (Ptr CLDAPMod)
cmods
       () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            )))

{- | Delete the specified DN -}
ldapDelete :: LDAP -> String -> IO ()
ldapDelete :: LDAP -> String -> IO ()
ldapDelete LDAP
ld String
dn =
    LDAP -> (LDAPPtr -> IO ()) -> IO ()
forall a. LDAP -> (LDAPPtr -> IO a) -> IO a
withLDAPPtr LDAP
ld (\LDAPPtr
cld ->
    String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString String
dn (\CString
cdn ->
    do String -> LDAP -> IO LDAPInt -> IO LDAPInt
checkLE String
"ldapDelete" LDAP
ld (IO LDAPInt -> IO LDAPInt) -> IO LDAPInt -> IO LDAPInt
forall a b. (a -> b) -> a -> b
$ LDAPPtr -> CString -> IO LDAPInt
ldap_delete_s LDAPPtr
cld CString
cdn
       () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                   ))

{- | Takes a list of name\/value points and converts them to LDAPMod
entries.  Each item will have the specified 'LDAPModOp'. -}
list2ldm :: LDAPModOp -> [(String, [String])] -> [LDAPMod]
list2ldm :: LDAPModOp -> [(String, [String])] -> [LDAPMod]
list2ldm LDAPModOp
mo = ((String, [String]) -> LDAPMod)
-> [(String, [String])] -> [LDAPMod]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
key, [String]
vals) -> LDAPMod {modOp :: LDAPModOp
modOp = LDAPModOp
mo, modType :: String
modType = String
key,
                                            modVals :: [String]
modVals = [String]
vals}
                  )

{- | Similar to list2ldm, but handles pairs with only one value. -}
pairs2ldm :: LDAPModOp -> [(String, String)] -> [LDAPMod]
pairs2ldm :: LDAPModOp -> [(String, String)] -> [LDAPMod]
pairs2ldm LDAPModOp
mo = LDAPModOp -> [(String, [String])] -> [LDAPMod]
list2ldm LDAPModOp
mo ([(String, [String])] -> [LDAPMod])
-> ([(String, String)] -> [(String, [String])])
-> [(String, String)]
-> [LDAPMod]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> (String, [String]))
-> [(String, String)] -> [(String, [String])]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
x, String
y) -> (String
x, [String
y]))

data CLDAPMod

newCLDAPMod :: LDAPMod -> IO (Ptr CLDAPMod)
newCLDAPMod :: LDAPMod -> IO (Ptr CLDAPMod)
newCLDAPMod LDAPMod
lm =
    do (Ptr CLDAPMod
ptr::(Ptr CLDAPMod)) <- Int -> IO (Ptr CLDAPMod)
forall a. Int -> IO (Ptr a)
mallocBytes (Int
24)
{-# LINE 97 "LDAP/Modify.hsc" #-}
       cmodtype <- newCString (modType lm)
       let (LDAPInt
cmodop::LDAPInt) = 
               (Int -> LDAPInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> LDAPInt) -> (LDAPMod -> Int) -> LDAPMod -> LDAPInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDAPModOp -> Int
forall a. Enum a => a -> Int
fromEnum (LDAPModOp -> Int) -> (LDAPMod -> LDAPModOp) -> LDAPMod -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LDAPMod -> LDAPModOp
modOp (LDAPMod -> LDAPInt) -> LDAPMod -> LDAPInt
forall a b. (a -> b) -> a -> b
$ LDAPMod
lm) LDAPInt -> LDAPInt -> LDAPInt
forall a. Bits a => a -> a -> a
.|. 
               LDAPInt
128
{-# LINE 101 "LDAP/Modify.hsc" #-}
       bervals <- mapM newBerval (modVals lm)
       (Ptr (Ptr Berval)
arrptr::Ptr (Ptr Berval)) <- Ptr Berval -> [Ptr Berval] -> IO (Ptr (Ptr Berval))
forall a. Storable a => a -> [a] -> IO (Ptr a)
newArray0 Ptr Berval
forall a. Ptr a
nullPtr [Ptr Berval]
bervals 
       ( (\Ptr CLDAPMod
hsc_ptr -> Ptr CLDAPMod -> Int -> LDAPInt -> IO ()
forall b. Ptr b -> Int -> LDAPInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CLDAPMod
hsc_ptr Int
0) ) Ptr CLDAPMod
ptr LDAPInt
cmodop
{-# LINE 104 "LDAP/Modify.hsc" #-}
       ( (\hsc_ptr -> pokeByteOff hsc_ptr 8) ) ptr cmodtype
{-# LINE 105 "LDAP/Modify.hsc" #-}
       ( (\hsc_ptr -> pokeByteOff hsc_ptr 16) ) ptr arrptr
{-# LINE 106 "LDAP/Modify.hsc" #-}
       return ptr

freeCLDAPMod :: Ptr CLDAPMod -> IO ()
freeCLDAPMod :: Ptr CLDAPMod -> IO ()
freeCLDAPMod Ptr CLDAPMod
ptr =
    do -- Free the array of Bervals
       (Ptr (Ptr Berval)
arrptr::Ptr (Ptr Berval)) <- ( (\Ptr CLDAPMod
hsc_ptr -> Ptr CLDAPMod -> Int -> IO (Ptr (Ptr Berval))
forall b. Ptr b -> Int -> IO (Ptr (Ptr Berval))
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CLDAPMod
hsc_ptr Int
16) ) Ptr CLDAPMod
ptr
{-# LINE 112 "LDAP/Modify.hsc" #-}
       (arr::[Ptr Berval]) <- peekArray0 nullPtr arrptr
       (Ptr Berval -> IO ()) -> [Ptr Berval] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Ptr Berval -> IO ()
freeHSBerval [Ptr Berval]
arr
       Ptr (Ptr Berval) -> IO ()
forall a. Ptr a -> IO ()
free Ptr (Ptr Berval)
arrptr
       -- Free the modtype
       (CString
cmodtype::CString) <- ( (\Ptr CLDAPMod
hsc_ptr -> Ptr CLDAPMod -> Int -> IO CString
forall b. Ptr b -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CLDAPMod
hsc_ptr Int
8) ) Ptr CLDAPMod
ptr
{-# LINE 117 "LDAP/Modify.hsc" #-}
       free cmodtype
       -- mod_op is an int and doesn't need freeing
       -- free the LDAPMod itself.
       Ptr CLDAPMod -> IO ()
forall a. Ptr a -> IO ()
free Ptr CLDAPMod
ptr
       
withCLDAPModArr0 :: [LDAPMod] -> (Ptr (Ptr CLDAPMod) -> IO a) -> IO a
withCLDAPModArr0 :: forall a. [LDAPMod] -> (Ptr (Ptr CLDAPMod) -> IO a) -> IO a
withCLDAPModArr0 = (LDAPMod -> IO (Ptr CLDAPMod))
-> (Ptr CLDAPMod -> IO ())
-> [LDAPMod]
-> (Ptr (Ptr CLDAPMod) -> IO a)
-> IO a
forall a b c.
(a -> IO (Ptr b))
-> (Ptr b -> IO ()) -> [a] -> (Ptr (Ptr b) -> IO c) -> IO c
withAnyArr0 LDAPMod -> IO (Ptr CLDAPMod)
newCLDAPMod Ptr CLDAPMod -> IO ()
freeCLDAPMod

foreign import ccall safe "ldap.h ldap_modify_s"
  ldap_modify_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt

foreign import ccall safe "ldap.h ldap_delete_s"
  ldap_delete_s :: LDAPPtr -> CString -> IO LDAPInt

foreign import ccall safe "ldap.h ldap_add_s"
  ldap_add_s :: LDAPPtr -> CString -> Ptr (Ptr CLDAPMod) -> IO LDAPInt