root / src / Ganeti / Curl / Internal.hsc @ 6ab6b19a
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 |