-- GENERATED by C->Haskell Compiler, version 0.16.0 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "./Gnome/Keyring/AccessControl/Internal.chs" #-}-- Copyright (C) 2009 John Millikin <jmillikin@gmail.com>
-- 
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- any later version.
-- 
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
-- 
-- You should have received a copy of the GNU General Public License
-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
-- 
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

{-# LINE 20 "./Gnome/Keyring/AccessControl/Internal.chs" #-}

module Gnome.Keyring.AccessControl.Internal where
import Control.Exception (bracket)
import Data.Set (Set, toList, fromList)
import Data.Text.Lazy (Text)
import Foreign
import Foreign.C
import Gnome.Keyring.FFI hiding (g_list_free)

data RawAccessType = ACCESS_READ
                   | ACCESS_WRITE
                   | ACCESS_REMOVE
                   deriving (Show)
instance Enum RawAccessType where
  fromEnum ACCESS_READ = 1
  fromEnum ACCESS_WRITE = 2
  fromEnum ACCESS_REMOVE = 4

  toEnum 1 = ACCESS_READ
  toEnum 2 = ACCESS_WRITE
  toEnum 4 = ACCESS_REMOVE
  toEnum unmatched = error ("RawAccessType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 30 "./Gnome/Keyring/AccessControl/Internal.chs" #-}

data AccessType
	= AccessRead
	| AccessWrite
	| AccessRemove
	deriving (Show, Eq, Ord)

data AccessControl = AccessControl
	{ accessControlName :: Maybe Text
	, accessControlPath :: Maybe Text
	, accessControlType :: Set AccessType
	}
	deriving (Show, Eq)

peekAccessControl :: Ptr () -> IO AccessControl
peekAccessControl ac = do
	name <- stealNullableText =<< gnome_keyring_item_ac_get_display_name ac
	path <- stealNullableText =<< gnome_keyring_item_ac_get_path_name ac
	cType <- gnome_keyring_item_ac_get_access_type ac
	return $ AccessControl name path $ peekAccessType cType

stealACL :: Ptr (Ptr ()) -> IO [AccessControl]
stealACL ptr = bracket (peek ptr) freeACL (mapGList peekAccessControl)

withACL :: [AccessControl] -> (Ptr () -> IO a) -> IO a
withACL acl = bracket (buildACL acl) freeACL

buildACL :: [AccessControl] -> IO (Ptr ())
buildACL acs = bracket
	gnome_keyring_application_ref_new
{-# LINE 60 "./Gnome/Keyring/AccessControl/Internal.chs" #-}
	gnome_keyring_application_ref_free $ \appRef ->
	buildACL' appRef acs nullPtr

buildACL' :: Ptr () -> [AccessControl] -> Ptr () -> IO (Ptr ())
buildACL'      _       [] list = return list
buildACL' appRef (ac:acs) list = buildAC appRef ac
	>>= g_list_append list
	>>= buildACL' appRef acs

buildAC :: Ptr () -> AccessControl -> IO (Ptr ())
buildAC appRef ac = do
	let cAllowed = cAccessTypes $ accessControlType ac
	ptr <- gnome_keyring_access_control_new appRef cAllowed
	withNullableText (accessControlName ac) $ gnome_keyring_item_ac_set_display_name ptr
	withNullableText (accessControlPath ac) $ gnome_keyring_item_ac_set_path_name ptr
	return ptr

freeACL :: Ptr () -> IO ()
freeACL = gnome_keyring_acl_free
{-# LINE 79 "./Gnome/Keyring/AccessControl/Internal.chs" #-}

cAccessTypes :: Bits a => Set AccessType -> a
cAccessTypes = foldr (.|.) 0 . map (fromIntegral . fromEnum . fromAccessType) . toList where

peekAccessType :: Integral a => a -> Set AccessType
peekAccessType cint = fromList $ concat
	[ [AccessRead   | int .&. fromEnum ACCESS_READ   > 0]
	, [AccessWrite  | int .&. fromEnum ACCESS_WRITE  > 0]
	, [AccessRemove | int .&. fromEnum ACCESS_REMOVE > 0]
	]
	where int = fromIntegral cint

fromAccessType :: AccessType -> RawAccessType
fromAccessType AccessRead   = ACCESS_READ
fromAccessType AccessWrite  = ACCESS_WRITE
fromAccessType AccessRemove = ACCESS_REMOVE

toAccessType :: RawAccessType -> AccessType
toAccessType ACCESS_READ   = AccessRead
toAccessType ACCESS_WRITE  = AccessWrite
toAccessType ACCESS_REMOVE = AccessRemove

data GetACLCallback = GetACLCallback GetListCallbackPtr
instance Callback GetACLCallback [AccessControl] where
	callbackToPtr (GetACLCallback x) = castFunPtr x
	freeCallback  (GetACLCallback x) = freeHaskellFunPtr x
	buildCallback = mkListCallback GetACLCallback
		peekAccessControl

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_item_ac_get_display_name"
  gnome_keyring_item_ac_get_display_name :: ((Ptr ()) -> (IO (Ptr CChar)))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_item_ac_get_path_name"
  gnome_keyring_item_ac_get_path_name :: ((Ptr ()) -> (IO (Ptr CChar)))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_item_ac_get_access_type"
  gnome_keyring_item_ac_get_access_type :: ((Ptr ()) -> (IO CInt))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_application_ref_new"
  gnome_keyring_application_ref_new :: (IO (Ptr ()))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_application_ref_free"
  gnome_keyring_application_ref_free :: ((Ptr ()) -> (IO ()))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h g_list_append"
  g_list_append :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_access_control_new"
  gnome_keyring_access_control_new :: ((Ptr ()) -> (CInt -> (IO (Ptr ()))))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_item_ac_set_display_name"
  gnome_keyring_item_ac_set_display_name :: ((Ptr ()) -> ((Ptr CChar) -> (IO ())))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_item_ac_set_path_name"
  gnome_keyring_item_ac_set_path_name :: ((Ptr ()) -> ((Ptr CChar) -> (IO ())))

foreign import ccall unsafe "Gnome/Keyring/AccessControl/Internal.chs.h gnome_keyring_acl_free"
  gnome_keyring_acl_free :: ((Ptr ()) -> (IO ()))