{-# 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
(Int -> Info -> ShowS)
-> (Info -> String) -> ([Info] -> ShowS) -> Show Info
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Info -> ShowS
showsPrec :: Int -> Info -> ShowS
$cshow :: Info -> String
show :: Info -> String
$cshowList :: [Info] -> ShowS
showList :: [Info] -> ShowS
Show,Int -> Info
Info -> Int
Info -> [Info]
Info -> Info
Info -> Info -> [Info]
Info -> Info -> Info -> [Info]
(Info -> Info)
-> (Info -> Info)
-> (Int -> Info)
-> (Info -> Int)
-> (Info -> [Info])
-> (Info -> Info -> [Info])
-> (Info -> Info -> [Info])
-> (Info -> Info -> Info -> [Info])
-> Enum 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
$csucc :: Info -> Info
succ :: Info -> Info
$cpred :: Info -> Info
pred :: Info -> Info
$ctoEnum :: Int -> Info
toEnum :: Int -> Info
$cfromEnum :: Info -> Int
fromEnum :: Info -> Int
$cenumFrom :: Info -> [Info]
enumFrom :: Info -> [Info]
$cenumFromThen :: Info -> Info -> [Info]
enumFromThen :: Info -> Info -> [Info]
$cenumFromTo :: Info -> Info -> [Info]
enumFromTo :: Info -> Info -> [Info]
$cenumFromThenTo :: Info -> Info -> Info -> [Info]
enumFromThenTo :: Info -> Info -> Info -> [Info]
Enum,Info
Info -> Info -> Bounded Info
forall a. a -> a -> Bounded a
$cminBound :: Info
minBound :: Info
$cmaxBound :: Info
maxBound :: 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   -> Long -> String
forall a. Show a => a -> String
show Long
l
       IDouble Double
d -> Double -> String
forall a. Show a => a -> String
show Double
d
       IList [String]
ss  -> [String] -> String
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 (Info -> String
forall a. Show a => a -> String
show Info
i) Long
1
   Info
ResponseCode -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
2
   Info
TotalTime    -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
3
   Info
NameLookupTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
4
   Info
ConnectTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
5
   Info
PreTransferTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
6
   Info
SizeUpload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
7
   Info
SizeDownload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
8
   Info
SpeedDownload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
9
   Info
SpeedUpload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
10
   Info
HeaderSize -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
11
   Info
RequestSize -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
12
   Info
SslVerifyResult -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
13
   Info
Filetime -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
14
   Info
ContentLengthDownload -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
15
   Info
ContentLengthUpload   -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
16
   Info
StartTransferTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
17
   Info
ContentType -> Curl -> String -> Long -> IO InfoValue
getInfoStr Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
18
   Info
RedirectTime -> Curl -> String -> Long -> IO InfoValue
getInfoDouble Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
19
   Info
RedirectCount -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
20
   Info
Private -> Curl -> String -> Long -> IO InfoValue
getInfoStr Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
21
   Info
HttpConnectCode -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
22
   Info
HttpAuthAvail -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
23
   Info
ProxyAuthAvail -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
24
   Info
OSErrno -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
25
   Info
NumConnects -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
26
   Info
SslEngines -> Curl -> String -> Long -> IO InfoValue
getInfoSList Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
27
   Info
CookieList -> Curl -> String -> Long -> IO InfoValue
getInfoSList Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
28
   Info
LastSocket -> Curl -> String -> Long -> IO InfoValue
getInfoLong Curl
h (Info -> String
forall a. Show a => a -> String
show Info
i) Long
29
   Info
FtpEntryPath -> Curl -> String -> Long -> IO InfoValue
getInfoStr Curl
h (Info -> String
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 =
     (Ptr (Ptr CChar) -> IO InfoValue) -> IO InfoValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CChar) -> IO InfoValue) -> IO InfoValue)
-> (Ptr (Ptr CChar) -> IO InfoValue) -> IO InfoValue
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr CChar)
ps -> do
        CInt
