-- 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/NetworkPassword.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 (FFI)
-- 
-- Networks passwords are a simple way of saving passwords associated with
-- a certain user, server, protocol, and other fields.

{-# LANGUAGE ForeignFunctionInterface #-}

{-# LINE 26 "./Gnome/Keyring/NetworkPassword.chs" #-}

module Gnome.Keyring.NetworkPassword
	( NetworkPassword (..)
	, NetworkPasswordLocation (..)
	, findNetworkPassword
	, setNetworkPassword
	) where
import Control.Exception (bracket)
import Data.Text.Lazy (Text)
import Gnome.Keyring.ItemInfo
import Gnome.Keyring.Internal.FFI
import Gnome.Keyring.Internal.Operation
import Gnome.Keyring.Internal.Types

data NetworkPassword = NetworkPassword
	{ networkPasswordKeyring  :: KeyringName
	, networkPasswordItemID   :: ItemID
	, networkPasswordLocation :: NetworkPasswordLocation
	, networkPassword         :: Text
	}
	deriving (Show, Eq)

data NetworkPasswordLocation = NetworkPasswordLocation
	{ locationProtocol :: Maybe Text
	, locationServer   :: Maybe Text
	, locationObject   :: Maybe Text
	, locationAuthType :: Maybe Text
	, locationPort     :: Word32
	, locationUser     :: Maybe Text
	, locationDomain   :: Maybe Text
	}
	deriving (Show, Eq)

-- | Find a previously stored 'NetworkPassword'. Searches all keyrings.
-- 
-- The user may be prompted to unlock necessary keyrings, and will be
-- prompted for access to the items if needed.
-- 
-- Network passwords are items with the 'ItemType' 'ItemNetworkPassword'.
-- 
findNetworkPassword :: NetworkPasswordLocation -> Operation [NetworkPassword]
findNetworkPassword loc = let
	p1 = locationUser     loc
	p2 = locationDomain   loc
	p3 = locationServer   loc
	p4 = locationObject   loc
	p5 = locationProtocol loc
	p6 = locationAuthType loc
	p7 = locationPort     loc
	in passwordListOperation
		(find_network_password p1 p2 p3 p4 p5 p6 p7)
		(find_network_password_sync p1 p2 p3 p4 p5 p6 p7)

find_network_password :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Word32 -> GetListCallbackPtr -> Ptr () -> DestroyNotifyPtr -> IO (CancellationKey)
find_network_password a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 =
  withNullableText a1 $ \a1' -> 
  withNullableText a2 $ \a2' -> 
  withNullableText a3 $ \a3' -> 
  withNullableText a4 $ \a4' -> 
  withNullableText a5 $ \a5' -> 
  withNullableText a6 $ \a6' -> 
  let {a7' = fromIntegral a7} in 
  let {a8' = id a8} in 
  let {a9' = id a9} in 
  let {a10' = id a10} in 
  find_network_password'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
  let {res' = CancellationKey res} in
  return (res')
{-# LINE 91 "./Gnome/Keyring/NetworkPassword.chs" #-}

find_network_password_sync :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Word32 -> IO (Result, [NetworkPassword])
find_network_password_sync a1 a2 a3 a4 a5 a6 a7 =
  withNullableText a1 $ \a1' -> 
  withNullableText a2 $ \a2' -> 
  withNullableText a3 $ \a3' -> 
  withNullableText a4 $ \a4' -> 
  withNullableText a5 $ \a5' -> 
  withNullableText a6 $ \a6' -> 
  let {a7' = fromIntegral a7} in 
  alloca $ \a8' -> 
  find_network_password_sync'_ a1' a2' a3' a4' a5' a6' a7' a8' >>= \res ->
  stealPasswordList a8'>>= \a8'' -> 
  let {res' = result res} in
  return (res', a8'')
{-# LINE 102 "./Gnome/Keyring/NetworkPassword.chs" #-}

-- | Store a network password.
-- 
-- If an item already exists for with this network info (ie: user, server,
-- etc.) then it will be updated.
-- 
-- Whether a new item is created or not, the item's ID will be returned.
-- 
-- Network passwords are items with the 'ItemType' 'ItemNetworkPassword'.
-- 
setNetworkPassword :: Maybe KeyringName -> NetworkPasswordLocation ->
                      Text ->
                      Operation ItemID
setNetworkPassword k loc secret = let
	p1 = locationUser     loc
	p2 = locationDomain   loc
	p3 = locationServer   loc
	p4 = locationObject   loc
	p5 = locationProtocol loc
	p6 = locationAuthType loc
	p7 = locationPort     loc
	in itemIDOperation
		(set_network_password k p1 p2 p3 p4 p5 p6 p7 secret)
		(set_network_password_sync k p1 p2 p3 p4 p5 p6 p7 secret)

set_network_password :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Word32 -> Text -> GetIntCallbackPtr -> Ptr () -> DestroyNotifyPtr -> IO (CancellationKey)
set_network_password a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 =
  withNullableText a1 $ \a1' -> 
  withNullableText a2 $ \a2' -> 
  withNullableText a3 $ \a3' -> 
  withNullableText a4 $ \a4' -> 
  withNullableText a5 $ \a5' -> 
  withNullableText a6 $ \a6' -> 
  withNullableText a7 $ \a7' -> 
  let {a8' = fromIntegral a8} in 
  withText a9 $ \a9' -> 
  let {a10' = id a10} in 
  let {a11' = id a11} in 
  let {a12' = id a12} in 
  set_network_password'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' a11' a12' >>= \res ->
  let {res' = CancellationKey res} in
  return (res')
{-# LINE 141 "./Gnome/Keyring/NetworkPassword.chs" #-}

set_network_password_sync :: Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Word32 -> Text -> IO (Result, ItemID)
set_network_password_sync a1 a2 a3 a4 a5 a6 a7 a8 a9 =
  withNullableText a1 $ \a1' -> 
  withNullableText a2 $ \a2' -> 
  withNullableText a3 $ \a3' -> 
  withNullableText a4 $ \a4' -> 
  withNullableText a5 $ \a5' -> 
  withNullableText a6 $ \a6' -> 
  withNullableText a7 $ \a7' -> 
  let {a8' = fromIntegral a8} in 
  withText a9 $ \a9' -> 
  alloca $ \a10' -> 
  set_network_password_sync'_ a1' a2' a3' a4' a5' a6' a7' a8' a9' a10' >>= \res ->
  peekItemID a10'>>= \a10'' -> 
  let {res' = result res} in
  return (res', a10'')
{-# LINE 154 "./Gnome/Keyring/NetworkPassword.chs" #-}

peekPassword :: Ptr () -> IO NetworkPassword
peekPassword pwd = do
	-- Password location
	protocol <- peekNullableText =<< (\ptr -> do {peekByteOff ptr 8 ::IO (Ptr CChar)}) pwd
	server <- peekNullableText =<< (\ptr -> do {peekByteOff ptr 12 ::IO (Ptr CChar)}) pwd
	object <- peekNullableText =<< (\ptr -> do {peekByteOff ptr 16 ::IO (Ptr CChar)}) pwd
	authType <- peekNullableText =<< (\ptr -> do {peekByteOff ptr 20 ::IO (Ptr CChar)}) pwd
	port <- fromIntegral `fmap` (\ptr -> do {peekByteOff ptr 24 ::IO CUInt}) pwd
	user <- peekNullableText =<< (\ptr -> do {peekByteOff ptr 28 ::IO (Ptr CChar)}) pwd
	domain <- peekNullableText =<< (\ptr -> do {peekByteOff ptr 32 ::IO (Ptr CChar)}) pwd
	let loc = NetworkPasswordLocation
		{ locationProtocol = protocol
		, locationServer   = server
		, locationObject   = object
		, locationAuthType = authType
		, locationPort     = port
		, locationUser     = user
		, locationDomain   = domain
		}
	
	-- Keyring, item, and secret
	keyring <- peekText =<< (\ptr -> do {peekByteOff ptr 0 ::IO (Ptr CChar)}) pwd
	itemID <- (ItemID . fromIntegral) `fmap` (\ptr -> do {peekByteOff ptr 4 ::IO CUInt}) pwd
	password <- peekText =<< (\ptr -> do {peekByteOff ptr 36 ::IO (Ptr CChar)}) pwd
	return $ NetworkPassword keyring itemID loc password

stealPasswordList :: Ptr (Ptr ()) -> IO [NetworkPassword]
stealPasswordList ptr = bracket (peek ptr)
	gnome_keyring_network_password_list_free
{-# LINE 184 "./Gnome/Keyring/NetworkPassword.chs" #-}
	(mapGList peekPassword)

passwordListOperation :: OperationImpl GetListCallback [NetworkPassword]
passwordListOperation = operationImpl $ \checkResult ->
	wrapGetListCallback $ \cres list _ ->
	checkResult cres $ mapGList peekPassword list

foreign import ccall safe "Gnome/Keyring/NetworkPassword.chs.h gnome_keyring_find_network_password"
  find_network_password'_ :: ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (CUInt -> ((FunPtr (CInt -> ((Ptr ()) -> ((Ptr ()) -> (IO ()))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO (Ptr ()))))))))))))

foreign import ccall safe "Gnome/Keyring/NetworkPassword.chs.h gnome_keyring_find_network_password_sync"
  find_network_password_sync'_ :: ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (CUInt -> ((Ptr (Ptr ())) -> (IO CInt)))))))))

foreign import ccall safe "Gnome/Keyring/NetworkPassword.chs.h gnome_keyring_set_network_password"
  set_network_password'_ :: ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (CUInt -> ((Ptr CChar) -> ((FunPtr (CInt -> (CUInt -> ((Ptr ()) -> (IO ()))))) -> ((Ptr ()) -> ((FunPtr ((Ptr ()) -> (IO ()))) -> (IO (Ptr ()))))))))))))))

foreign import ccall safe "Gnome/Keyring/NetworkPassword.chs.h gnome_keyring_set_network_password_sync"
  set_network_password_sync'_ :: ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> ((Ptr CChar) -> (CUInt -> ((Ptr CChar) -> ((Ptr CUInt) -> (IO CInt)))))))))))

foreign import ccall safe "Gnome/Keyring/NetworkPassword.chs.h gnome_keyring_network_password_list_free"
  gnome_keyring_network_password_list_free :: ((Ptr ()) -> (IO ()))