Acl.hs

{-# LANGUAGE FlexibleInstances #-}

module Acl (
  cvtacl,
  showAclDiffs,
  Acl
)
where

import Util
import Data.List
import Debug.Trace
import Text.ParserCombinators.Parsec

dquote = char '"' <?> "double quote"
quoted_char = try (do
    char '\\'
    r <- char '"'
    return r
  <?> "quoted_char" )
                 
qtext = many( quoted_char <|> noneOf "\"")
quoted_string = do 
    dquote
    r <- qtext
    dquote
    return r
  <?> "quoted string"

qsts :: CharParser () String
qsts = do
  r <- many (quoted_string <|> many1 (noneOf ","))
  return (concat r)
  
dlml :: CharParser () [String]
dlml = sepBy qsts (char ',')

glx :: String -> [String]
glx x =
  let z = parse dlml "" ((tail . init) x)
  in case z of 
     Right y -> y
     Left y -> error (show y)
  

cvtacl :: String -> [Acl]
cvtacl x = if (null x) then [] else sort $ map toAcl (glx x)

instance Comparable Acl where
  objCmp a b =
    if (grantee a == grantee b && privileges a == privileges b) then Equal a 
    else Unequal a b

data Acl = Acl { grantee :: String, privileges :: [Char], grantor :: String }

instance Show Acl where
  show a = concat [grantee a, " has ", intercalate "," $ map privName (privileges a) ]

privName x = case x of { ('a') -> "INSERT"; ('r') -> "SELECT"; ('w')->"UPDATE"; ('d')->"DELETE"
                        ; ('D') -> "TRUNCATE"; ('x') -> "REFERENCES"; ('t') -> "TRIGGER"; ('X')->"EXECUTE"
                        ; ('U') -> "USAGE"; ('C') -> "CREATE"; ('T')->"CREATE TEMP"; ('c')->"CONNECT"; otherwise ->"? "++[x] }

toAcl x = let  (p,q) = (break ('/'==) x)
               (a,b) = (break ('='==) p)
          in Acl (if (null a) then "public" else if (head a == '"') then (read a :: String) else a) (tail b) (tail q)

instance Ord Acl where
  compare a b = compare (grantee a) (grantee b)

instance Eq Acl where
  (==) a b = grantee a == grantee b && privileges a == privileges b
  
instance Show (Comparison Acl) where
  show (Equal x) = ""
  show (LeftOnly a) = concat [azure, [charLeftArrow]," ", show a, treset]
  show (RightOnly a) = concat [peach, [charRightArrow], " ", show a,  treset]
  show (Unequal a b) = let p = map privName (privileges a \\ privileges b)
                           q = map privName (privileges b \\ privileges a)
                       in concat [nok, grantee a, if (null p) then "" else concat [" also has ", azure , intercalate "," p],
                                             if (null q) then "" else concat ["; lacks ", peach, intercalate "," q],
                                  treset ]

showAclDiffs a b = 
  let dc = dbCompare a b
      ddc = filter (\l -> case l of { Equal _ -> False; otherwise -> True }) dc
  in if ( a /=  b) 
     then concat [ setAttr bold, "\n acls: ", treset, "\n  ", intercalate "\n  " $ map show ddc] 
     else ""