diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2023, Oleg Grenrus + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Oleg Grenrus nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/example/minicurl-example.hs b/example/minicurl-example.hs new file mode 100644 --- /dev/null +++ b/example/minicurl-example.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main (main) where + +import qualified Crypto.Hash.SHA256 as SHA256 +import qualified Data.ByteString as BS +import Test.HUnit ((@?=)) + +import MiniCurl + +main :: IO () +main = withLibcurl $ do + withCurl $ \curl -> do + curlResponseCode curl >>= print + + bs1 <- curlPerform curl "http://oleg.fi/ClojuTre19.pdf" 188177 + curlResponseCode curl >>= print + SHA256.hash bs1 @?= "\180A\131A\136>= print + SHA256.hash bs2 @?= "\180A\131A\136 +#include +#include +#include + +/************************************************************************* + * declarations + *************************************************************************/ + +static inline int hs_minicurl_global_init(); +static inline void hs_minicurl_global_cleanup(); + +static inline CURL *hs_minicurl_init(); +static inline void hs_minicurl_cleanup(CURL *curl); + +static inline int hs_minicurl_perform(CURL *curl, const char *url, uint8_t *ptr, size_t size); +static inline int hs_minicurl_response_code(CURL *curl); + +/************************************************************************* + * implementations + *************************************************************************/ + +static inline int hs_minicurl_global_init() { + return curl_global_init(CURL_GLOBAL_ALL); +} + +static inline void hs_minicurl_global_cleanup() { + return curl_global_cleanup(); +} + +static inline CURL *hs_minicurl_init() { + CURL *curl = curl_easy_init(); + if (curl == NULL) return NULL; + + /* Set common options */ + curl_easy_setopt(curl, CURLOPT_NOSIGNAL, 1L); + curl_easy_setopt(curl, CURLOPT_FAILONERROR, 1L); + /* CURLcode curl_easy_setopt(curl, CURLOPT_FOLLOWLOCATION, 1L); */ + + return curl; +} + +static inline void hs_minicurl_cleanup(CURL *curl) { + curl_easy_cleanup(curl); +} + +struct hs_minicurl_buffer { + uint8_t *data; + size_t off; + size_t len; +}; + +static inline size_t write_data(uint8_t *read_buf, size_t always_one, size_t n, struct hs_minicurl_buffer *write_buf) { + /* printf("write_data %p %lu %lu %p %lu %lu\n", read_buf, always_one, n, write_buf->data, write_buf->off, write_buf->len); */ + + if (write_buf->off >= write_buf->len) { + return 0; + } + + size_t p = write_buf->len - write_buf->off; + size_t m = n > p ? p : n; /* MIN(n, p) */ + + memcpy(write_buf->data + write_buf->off, read_buf, m); + write_buf->off += m; + + return m; +} + +static inline int hs_minicurl_perform(CURL *curl, const char *url, uint8_t *ptr, size_t size) { + CURLcode res = CURLE_OK; + + if (curl == NULL) return CURLE_FAILED_INIT; + + struct hs_minicurl_buffer buf = { .data = ptr, .off = 0, .len = size }; + + curl_easy_setopt(curl, CURLOPT_URL, url); + curl_easy_setopt(curl, CURLOPT_WRITEFUNCTION, write_data); + curl_easy_setopt(curl, CURLOPT_WRITEDATA, &buf); + + return curl_easy_perform(curl); +} + +static inline int hs_minicurl_response_code(CURL *curl) { + long codep = 0; + curl_easy_getinfo(curl, CURLINFO_RESPONSE_CODE, &codep); + return codep; +} + +#endif diff --git a/minicurl.cabal b/minicurl.cabal new file mode 100644 --- /dev/null +++ b/minicurl.cabal @@ -0,0 +1,57 @@ +cabal-version: 3.0 +name: minicurl +version: 0 +synopsis: Minimal bindings to libcurl +category: Network +description: + Minimal bindings to @libcurl@. + Allows to download files if you know their size. + +author: Oleg Grenrus +maintainer: Oleg Grenrus +homepage: https://github.com/phadej/minicurl +bug-reports: https://github.com/phadej/minicurl/issues +license: BSD-3-Clause +license-file: LICENSE +extra-source-files: include/hs_minicurl.h +tested-with: + GHC ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.4 + || ==8.10.7 + || ==9.0.2 + || ==9.2.5 + || ==9.4.4 + +source-repository head + type: git + location: https://github.com/phadej/minicurl.git + +library + default-language: Haskell2010 + hs-source-dirs: src + include-dirs: include + ghc-options: -Wall + exposed-modules: MiniCurl + pkgconfig-depends: libcurl >=7.58.0 + build-depends: + , base >=4.9.0.0 && <4.18 + , bytestring ^>=0.10.8.1 || ^>=0.11.3.1 + +-- this "test-suite" requires internet connection. +test-suite minicurl-example + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: example + main-is: minicurl-example.hs + build-depends: + , base + , bytestring + , minicurl + + -- test dependencies + build-depends: + , cryptohash-sha256 ^>=0.11.102.1 + , HUnit ^>=1.6.2.0 diff --git a/src/MiniCurl.hs b/src/MiniCurl.hs new file mode 100644 --- /dev/null +++ b/src/MiniCurl.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE CApiFFI #-} +{-# LANGUAGE CPP #-} +module MiniCurl ( + CURL, + withLibcurl, + withCurl, + curlPerform, + curlResponseCode, +) where + +import Control.Exception (bracket, bracket_) +import Data.ByteString.Internal (ByteString (..)) +import Data.Coerce (coerce) +import Data.Word (Word8) +import Foreign.C.String (CString, withCString) +import Control.Concurrent.MVar +import Foreign.C.Types (CInt (..), CSize (..)) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr (Ptr) +import GHC.ForeignPtr (mallocPlainForeignPtrBytes) + +-- | Curl handle. +newtype CURL = CURL (MVar (Ptr Curl)) + +-- | (Globally) initialize @libcurl@. +-- +-- Wrap your @main@ in it: +-- +-- @ +-- main :: IO () +-- main = 'withLibcurl' $ do +-- ... +-- @ +-- +withLibcurl :: IO r -> IO r +withLibcurl = bracket_ c_minicurl_global_init c_minicurl_global_cleanup + +-- | Create curl handle. +-- +-- Note: you can reuse 'CURL' handle for multiple requests. +withCurl :: (CURL -> IO r) -> IO r +withCurl kont = bracket c_minicurl_init c_minicurl_cleanup $ \ptr -> + newMVar ptr >>= coerce kont + +-- | Perform request. +-- +-- The resulting 'ByteString' will be exactly of the size specified by size argument. +-- If response is smaller, the rest will be zeros; if larger the response will be truncated (not read further)! +-- It's your job to verify that transport was successful, e.g. if you know the expected hash of the download. +-- +-- 'curlPerform' is thread-safe (underlying handle in 'CURL' is wrapped in 'MVar'). +-- +curlPerform + :: CURL -- ^ CURL handle + -> String -- ^ URL + -> Int -- ^ Expected size of the output. + -> IO ByteString +curlPerform (CURL curlMVar) url size = withMVar curlMVar $ \curl -> do + fptr <- mallocPlainForeignPtrBytes size + withForeignPtr fptr $ \ptr -> + withCString url $ \c_url -> do + _res <- c_minicurl_perform curl c_url ptr (fromIntegral size :: CSize) + return () + +#if MIN_VERSION_bytestring(0,11,0) + return $ BS fptr size +#else + return $ PS fptr 0 size +#endif + +-- | Get (last) response code. +curlResponseCode :: CURL -> IO Int +curlResponseCode (CURL curlMVar) = withMVar curlMVar $ \curl -> + fromIntegral <$> c_minicurl_response_code curl + +------------------------------------------------------------------------------- +-- FFI +------------------------------------------------------------------------------- + +data Curl + +foreign import capi safe "hs_minicurl.h hs_minicurl_global_init" c_minicurl_global_init :: IO CInt +foreign import capi safe "hs_minicurl.h hs_minicurl_global_cleanup" c_minicurl_global_cleanup :: IO () +foreign import capi safe "hs_minicurl.h hs_minicurl_init" c_minicurl_init :: IO (Ptr Curl) +foreign import capi safe "hs_minicurl.h hs_minicurl_cleanup" c_minicurl_cleanup :: Ptr Curl -> IO () +foreign import capi safe "hs_minicurl.h hs_minicurl_perform" c_minicurl_perform :: Ptr Curl -> CString -> Ptr Word8 -> CSize -> IO CInt +foreign import capi safe "hs_minicurl.h hs_minicurl_response_code" c_minicurl_response_code :: Ptr Curl -> IO CInt