-- 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/Find.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/>.
-- 
-- |
-- Maintainer  : John Millikin <jmillikin@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (Typeclass extensions & FFI)
-- 
-- A find operation searches through all keyrings for items that match the
-- given attributes. The user may be prompted to unlock necessary keyrings,
-- and will be prompted for access to the items if needed.
-- 
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

{-# LINE 29 "./Gnome/Keyring/Find.chs" #-}

module Gnome.Keyring.Find
	( Found (..)
	, findItems
	) where
import Control.Exception (bracket)
import Data.Text.Lazy (Text)
import Foreign
import Foreign.C
import Gnome.Keyring.ItemInfo.Internal
import Gnome.Keyring.Attribute.Internal
import Gnome.Keyring.Operation.Internal
import Gnome.Keyring.FFI
import Gnome.Keyring.Types

data Found = Found
	{ foundKeyring    :: KeyringName
	, foundItemID     :: ItemID
	, foundAttributes :: [Attribute]
	, foundSecret     :: Text
	}
	deriving (Show, Eq)

peekFound :: Ptr () -> IO Found
peekFound f = do
	keyring <- peekText =<< (\ptr -> do {peekByteOff ptr 0 ::IO (Ptr CChar)}) f
	cItemID <- (\ptr -> do {peekByteOff ptr 4 ::IO CUInt}) f
	attrs <- peekAttributeList =<< (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr ())}) f
	secret <- peekText =<< (\ptr -> do {peekByteOff ptr 12 ::IO (Ptr CChar)}) f
	return $ Found keyring (ItemID (fromIntegral cItemID)) attrs secret

stealFoundList :: Ptr (Ptr ()) -> IO [Found]
stealFoundList ptr = bracket (peek ptr)
	gnome_keyring_found_list_free
{-# LINE 63 "./Gnome/Keyring/Find.chs" #-}
	(mapGList peekFound)

data GetFoundListCallback = GetFoundListCallback GetListCallbackPtr
instance Callback GetFoundListCallback [Found] where
	callbackToPtr (GetFoundListCallback x) = castFunPtr x
	freeCallback  (GetFoundListCallback x) = freeHaskellFunPtr x
	buildCallback = mkListCallback GetFoundListCallback
		peekFound

-- | Searches through all keyrings for items that match the attributes. The
-- matches are for exact equality.
-- 
-- The user may be prompted to unlock necessary keyrings, and will be
-- prompted for access to the items if needed.
-- 
findItems :: ItemType -> [Attribute] -> Operation [Found]
findItems t as = operation
	(find_items t as)
	(find_items_sync t as)

find_items :: ItemType -> [Attribute] -> GetFoundListCallback -> Ptr () -> DestroyNotifyPtr -> IO (CancellationKey)
find_items a1 a2 a3 a4 a5 =
  let {a1' = fromItemType a1} in 
  withAttributeList a2 $ \a2' -> 
  let {a3' = callbackToPtr a3} in 
  let {a4' = id a4} in 
  let {a5' = id a5} in 
  find_items'_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = CancellationKey res} in
  return (res')
{-# LINE 90 "./Gnome/Keyring/Find.chs" #-}

find_items_sync :: ItemType -> [Attribute] -> IO (Result, [Found])
find_items_sync a1 a2 =
  let {a1' = fromItemType a1} in 
  withAttributeList a2 $ \a2' -> 
  alloca $ \a3' -> 
  find_items_sync'_ a1' a2' a3' >>= \res ->
  stealFoundList a3'>>= \a3'' -> 
  let {res' = result res} in
  return (res', a3'')
{-# LINE 96 "./Gnome/Keyring/Find.chs" #-}

foreign import ccall unsafe "Gnome/Keyring/Find.chs.h gnome_keyring_found_list_free"
  gnome_keyring_found_list_free :: ((Ptr ()) -> (IO ()))

foreign import ccall safe "Gnome/Keyring/Find.chs.h gnome_keyring_find_items"
  find_items'_ :: (CInt -> ((Ptr ()) -> ((FunPtr (CInt -> ((Ptr ()) -> ((Ptr ()) -> (IO ()))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO (Ptr ())))))))

foreign import ccall unsafe "Gnome/Keyring/Find.chs.h gnome_keyring_find_items_sync"
  find_items_sync'_ :: (CInt -> ((Ptr ()) -> ((Ptr (Ptr ())) -> (IO CInt))))