{-# LANGUAGE ForeignFunctionInterface #-}
--------------------------------------------------------------------
-- |
-- Module    : Network.Curl.Info
-- Copyright : (c) 2007-2009, Galois Inc 
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@galois.com>
-- Stability : provisional
-- Portability: portable
--
-- Accessing the properties of a curl handle's current state\/request.
--
--------------------------------------------------------------------
module Network.Curl.Info 
         ( Info(..)
         , InfoValue(..)
         , getInfo        -- :: Curl -> Info -> IO InfoValue
         ) where

import Network.Curl.Types
import Network.Curl.Code

import Control.Monad
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.C


data Info
 = EffectiveUrl
 | ResponseCode
 | TotalTime
 | NameLookupTime
 | ConnectTime
 | PreTransferTime
 | SizeUpload
 | SizeDownload
 | SpeedDownload
 | SpeedUpload
 | HeaderSize
 | RequestSize
 | SslVerifyResult
 | Filetime
 | ContentLengthDownload
 | ContentLengthUpload
 | StartTransferTime
 | ContentType
 | RedirectTime
 | RedirectCount
 | Private
 | HttpConnectCode
 | HttpAuthAvail
 | ProxyAuthAvail
 | OSErrno
 | NumConnects
 | SslEngines
 | CookieList
 | LastSocket
 | FtpEntryPath
   deriving (Int -> Info -> ShowS
[Info] -> ShowS
Info -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Info] -> ShowS
$cshowList :: [Info] -> ShowS
show :: Info -> String
$cshow :: Info -> String
showsPrec :: Int -> Info -> ShowS
$cshowsPrec :: Int -> Info -> ShowS
Show,Int -> Info
Info -> Int
Info -> [Info]
Info -> Info
Info -> Info -> [Info]
Info -> Info -> Info -> [Info]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Info -> Info -> Info -> [Info]
$cenumFromThenTo :: Info -> Info -> Info -> [Info]
enumFromTo :: Info -> Info -> [Info]
$cenumFromTo :: Info -> Info -> [Info]
enumFromThen :: Info -> Info -> [Info]
$cenumFromThen :: Info -> Info -> [Info]
enumFrom :: Info -> [Info]
$cenumFrom :: Info -> [Info]
fromEnum :: Info -> Int
$cfromEnum :: Info -> Int
toEnum :: Int -> Info
$ctoEnum :: Int -> Info
pred :: Info -> Info
$cpred :: Info -> Info
succ :: Info -> Info
$csucc :: Info -> Info
Enum,Info
forall a. a -> a -> Bounded a
maxBound :: Info
$cmaxBound :: Info
minBound :: Info
$cminBound :: Info
Bounded)

data InfoValue
 = IString String
 | ILong   Long
 | IDouble Double
 | IList   [String]

instance Show InfoValue where
   show :: InfoValue -> String
show InfoValue
k = 
     case InfoValue
k of
       IString String
s -> String
s
       ILong Long
l   -> forall a. Show a => a -> String
show Long
l
       IDouble Double
d -> forall a. Show a => a -> String
show Double
d
       IList [String]
ss  -> forall a. Show a => a -> String
show [String]
ss

{-
stringTag :: Long
stringTag = 0x100000  -- CURLINFO_STRING

longTag :: Long
longTag = 0x200000  -- CURLINFO_LONG

doubleTag :: Long
doubleTag = 0x300000  -- CURLINFO_DOUBLE

slistTag :: Long
slistTag = 0x400000  -- CURLINFO_SLIST
-}

{- unused, unexported
infoMask :: Long
infoMask = 0x0fffff  -- CURLINFO_MASK

infoTypeMask :: Long
infoTypeMask = 0xf00000  -- CURLINFO_TYPEMASK
-}

getInfo :: Curl -> Info -> IO InfoValue
getInfo :: Curl -> Info -> IO InfoValue
getInfo Curl
h Info
i = do
 case Info
i of
   Info
EffectiveUrl -> Curl -> String -> Long -> IO InfoValue
getInfoStr Curl
h (forall a. Show a => a -> String
show Info
i) Long
1
   Info
ResponseCode -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
2
   Info
TotalTime    -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
3
   Info
NameLookupTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
4
   Info
ConnectTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
5
   Info
PreTransferTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
6
   Info
SizeUpload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
7
   Info
SizeDownload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
8
   Info
SpeedDownload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
9
   Info
SpeedUpload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
10
   Info
HeaderSize -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
11
   Info
RequestSize -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
12
   Info
SslVerifyResult -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
13
   Info
Filetime -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
14
   Info
ContentLengthDownload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
15
   Info
ContentLengthUpload   -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
16
   Info
StartTransferTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
17
   Info
ContentType -> Curl -> String -> Long -> IO InfoValue
getInfoStr Curl
h (forall a. Show a => a -> String
show Info
i) Long
18
   Info
RedirectTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (forall a. Show a => a -> String
show Info
i) Long
19
   Info
RedirectCount -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
20
   Info
Private -> Curl -> String -> Long -> IO InfoValue
getInfoStr Curl
h (forall a. Show a => a -> String
show Info
i) Long
21
   Info
HttpConnectCode -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
22
   Info
HttpAuthAvail -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
23
   Info
ProxyAuthAvail -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
24
   Info
OSErrno -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
25
   Info
NumConnects -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
26
   Info
SslEngines -> Curl -> String -> Long -> IO InfoValue
getInfoSList Curl
h (forall a. Show a => a -> String
show Info
i) Long
27
   Info
CookieList -> Curl -> String -> Long -> IO InfoValue
getInfoSList Curl
h (forall a. Show a => a -> String
show Info
i) Long
28
   Info
