Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Curl / Internal.hsc @ 88b58ed6

History | View | Annotate | Download (4.3 kB)

1
{-# LANGUAGE ForeignFunctionInterface #-}
2
{-# OPTIONS_GHC -fno-warn-deprecated-flags #-}
3
-- the above is needed due to the fact that hsc2hs generates code also
4
-- compatible with older compilers; see
5
-- http://hackage.haskell.org/trac/ghc/ticket/3844
6

    
7
{-| Hsc2hs definitions for 'Storable' interfaces.
8

    
9
-}
10

    
11
{-
12

    
13
Copyright (C) 2013 Google Inc.
14

    
15
This program is free software; you can redistribute it and/or modify
16
it under the terms of the GNU General Public License as published by
17
the Free Software Foundation; either version 2 of the License, or
18
(at your option) any later version.
19

    
20
This program is distributed in the hope that it will be useful, but
21
WITHOUT ANY WARRANTY; without even the implied warranty of
22
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
23
General Public License for more details.
24

    
25
You should have received a copy of the GNU General Public License
26
along with this program; if not, write to the Free Software
27
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
28
02110-1301, USA.
29

    
30
-}
31

    
32
module Ganeti.Curl.Internal
33
  ( CurlMsgCode(..)
34
  , toMsgCode
35
  , fromMsgCode
36
  , CurlMsg(..)
37
  , errorBufferSize
38
  , CurlMCode(..)
39
  , toMCode
40
  ) where
41

    
42
import Foreign
43
import Foreign.C.Types
44

    
45
import Network.Curl
46

    
47
#include <curl/curl.h>
48

    
49
-- | Data representing a @CURLMSG@ enum.
50
data CurlMsgCode = CurlMsgNone
51
                 | CurlMsgDone
52
                 | CurlMsgUnknown CInt -- ^ Haskell specific code for
53
                                       -- unknown codes
54
                   deriving (Show, Eq)
55

    
56
-- | Data representing a @struct CURLMsg@.
57
data CurlMsg = CurlMsg
58
  { cmMessage :: CurlMsgCode -- ^ The message type
59
  , cmHandle  :: CurlH       -- ^ The internal curl handle to which it applies
60
  , cmResult  :: CurlCode    -- ^ The message-specific result
61
  }
62

    
63
-- | Partial 'Storable' instance for 'CurlMsg'; we do not extract all
64
-- fields, only the one we are interested in.
65
instance Storable CurlMsg where
66
  sizeOf    _ = (#size CURLMsg)
67
  alignment _ = alignment (undefined :: CInt)
68
  peek ptr = do
69
    msg <- (#peek CURLMsg, msg) ptr
70
    handle <- (#peek CURLMsg, easy_handle) ptr
71
    result <- (#peek CURLMsg, data.result) ptr
72
    return $ CurlMsg (toMsgCode msg) handle (toCode result)
73
  poke ptr (CurlMsg msg handle result) = do
74
    (#poke CURLMsg, msg) ptr (fromMsgCode msg)
75
    (#poke CURLMsg, easy_handle) ptr handle
76
    (#poke CURLMsg, data.result) ptr ((fromIntegral $ fromEnum result)::CInt)
77

    
78
-- | Minimum buffer size for 'CurlErrorBuffer'.
79
errorBufferSize :: Int
80
errorBufferSize = (#const CURL_ERROR_SIZE)
81

    
82
-- | Multi interface error codes.
83
data CurlMCode = CurlmCallMultiPerform
84
               | CurlmOK
85
               | CurlmBadHandle
86
               | CurlmBadEasyHandle
87
               | CurlmOutOfMemory
88
               | CurlmInternalError
89
               | CurlmBadSocket
90
               | CurlmUnknownOption
91
               | CurlmUnknown CInt -- ^ Haskell specific code denoting
92
                                   -- undefined codes (e.g. when
93
                                   -- libcurl has defined new codes
94
                                   -- that are not implemented yet)
95
                 deriving (Show, Eq)
96

    
97
-- | Convert a CInt CURLMSG code (as returned by the C library) to a
98
-- 'CurlMsgCode'. When an unknown code is received, the special
99
-- 'CurlMsgUnknown' constructor will be used.
100
toMsgCode :: CInt -> CurlMsgCode
101
toMsgCode (#const CURLMSG_NONE) = CurlMsgNone
102
toMsgCode (#const CURLMSG_DONE) = CurlMsgDone
103
toMsgCode v = CurlMsgUnknown v
104

    
105
-- | Convert a CurlMsgCode to a CInt.
106
fromMsgCode :: CurlMsgCode -> CInt
107
fromMsgCode CurlMsgNone = (#const CURLMSG_NONE)
108
fromMsgCode CurlMsgDone = (#const CURLMSG_DONE)
109
fromMsgCode (CurlMsgUnknown v) = v
110

    
111
-- | Convert a CInt CURLMcode (as returned by the C library) to a
112
-- 'CurlMCode'. When an unknown code is received, the special
113
-- 'CurlmUnknown' constructor will be used.
114
toMCode :: CInt -> CurlMCode
115
toMCode (#const CURLM_CALL_MULTI_PERFORM) = CurlmCallMultiPerform
116
toMCode (#const CURLM_OK)                 = CurlmOK
117
toMCode (#const CURLM_BAD_HANDLE)         = CurlmBadHandle
118
toMCode (#const CURLM_BAD_EASY_HANDLE)    = CurlmBadEasyHandle
119
toMCode (#const CURLM_OUT_OF_MEMORY)      = CurlmOutOfMemory
120
toMCode (#const CURLM_INTERNAL_ERROR)     = CurlmInternalError
121
toMCode (#const CURLM_BAD_SOCKET)         = CurlmBadSocket
122
toMCode (#const CURLM_UNKNOWN_OPTION)     = CurlmUnknownOption
123
toMCode v = CurlmUnknown v