{-# 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
        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 rc of
          CInt
0 -> do
             s <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
ps
             if s == nullPtr
              then return (IString "")
              else liftM IString $ peekCString 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
        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 rc of
          CInt
0 -> do
             l <- Ptr Long -> IO Long
forall a. Storable a => Ptr a -> IO a
peek Ptr Long
pl
             return (ILong 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
        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 rc of
          CInt
0 -> do
             d <- Ptr Double -> IO Double
forall a. Storable a => Ptr a -> IO a
peek Ptr Double
pd
             return (IDouble 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
        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 rc of
          CInt
0 -> do
             p <- Ptr (Ptr (Ptr CChar)) -> IO (Ptr (Ptr CChar))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (Ptr CChar))
ps
             ls <- unmarshallList p
             return (IList 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
         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
         s  <- if ps == nullPtr then return "" else peekCString ps
         nx <- peekByteOff ptr (sizeOf nullPtr)
         ls <- unmarshallList nx
         return (s: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