root / src / Ganeti / Curl / Internal.hsc @ 6e1e47d4
History | View | Annotate | Download (4.3 kB)
1 | cc40185c | Iustin Pop | {-# LANGUAGE ForeignFunctionInterface #-} |
---|---|---|---|
2 | cc40185c | Iustin Pop | {-# OPTIONS_GHC -fno-warn-deprecated-flags #-} |
3 | cc40185c | Iustin Pop | -- the above is needed due to the fact that hsc2hs generates code also |
4 | cc40185c | Iustin Pop | -- compatible with older compilers; see |
5 | cc40185c | Iustin Pop | -- http://hackage.haskell.org/trac/ghc/ticket/3844 |
6 | cc40185c | Iustin Pop | |
7 | cc40185c | Iustin Pop | {-| Hsc2hs definitions for 'Storable' interfaces. |
8 | cc40185c | Iustin Pop | |
9 | cc40185c | Iustin Pop | -} |
10 | cc40185c | Iustin Pop | |
11 | cc40185c | Iustin Pop | {- |
12 | cc40185c | Iustin Pop | |
13 | cc40185c | Iustin Pop | Copyright (C) 2013 Google Inc. |
14 | cc40185c | Iustin Pop | |
15 | cc40185c | Iustin Pop | This program is free software; you can redistribute it and/or modify |
16 | cc40185c | Iustin Pop | it under the terms of the GNU General Public License as published by |
17 | cc40185c | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
18 | cc40185c | Iustin Pop | (at your option) any later version. |
19 | cc40185c | Iustin Pop | |
20 | cc40185c | Iustin Pop | This program is distributed in the hope that it will be useful, but |
21 | cc40185c | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
22 | cc40185c | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
23 | cc40185c | Iustin Pop | General Public License for more details. |
24 | cc40185c | Iustin Pop | |
25 | cc40185c | Iustin Pop | You should have received a copy of the GNU General Public License |
26 | cc40185c | Iustin Pop | along with this program; if not, write to the Free Software |
27 | cc40185c | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
28 | cc40185c | Iustin Pop | 02110-1301, USA. |
29 | cc40185c | Iustin Pop | |
30 | cc40185c | Iustin Pop | -} |
31 | cc40185c | Iustin Pop | |
32 | cc40185c | Iustin Pop | module Ganeti.Curl.Internal |
33 | cc40185c | Iustin Pop | ( CurlMsgCode(..) |
34 | cc40185c | Iustin Pop | , toMsgCode |
35 | cc40185c | Iustin Pop | , fromMsgCode |
36 | cc40185c | Iustin Pop | , CurlMsg(..) |
37 | cc40185c | Iustin Pop | , errorBufferSize |
38 | cc40185c | Iustin Pop | , CurlMCode(..) |
39 | cc40185c | Iustin Pop | , toMCode |
40 | cc40185c | Iustin Pop | ) where |
41 | cc40185c | Iustin Pop | |
42 | cc40185c | Iustin Pop | import Foreign |
43 | cc40185c | Iustin Pop | import Foreign.C.Types |
44 | cc40185c | Iustin Pop | |
45 | cc40185c | Iustin Pop | import Network.Curl |
46 | cc40185c | Iustin Pop | |
47 | cc40185c | Iustin Pop | #include <curl/curl.h> |
48 | cc40185c | Iustin Pop | |
49 | cc40185c | Iustin Pop | -- | Data representing a @CURLMSG@ enum. |
50 | cc40185c | Iustin Pop | data CurlMsgCode = CurlMsgNone |
51 | cc40185c | Iustin Pop | | CurlMsgDone |
52 | cc40185c | Iustin Pop | | CurlMsgUnknown CInt -- ^ Haskell specific code for |
53 | cc40185c | Iustin Pop | -- unknown codes |
54 | cc40185c | Iustin Pop | deriving (Show, Eq) |
55 | cc40185c | Iustin Pop | |
56 | cc40185c | Iustin Pop | -- | Data representing a @struct CURLMsg@. |
57 | cc40185c | Iustin Pop | data CurlMsg = CurlMsg |
58 | cc40185c | Iustin Pop | { cmMessage :: CurlMsgCode -- ^ The message type |
59 | cc40185c | Iustin Pop | , cmHandle :: CurlH -- ^ The internal curl handle to which it applies |
60 | cc40185c | Iustin Pop | , cmResult :: CurlCode -- ^ The message-specific result |
61 | cc40185c | Iustin Pop | } |
62 | cc40185c | Iustin Pop | |
63 | cc40185c | Iustin Pop | -- | Partial 'Storable' instance for 'CurlMsg'; we do not extract all |
64 | cc40185c | Iustin Pop | -- fields, only the one we are interested in. |
65 | cc40185c | Iustin Pop | instance Storable CurlMsg where |
66 | cc40185c | Iustin Pop | sizeOf _ = (#size CURLMsg) |
67 | cc40185c | Iustin Pop | alignment _ = alignment (undefined :: CInt) |
68 | cc40185c | Iustin Pop | peek ptr = do |
69 | cc40185c | Iustin Pop | msg <- (#peek CURLMsg, msg) ptr |
70 | cc40185c | Iustin Pop | handle <- (#peek CURLMsg, easy_handle) ptr |
71 | cc40185c | Iustin Pop | result <- (#peek CURLMsg, data.result) ptr |
72 | cc40185c | Iustin Pop | return $ CurlMsg (toMsgCode msg) handle (toCode result) |
73 | cc40185c | Iustin Pop | poke ptr (CurlMsg msg handle result) = do |
74 | cc40185c | Iustin Pop | (#poke CURLMsg, msg) ptr (fromMsgCode msg) |
75 | cc40185c | Iustin Pop | (#poke CURLMsg, easy_handle) ptr handle |
76 | cc40185c | Iustin Pop | (#poke CURLMsg, data.result) ptr ((fromIntegral $ fromEnum result)::CInt) |
77 | cc40185c | Iustin Pop | |
78 | cc40185c | Iustin Pop | -- | Minimum buffer size for 'CurlErrorBuffer'. |
79 | cc40185c | Iustin Pop | errorBufferSize :: Int |
80 | cc40185c | Iustin Pop | errorBufferSize = (#const CURL_ERROR_SIZE) |
81 | cc40185c | Iustin Pop | |
82 | cc40185c | Iustin Pop | -- | Multi interface error codes. |
83 | cc40185c | Iustin Pop | data CurlMCode = CurlmCallMultiPerform |
84 | cc40185c | Iustin Pop | | CurlmOK |
85 | cc40185c | Iustin Pop | | CurlmBadHandle |
86 | cc40185c | Iustin Pop | | CurlmBadEasyHandle |
87 | cc40185c | Iustin Pop | | CurlmOutOfMemory |
88 | cc40185c | Iustin Pop | | CurlmInternalError |
89 | cc40185c | Iustin Pop | | CurlmBadSocket |
90 | cc40185c | Iustin Pop | | CurlmUnknownOption |
91 | cc40185c | Iustin Pop | | CurlmUnknown CInt -- ^ Haskell specific code denoting |
92 | cc40185c | Iustin Pop | -- undefined codes (e.g. when |
93 | cc40185c | Iustin Pop | -- libcurl has defined new codes |
94 | cc40185c | Iustin Pop | -- that are not implemented yet) |
95 | cc40185c | Iustin Pop | deriving (Show, Eq) |
96 | cc40185c | Iustin Pop | |
97 | cc40185c | Iustin Pop | -- | Convert a CInt CURLMSG code (as returned by the C library) to a |
98 | cc40185c | Iustin Pop | -- 'CurlMsgCode'. When an unknown code is received, the special |
99 | cc40185c | Iustin Pop | -- 'CurlMsgUnknown' constructor will be used. |
100 | cc40185c | Iustin Pop | toMsgCode :: CInt -> CurlMsgCode |
101 | cc40185c | Iustin Pop | toMsgCode (#const CURLMSG_NONE) = CurlMsgNone |
102 | cc40185c | Iustin Pop | toMsgCode (#const CURLMSG_DONE) = CurlMsgDone |
103 | cc40185c | Iustin Pop | toMsgCode v = CurlMsgUnknown v |
104 | cc40185c | Iustin Pop | |
105 | cc40185c | Iustin Pop | -- | Convert a CurlMsgCode to a CInt. |
106 | cc40185c | Iustin Pop | fromMsgCode :: CurlMsgCode -> CInt |
107 | cc40185c | Iustin Pop | fromMsgCode CurlMsgNone = (#const CURLMSG_NONE) |
108 | cc40185c | Iustin Pop | fromMsgCode CurlMsgDone = (#const CURLMSG_DONE) |
109 | cc40185c | Iustin Pop | fromMsgCode (CurlMsgUnknown v) = v |
110 | cc40185c | Iustin Pop | |
111 | cc40185c | Iustin Pop | -- | Convert a CInt CURLMcode (as returned by the C library) to a |
112 | cc40185c | Iustin Pop | -- 'CurlMCode'. When an unknown code is received, the special |
113 | cc40185c | Iustin Pop | -- 'CurlmUnknown' constructor will be used. |
114 | cc40185c | Iustin Pop | toMCode :: CInt -> CurlMCode |
115 | cc40185c | Iustin Pop | toMCode (#const CURLM_CALL_MULTI_PERFORM) = CurlmCallMultiPerform |
116 | cc40185c | Iustin Pop | toMCode (#const CURLM_OK) = CurlmOK |
117 | cc40185c | Iustin Pop | toMCode (#const CURLM_BAD_HANDLE) = CurlmBadHandle |
118 | cc40185c | Iustin Pop | toMCode (#const CURLM_BAD_EASY_HANDLE) = CurlmBadEasyHandle |
119 | cc40185c | Iustin Pop | toMCode (#const CURLM_OUT_OF_MEMORY) = CurlmOutOfMemory |
120 | cc40185c | Iustin Pop | toMCode (#const CURLM_INTERNAL_ERROR) = CurlmInternalError |
121 | cc40185c | Iustin Pop | toMCode (#const CURLM_BAD_SOCKET) = CurlmBadSocket |
122 | cc40185c | Iustin Pop | toMCode (#const CURLM_UNKNOWN_OPTION) = CurlmUnknownOption |
123 | cc40185c | Iustin Pop | toMCode v = CurlmUnknown v |