{-# LINE 1 "Graphics/X11/Xauth.hsc" #-}
module Graphics.X11.Xauth
{-# LINE 2 "Graphics/X11/Xauth.hsc" #-}
    (Xauth(..), familyLocal, familyWild, familyNetname,
    familyKrb5Principal, familyLocalHost, getAuthByAddr) where


{-# LINE 6 "Graphics/X11/Xauth.hsc" #-}

import Foreign
import Foreign.C
import Control.Monad (liftM2, zipWithM_)

data Xauth = Xauth { xauthName, xauthData :: [CChar] } deriving (Show, Read)

familyLocal, familyWild, familyNetname, familyKrb5Principal, familyLocalHost :: CUShort
familyLocal         = 256
{-# LINE 15 "Graphics/X11/Xauth.hsc" #-}
familyWild          = 65535
{-# LINE 16 "Graphics/X11/Xauth.hsc" #-}
familyNetname       = 254
{-# LINE 17 "Graphics/X11/Xauth.hsc" #-}
familyKrb5Principal = 253
{-# LINE 18 "Graphics/X11/Xauth.hsc" #-}
familyLocalHost     = 252
{-# LINE 19 "Graphics/X11/Xauth.hsc" #-}

foreign import ccall "X11/Xauth.h XauGetAuthByAddr"
    xauGetAuthByAddr :: CUShort -> CUShort -> Ptr CChar -> CUShort -> Ptr CChar
                         -> CInt -> Ptr CChar -> IO (Ptr Xauth)

foreign import ccall "X11/Xauth.h XauDisposeAuth"
    xauDisposeAuth :: Ptr Xauth -> IO ()

getAuthByAddr :: CUShort -> [CChar] -> [CChar] -> [CChar] -> IO (Maybe Xauth)
getAuthByAddr family address number atype
 = withArray address $ \addr_p -> withArray number $ \num_p ->
   withArray atype $ \atype_p -> do
        res <- xauGetAuthByAddr family (slength address) addr_p (slength number)
                             num_p (slength atype) atype_p
        if res == nullPtr
            then return Nothing
            else do
                name_p   <- (\hsc_ptr -> peekByteOff hsc_ptr 20)        res
{-# LINE 37 "Graphics/X11/Xauth.hsc" #-}
                name_len <- (\hsc_ptr -> peekByteOff hsc_ptr 16) res :: IO CUShort
{-# LINE 38 "Graphics/X11/Xauth.hsc" #-}
                data_p   <- (\hsc_ptr -> peekByteOff hsc_ptr 28)        res
{-# LINE 39 "Graphics/X11/Xauth.hsc" #-}
                data_len <- (\hsc_ptr -> peekByteOff hsc_ptr 24) res :: IO CUShort
{-# LINE 40 "Graphics/X11/Xauth.hsc" #-}
                x <- if or [nullPtr == name_p, nullPtr == data_p, data_len <= 0, name_len <= 0]
                    then return $ Nothing
                    else
                        liftM2 ((Just .) . Xauth)
                            (peekArray (fromIntegral name_len) name_p)
                            (peekArray (fromIntegral data_len) data_p)
                xauDisposeAuth res
                return x
 where slength x = fromIntegral $ length x