LastSocket -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (forall a. Show a => a -> String
show Info
i) Long
29
   Info
FtpEntryPath -> Curl -> String -> Long -> IO InfoValue
getInfoStr Curl
h (forall a. Show a => a -> String
show Info
i) Long
30

getInfoStr :: Curl -> String -> Long -> IO InfoValue
getInfoStr :: Curl -> String -> Long -> IO InfoValue
getInfoStr Curl
h String
loc Long
tg =
     forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr CChar)
ps -> do
        CInt
rc <- forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
h forall a b. (a -> b) -> a -> b
$ \IORef OptionMap
_ CurlH
p -> CurlH -> Long -> Ptr (Ptr CChar) -> IO CInt
easy_getinfo_str CurlH
p Long
tg Ptr (Ptr CChar)
ps
        case CInt
rc of
          CInt
0 -> do
             Ptr CChar
s <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ps
             if Ptr CChar
s forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr
              then forall (m :: * -> *) a. Monad m => a -> m a
return (String -> InfoValue
IString String
"")
              else forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> InfoValue
IString forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO String
peekCString Ptr CChar
s
          CInt
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getInfo{"forall a. [a] -> [a] -> [a]
++String
loc forall a. [a] -> [a] -> [a]
++ String
"}: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CInt -> CurlCode
toCode CInt
rc))

getInfoLong :: Curl -> String -> Long -> IO InfoValue
getInfoLong :: Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h String
loc Long
tg =
     forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr Long
pl -> do
        CInt
rc <- forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
h forall a b. (a -> b) -> a -> b
$ \IORef OptionMap
_ CurlH
p -> CurlH -> Long -> Ptr Long -> IO CInt
easy_getinfo_long CurlH
p Long
tg Ptr Long
pl
        case CInt
rc of
          CInt
0 -> do
             Long
l <- forall a. Storable a => Ptr a -> IO a
peek Ptr Long
pl
             forall (m :: * -> *) a. Monad m => a -> m a
return (Long -> InfoValue
ILong Long
l)
          CInt
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getInfo{"forall a. [a] -> [a] -> [a]
++String
loc forall a. [a] -> [a] -> [a]
++ String
"}: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CInt -> CurlCode
toCode CInt
rc))

getInfoDouble :: Curl -> String -> Long -> IO InfoValue
getInfoDouble :: Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h String
loc Long
tg =
     forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr Double
pd -> do
        CInt
rc <- forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
h forall a b. (a -> b) -> a -> b
$ \IORef OptionMap
_ CurlH
p -> CurlH -> Long -> Ptr Double -> IO CInt
easy_getinfo_double CurlH
p Long
tg Ptr Double
pd
        case CInt
rc of
          CInt
0 -> do
             Double
d <- forall a. Storable a => Ptr a -> IO a
peek Ptr Double
pd
             forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> InfoValue
IDouble Double
d)
          CInt
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getInfo{"forall a. [a] -> [a] -> [a]
++String
loc forall a. [a] -> [a] -> [a]
++ String
"}: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CInt -> CurlCode
toCode CInt
rc))

getInfoSList :: Curl -> String -> Long -> IO InfoValue
getInfoSList :: Curl -> String -> Long -> IO InfoValue
getInfoSList Curl
h String
loc Long
tg =
     forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr (Ptr CChar))
ps -> do
        CInt
rc <- forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
h forall a b. (a -> b) -> a -> b
$ \IORef OptionMap
_ CurlH
p -> CurlH -> Long -> Ptr (Ptr (Ptr CChar)) -> IO CInt
easy_getinfo_slist CurlH
p Long
tg Ptr (Ptr (Ptr CChar))
ps
        case CInt
rc of
          CInt
0 -> do
             Ptr (Ptr CChar)
p <- forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
ps
             [String]
ls <- forall {b}. Ptr b -> IO [String]
unmarshallList Ptr (Ptr CChar)
p
             forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> InfoValue
IList [String]
ls)
          CInt
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getInfo{"forall a. [a] -> [a] -> [a]
++String
loc forall a. [a] -> [a] -> [a]
++ String
"}: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (CInt -> CurlCode
toCode CInt
rc))
 where
   unmarshallList :: Ptr b -> IO [String]
unmarshallList Ptr b
ptr 
     | Ptr b
ptr forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr = forall (m :: * -> *) a. Monad m => a -> m a
return []
     | Bool
otherwise = do
         Ptr CChar
ps <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0
         String
s  <- if Ptr CChar
ps forall a. Eq a => a -> a -> Bool
== forall a. Ptr a
nullPtr then forall (m :: * -> *) a. Monad m => a -> m a
return String
"" else Ptr CChar -> IO String
peekCString Ptr CChar
ps
         Ptr b
nx <- forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr (forall a. Storable a => a -> Int
sizeOf forall a. Ptr a
nullPtr)
         [String]
ls <- Ptr b -> IO [String]
unmarshallList Ptr b
nx
         forall (m :: * -> *) a. Monad m => a -> m a
return (String
sforall a. a -> [a] -> [a]
:[String]
ls)

-- FFI decls
foreign import ccall
  "curl_easy_getinfo_long" easy_getinfo_long :: CurlH -> Long -> Ptr Long -> IO CInt

foreign import ccall
  "curl_easy_getinfo_string" easy_getinfo_str  :: CurlH -> Long -> Ptr CString -> IO CInt

foreign import ccall
  "curl_easy_getinfo_double" easy_getinfo_double :: CurlH -> Long -> Ptr Double -> IO CInt

foreign import ccall
  "curl_easy_getinfo_slist" easy_getinfo_slist :: CurlH -> Long -> Ptr (Ptr (Ptr CChar)) -> IO CInt