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)
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
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
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 ()))