module Text.LDIF.Apply (
applyLDIF
)
where
import Prelude
import Text.LDIF.Types
import Text.LDIF.Utils
import Text.LDIF.Printer
import Data.List (nub, foldl')
import qualified Data.ByteString.Char8 as BC
applyLDIF :: LDIF -> LDIF -> LDIF
applyLDIF dst (LDIF _ xs) = foldl' (\ld chg -> applyRecord2LDIF chg ld) dst xs
applyRecord2LDIF :: LDIFRecord -> LDIF -> LDIF
applyRecord2LDIF (ContentRecord dn vals) dst = applyRecord2LDIF (ChangeRecord dn (ChangeAdd vals)) dst
applyRecord2LDIF (ChangeRecord dn op) dst = applyChange2Record op dn dst (findRecordByDN dstc dn)
where
dstc = createLookupTable dst
applyChange2Record :: Change -> DN -> LDIF -> Maybe LDIFRecord -> LDIF
applyChange2Record (ChangeAdd vals) dn ld Nothing = LDIF (lcVersion ld) ((lcEntries ld)++[ContentRecord dn vals])
applyChange2Record (ChangeAdd _) dn _ (Just _) = error ("ADD: Already exists: "++(BC.unpack $ dn2str dn))
applyChange2Record ChangeDelete dn ld (Just _) = LDIF (lcVersion ld) (filter (\x -> dn /= (reDN x)) (lcEntries ld))
applyChange2Record ChangeDelete dn _ Nothing = error ("DELETE: Entry not found: "++(BC.unpack $ dn2str dn))
applyChange2Record (ChangeModify _) dn _ Nothing = error ("MODIFY: Entry not found: "++(BC.unpack $ dn2str dn))
applyChange2Record (ChangeModify ops) dn ld (Just r) = let pre = takeWhile (\x -> dn /= (reDN x)) (lcEntries ld)
post = filter (\x -> dn /= (reDN x)) $ dropWhile (\x -> dn /= (reDN x)) (lcEntries ld)
rn = foldr applyMod2Record r ops
in LDIF (lcVersion ld) (pre++[rn]++post)
applyChange2Record ChangeModDN _ _ _ = error "ModDN: Operation is not supported yet."
applyMod2Record :: Modify -> LDIFRecord -> LDIFRecord
applyMod2Record (ModAdd name vals) (ContentRecord dn av) = let nav = map (\v -> (name,v)) vals
mav = av ++ nav
verified = if (length $ nub mav) == (length mav) then mav
else error ("ModAdd: Values already exists: "++(show av)++" vs "++(show vals)++" DN:"++(BC.unpack $ dn2str dn))
in ContentRecord dn verified
applyMod2Record (ModDelete name []) (ContentRecord dn av) = let nav = filter (\(n,_) -> n /= name) av
verified = if (length $ nub nav) /= (length av) then nav
else error ("ModDel: Attribute not found: "++(show name)++" DN:"++(BC.unpack $ dn2str dn))
in ContentRecord dn verified
applyMod2Record (ModDelete name vals) (ContentRecord dn av) = let mav = filter (\(n,v) -> n /= name || v `notElem` vals) av
verified = if (length av) (length mav) == (length vals) then mav
else error ("ModDel: Attribute/Value not found: "++(show name)++"vals"++(show vals)++" DN:"++(BC.unpack $ dn2str dn))
in ContentRecord dn verified
applyMod2Record (ModReplace name vals) (ContentRecord dn av) = let nav = map (\v -> (name,v)) vals
mav = (filter (\(n,_) -> n /= name) av) ++ nav
in ContentRecord dn mav
applyMod2Record _ x = error $ "Unexpected LDIF Record:" ++ (show x)