    {-# 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