module Gnome.Keyring.Attribute.Internal where
import Control.Exception (bracket)
import Data.Text.Lazy (Text)
import Foreign
import Foreign.C
import Gnome.Keyring.FFI
data AttributeType = ATTRIBUTE_TYPE_STRING
| ATTRIBUTE_TYPE_UINT32
deriving (Enum)
data Attribute
= TextAttribute Text Text
| WordAttribute Text Word32
deriving (Show, Eq)
attributeName :: Attribute -> Text
attributeName (TextAttribute n _) = n
attributeName (WordAttribute n _) = n
withAttributeList :: [Attribute] -> (Ptr () -> IO a) -> IO a
withAttributeList attrs io = bracket newList freeList buildList where
newList = g_array_new 0 0 12
buildList list = sequence (map (append list) attrs) >> io list
append list (TextAttribute n x) = appendString list n x
append list (WordAttribute n x) = appendUInt32 list n x
appendString :: Ptr () -> Text -> Text -> IO (())
appendString a1 a2 a3 =
let {a1' = id a1} in
withText a2 $ \a2' ->
withText a3 $ \a3' ->
appendString'_ a1' a2' a3' >>= \res ->
let {res' = id res} in
return (res')
appendUInt32 :: Ptr () -> Text -> Word32 -> IO (())
appendUInt32 a1 a2 a3 =
let {a1' = id a1} in
withText a2 $ \a2' ->
let {a3' = fromIntegral a3} in
appendUInt32'_ a1' a2' a3' >>= \res ->
let {res' = id res} in
return (res')
peekAttributeList :: Ptr () -> IO [Attribute]
peekAttributeList array = do
len <- (\ptr -> do {peekByteOff ptr 4 ::IO CUInt}) array
start <- (\ptr -> do {peekByteOff ptr 0 ::IO (Ptr CChar)}) array
peekAttributeList' (fromIntegral len) (castPtr start)
peekAttributeList' :: Integer -> Ptr () -> IO [Attribute]
peekAttributeList' 0 _ = return []
peekAttributeList' n ptr = do
attr <- peekAttribute ptr
attrs <- peekAttributeList' (n 1) (plusPtr ptr 12)
return $ attr : attrs
peekAttribute :: Ptr () -> IO Attribute
peekAttribute attr = do
name <- peekText =<< (\ptr -> do {peekByteOff ptr 0 ::IO (Ptr CChar)}) attr
cType <- (\ptr -> do {peekByteOff ptr 4 ::IO CInt}) attr
case toEnum . fromIntegral $ cType of
ATTRIBUTE_TYPE_STRING -> do
value <- peekText =<< (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr CChar)}) attr
return $ TextAttribute name value
ATTRIBUTE_TYPE_UINT32 -> do
cValue <- (\ptr -> do {peekByteOff ptr 8 ::IO CUInt}) attr
return $ WordAttribute name $ fromIntegral cValue
stealAttributeList :: Ptr (Ptr ()) -> IO [Attribute]
stealAttributeList ptr = bracket (peek ptr) freeList peekAttributeList
freeList :: Ptr () -> IO ()
freeList = gnome_keyring_attribute_list_free
foreign import ccall unsafe "Gnome/Keyring/Attribute/Internal.chs.h g_array_new"
g_array_new :: (CInt -> (CInt -> (CUInt -> (IO (Ptr ())))))
foreign import ccall unsafe "Gnome/Keyring/Attribute/Internal.chs.h gnome_keyring_attribute_list_append_string"
appendString'_ :: ((Ptr ()) -> ((Ptr CChar) -> ((Ptr CChar) -> (IO ()))))
foreign import ccall unsafe "Gnome/Keyring/Attribute/Internal.chs.h gnome_keyring_attribute_list_append_uint32"
appendUInt32'_ :: ((Ptr ()) -> ((Ptr CChar) -> (CUInt -> (IO ()))))
foreign import ccall unsafe "Gnome/Keyring/Attribute/Internal.chs.h gnome_keyring_attribute_list_free"
gnome_keyring_attribute_list_free :: ((Ptr ()) -> (IO ()))