rc <- Curl -> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
h ((IORef OptionMap -> CurlH -> IO CInt) -> IO CInt)
-> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
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 <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ps
             if Ptr CChar
s Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
              then InfoValue -> IO InfoValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> InfoValue
IString String
"")
              else (String -> InfoValue) -> IO String -> IO InfoValue
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> InfoValue
IString (IO String -> IO InfoValue) -> IO String -> IO InfoValue
forall a b. (a -> b) -> a -> b
$ Ptr CChar -> IO String
peekCString Ptr CChar
s
          CInt
_ -> String -> IO InfoValue
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getInfo{"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CurlCode -> String
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 =
     (Ptr Long -> IO InfoValue) -> IO InfoValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Long -> IO InfoValue) -> IO InfoValue)
-> (Ptr Long -> IO InfoValue) -> IO InfoValue
forall a b. (a -> b) -> a -> b
$ \ Ptr Long
pl -> do
        CInt
rc <- Curl -> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
h ((IORef OptionMap -> CurlH -> IO CInt) -> IO CInt)
-> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
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 <- Ptr Long -> IO Long
forall a. Storable a => Ptr a -> IO a
peek Ptr Long
pl
             InfoValue -> IO InfoValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Long -> InfoValue
ILong Long
l)
          CInt
_ -> String -> IO InfoValue
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getInfo{"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CurlCode -> String
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 =
     (Ptr Double -> IO InfoValue) -> IO InfoValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Double -> IO InfoValue) -> IO InfoValue)
-> (Ptr Double -> IO InfoValue) -> IO InfoValue
forall a b. (a -> b) -> a -> b
$ \ Ptr Double
pd -> do
        CInt
rc <- Curl -> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
h ((IORef OptionMap -> CurlH -> IO CInt) -> IO CInt)
-> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
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 <- Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
peek Ptr Double
pd
             InfoValue -> IO InfoValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> InfoValue
IDouble Double
d)
          CInt
_ -> String -> IO InfoValue
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getInfo{"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CurlCode -> String
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 =
     (Ptr (Ptr (Ptr CChar)) -> IO InfoValue) -> IO InfoValue
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr (Ptr CChar)) -> IO InfoValue) -> IO InfoValue)
-> (Ptr (Ptr (Ptr CChar)) -> IO InfoValue) -> IO InfoValue
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr (Ptr CChar))
ps -> do
        CInt
rc <- Curl -> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
forall a. Curl -> (IORef OptionMap -> CurlH -> IO a) -> IO a
curlPrim Curl
h ((IORef OptionMap -> CurlH -> IO CInt) -> IO CInt)
-> (IORef OptionMap -> CurlH -> IO CInt) -> IO CInt
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 <- Ptr (Ptr (Ptr CChar)) -> IO (Ptr (Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
ps
             [String]
ls <- Ptr (Ptr CChar) -> IO [String]
forall {b}. Ptr b -> IO [String]
unmarshallList Ptr (Ptr CChar)
p
             InfoValue -> IO InfoValue
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> InfoValue
IList [String]
ls)
          CInt
_ -> String -> IO InfoValue
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"getInfo{"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
loc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CurlCode -> String
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 Ptr b -> Ptr b -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr b
forall a. Ptr a
nullPtr = [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
     | Bool
otherwise = do
         Ptr CChar
ps <- Ptr b -> Int -> IO (Ptr CChar)
forall b. Ptr b -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr Int
0
         String
s  <- if Ptr CChar
ps Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr then String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"" else Ptr CChar -> IO String
peekCString Ptr CChar
ps
         Ptr b
nx <- Ptr b -> Int -> IO (Ptr b)
forall b. Ptr b -> Int -> IO (Ptr b)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr b
ptr (Ptr Any -> Int
forall a. Storable a => a -> Int
sizeOf Ptr Any
forall a. Ptr a
nullPtr)
         [String]
ls <- Ptr b -> IO [String]
unmarshallList Ptr b
nx
         [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
sString -> [String] -> [String]
forall 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