diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,78 @@ + + +# curl-aeson library for Haskell + +This is a library for communicating with JSON over HTTP connection. +It supports rich set of HTTP connectivity features provided by +[curl](https://github.com/galoisinc/curl) library combined to the +performance and elegance of [aeson](https://github.com/bos/aeson). + +Author: Joel Lehtonen + +This library is at its best when communicating with simple, +non-standardized JSON interfaces. If you are implementing JSON-RPC +compliant client or server, take a look at +[another library](http://hackage.haskell.org/package/jmacro-rpc). + +## Example + +In this example we fetch latest bid and ask values from a Bitcoin +exchange using +[their public API](https://github.com/paytunia/api-documentation#read-the-ticker): + +```haskell +{-# LANGUAGE OverloadedStrings #-} +import Control.Monad +import Data.Aeson +import Network.Curl.Aeson + +ticker :: IO (Double,Double) +ticker = curlAesonGetWith p "https://bitcoin-central.net/api/v1/ticker/eur" + where + p (Object o) = do + bid <- o .: "bid" + ask <- o .: "ask" + return (bid,ask) + p _ = mzero +``` + +You may find more examples from package documentation. + +## Installation + +### On Ubuntu and Debian + +Starting from Ubuntu 12.04 and Debian wheezy, all dependencies are +found from repositories: + + sudo apt-get install libghc-aeson-dev libghc-curl-dev cabal-install + +Then just install this: + + cabal install + +### Other + +Install and configure +[Haskell Platform](http://www.haskell.org/platform/). Then, fetch all the +requirements and install this library by running: + + cabal update + cabal install + +## License + +Following the convention of Haskell community, this library is +licensed under the terms of +[BSD 3-clause license](https://en.wikipedia.org/wiki/BSD_licenses#3-clause_license_.28.22Revised_BSD_License.22.2C_.22New_BSD_License.22.2C_or_.22Modified_BSD_License.22.29). +Personally I prefer GPLv3, but this library is simple enough to be +released with non-[copyleft](https://en.wikipedia.org/wiki/Copyleft) +license. + +The license text is included in LICENSE file. + +## Contact + +I'm not an expert in doing software packages, so feel free to correct +me by sending pull requests. Also, I would like to hear if you have +found my library to be useful. diff --git a/curl-aeson.cabal b/curl-aeson.cabal --- a/curl-aeson.cabal +++ b/curl-aeson.cabal @@ -1,38 +1,46 @@ -name: curl-aeson -version: 0.0.4 -synopsis: Communicate with HTTP service using JSON -description: A library for communicating with JSON over HTTP connection. - Supports rich set of HTTP connectivity features provided by - libcurl combined to the performance and elegancy of aeson. - . - All HTTP methods are supported. Instances of 'ToJSON' and - 'FromJSON' typeclasses can be transferred via this library. - Session cookies and other HTTP options may be passed to libcurl - if needed. - . - This library is at its best when communicating with simple, - non-standardized JSON interfaces. If you are implementing - JSON-RPC compliant client or server, take a look at - . -category: Network, Web, JSON -license: BSD3 -license-file: LICENSE -author: Joel Lehtonen -maintainer: joel.lehtonen+curlaeson@iki.fi -homepage: https://github.com/zouppen/haskell-curl-aeson -build-type: Simple -cabal-version: >= 1.6 - -library - hs-source-dirs: src - exposed-modules: Network.Curl.Aeson - build-depends: - aeson >= 0.6.0.0, - base >= 4 && < 5, - curl >= 1.3.7, - text, - utf8-string >= 0.3 +cabal-version: >=1.10 +name: curl-aeson +version: 0.1.0.0 +synopsis: Communicate with HTTP service using JSON +description: A library for communicating with JSON over HTTP + connection. Supports rich set of HTTP connectivity + features provided by libcurl combined to the + performance and elegancy of aeson. + . + All HTTP methods are supported. Instances of 'ToJSON' + and 'FromJSON' typeclasses can be transferred via + this library. Session cookies and other HTTP options + may be passed to libcurl if needed. + . + This library is at its best when communicating with + simple, non-standardized JSON interfaces. If you are + implementing JSON-RPC compliant client or server, + take a look at + . +category: Network, Web, JSON +license: BSD3 +license-file: LICENSE +author: Joel Lehtonen +maintainer: joel.lehtonen+curlaeson@iki.fi +homepage: https://github.com/zouppen/haskell-curl-aeson +bug-reports: https://github.com/zouppen/haskell-curl-aeson/issues +build-type: Simple +extra-source-files: README.md source-repository head - type: git - location: git://github.com/zouppen/haskell-curl-aeson.git + type: git + location: https://github.com/zouppen/haskell-curl-aeson.git + +library + exposed-modules: Network.Curl.Aeson + other-modules: Network.Curl.Aeson.Internal + other-extensions: RecordWildCards, OverloadedStrings + build-depends: base ==4.*, + aeson >= 0.6, + curl >=1.3 && <1.4, + -- Text and ByteString dependencies should be + -- in-line with aeson dependencies + bytestring >=0.10.8.1 && <0.12, + text >=1.2.3.0 && <1.3 || >=2.0 && <2.1 + hs-source-dirs: src + default-language: Haskell2010 diff --git a/src/Network/Curl/Aeson.hs b/src/Network/Curl/Aeson.hs --- a/src/Network/Curl/Aeson.hs +++ b/src/Network/Curl/Aeson.hs @@ -1,92 +1,187 @@ -{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} +{-# LANGUAGE RecordWildCards #-} -- | -- Module : Network.Curl.Aeson --- Copyright : (c) 2013, Joel Lehtonen +-- Copyright : (c) 2013-2022, Joel Lehtonen -- License : BSD3 -- -- Maintainer: Joel Lehtonen -- Stability : experimental -- Portability: portable -- --- Functions for communicating with JSON over HTTP connection. +-- Functions for communicating with JSON over HTTP, HTTPS, or any +-- protocol supported by [cURL](https://curl.se/). module Network.Curl.Aeson ( -- * How to use this library -- $use - -- * Sending HTTP request + -- * cURL requests with JSON payload and response curlAesonGet , curlAesonGetWith - , curlAeson - -- * Helper functions + , curlAesonCustom + , curlAesonCustomWith + -- * Generic cURL request + , curlAesonRaw + -- * Helpers for working with raw requests + , jsonPayload + , binaryPayload + , binaryResponse + , valueResponse + , jsonResponse + -- * Other helper functions , cookie , rawJson , (...) , noData + -- * Types + , Payload(..) + , ResponseParser -- * Exception handling , CurlAesonException(..) + -- * Deprecated functions + , curlAeson ) where import Control.Exception import Control.Monad import Data.Aeson import Data.Aeson.Types -import Data.ByteString.Lazy.UTF8 (fromString,toString) +import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as B import Data.Maybe import Data.Text (Text) import Data.Typeable import Network.Curl +import Network.Curl.Aeson.Internal -- | Shorthand for doing just a HTTP GET request and parsing the output to --- any FromJSON instance. -curlAesonGet :: (FromJSON a) => URLString -> IO a -curlAesonGet = curlAesonGetWith parseJSON +-- any 'FromJSON' instance. +curlAesonGet :: (FromJSON a) + => URLString -- ^ Request URL + -> IO a -- ^ Received and parsed data +curlAesonGet url = curlAesonCustom [] "GET" url noData -- | Shorthand for doing just a HTTP GET request and parsing the -- output with given parser /p/. -curlAesonGetWith :: (Value -> Parser a) -> URLString -> IO a -curlAesonGetWith p url = curlAeson p "GET" url [] noData +curlAesonGetWith + :: (Value -> Parser a) -- ^Aeson parser for response. Use 'pure' if + -- you want it in AST format. + -> URLString -- ^Request URL + -> IO a -- ^Received and parsed data +curlAesonGetWith p url = curlAesonCustomWith p [] "GET" url noData --- | Send single HTTP request. +-- | Send a single HTTP request and a custom parser. -- -- The request automatically has @Content-type: application/json@ -- header if you pass any data. This function is lenient on response --- content type: everything is accepted as long as it is parseable --- with 'decode'. HTTP payload is expected to be UTF-8 encoded. +-- content type; everything is accepted as long as it is valid JSON +-- and parseable with your supplied parser. -- -- If you need authentication, you need to pass session cookie or -- other means of authentication tokens via 'CurlOption' list. -curlAeson :: - (ToJSON a) - => (Value -> Parser b) -- ^ Parser for response. Use 'parseJSON' if - -- you like want to use FromJSON instance or +curlAesonCustomWith + :: (ToJSON a) + => (Value -> Parser b) -- ^ Aeson parser for response. Use -- 'pure' if you want it in AST format. + -> [CurlOption] -- ^ Session cookies, or other cURL + -- options. Use 'mempty' if you don't need + -- any. -> String -- ^ Request method -> URLString -- ^ Request URL - -> [CurlOption] -- ^ Session cookies, or other cURL - -- options. Use empty list if you don't need + -> Maybe a -- ^ JSON data to send, or 'Nothing' when + -- sending request without any content. + -> IO b -- ^ Received and parsed data +curlAesonCustomWith parser opts method url maybeValue = + curlAesonRaw + (\x -> eitherDecode x >>= parseEither parser) + opts method url + (maybeValue >>= jsonPayload) + +{-# DEPRECATED curlAeson "Use customAesonCustomWith instead" #-} +-- |See type of 'curlAesonCustomWith'. +curlAeson :: ToJSON a => (Value -> Parser b) -> String -> URLString -> [CurlOption] -> Maybe a -> IO b +curlAeson parser method url opts = curlAesonCustomWith parser opts method url + +-- | Send a single cURL request. +-- +-- The request automatically has @Content-type: application/json@ +-- header if you pass any data. This function is lenient on response +-- content type; everything is accepted as long as 'parseJSON' +-- succeeds. +-- +-- If you need authentication, you need to pass session cookie or +-- other means of authentication tokens via 'CurlOption' list. +curlAesonCustom :: + (ToJSON a, FromJSON b) + => [CurlOption] -- ^ Session cookies, or other cURL + -- options. Use 'mempty' if you don't need -- any. - -> Maybe a -- ^ JSON data to send, or Nothing when + -> String -- ^ Request method + -> URLString -- ^ Request URL + -> Maybe a -- ^ JSON data to send, or 'Nothing' when -- sending request without any content. - -> IO b -- ^ Received JSON data -curlAeson parser method url extraOpts maybeContent = do - (curlCode,received) <- curlGetString url curlOpts - when (curlCode /= CurlOK) $ throw CurlAesonException{errorMsg="HTTP error",..} - let ast = case decode $ fromString received of - Nothing -> throw CurlAesonException{errorMsg="JSON parsing failed",..} - Just x -> x - return $ case parseEither parser ast of - Left errorMsg -> throw CurlAesonException{..} - Right x -> x - where - curlOpts = commonOpts++dataOpts++extraOpts - commonOpts = [CurlCustomRequest method] - dataOpts = case maybeContent of - Nothing -> [] - Just a -> [CurlPostFields [toString $ encode a] - ,CurlHttpHeaders ["Content-type: application/json"] - ] + -> IO b -- ^ Received and parsed data +curlAesonCustom opts method url maybeValue = + curlAesonRaw eitherDecode opts method url + (maybeValue >>= jsonPayload) +-- |The most flexible function we have here. +-- +-- Sends raw cURL request with a possible payload and collects the +-- output. This function is binary safe so it works with other media +-- types than JSON and supports binary upload and JSON response +-- (common case with media uploads). +-- +-- When /payload/ is given, cURL options 'CurlReadFunction', +-- 'CurlUpload' and 'CurlInFileSizeLarge' are set and HTTP header +-- Content-Type is appended implicitly. +curlAesonRaw + :: ResponseParser a -- ^ Parser function for the response such as 'eitherDecode' + -> [CurlOption] -- ^ Extra curl options. + -> String -- ^ Request method + -> URLString -- ^ Request URL + -> Maybe Payload -- ^ Request body payload, if any. + -> IO a -- ^ Received and parsed data +curlAesonRaw parser userOpts method url maybePayload = do + -- Prepare the upload + putOpts <- case maybePayload of + Nothing -> pure userOpts + Just Payload{..} -> do + readFunc <- mkReadFunctionLazy payload + pure $ CurlReadFunction readFunc : + CurlUpload True : + CurlInFileSizeLarge (fromIntegral $ B.length payload) : + mergeHeaders [ "Content-Type: " <> contentType ] userOpts + -- Add request method + let curlOpts = CurlCustomRequest method : putOpts + -- Perform the request + (curlCode, received) <- curlGetString_ url curlOpts + when (curlCode /= CurlOK) $ + throwIO CurlAesonException{parseError = Nothing, ..} + -- Trying to parse + case parser received of + Left e -> throwIO CurlAesonException{parseError = Just e, ..} + Right x -> pure x + +-- |Internal tool to merge headers in a cURL option list +mergeHeaders :: [String] -> [CurlOption] -> [CurlOption] +mergeHeaders acc [] = [CurlHttpHeaders acc] +mergeHeaders acc ((CurlHttpHeaders x):xs) = mergeHeaders (acc <> x) xs +mergeHeaders acc (x:xs) = x:mergeHeaders acc xs + +-- |Convert a value to JSON payload. This never returns Nothing. +jsonPayload :: ToJSON a => a -> Maybe Payload +jsonPayload a = Just Payload{..} + where payload = encode a + contentType = "application/json" + +-- |Just a shortcut for defining binary payloads of given media +-- type. This never returns Nothing. +binaryPayload :: String -- ^Media type (MIME) + -> ByteString -- ^Data + -> Maybe Payload -- ^Payload +binaryPayload a b = Just $ Payload a b + -- | Helper function for writing parsers for JSON objects which are -- not needed to be parsed completely. -- @@ -95,7 +190,7 @@ -- @OverloadedStrings@ language extension which enables 'Text' values -- to be written as string literals. -- --- @p ('Object' o) = 'pure' obj'...'\"glossary\"'...'\"title\" +-- @p ('Data.Aeson.Types.Internal.Object' o) = 'pure' o'...'\"glossary\"'...'\"title\" --p _ = 'mzero' -- @ (...) :: FromJSON b @@ -111,65 +206,92 @@ -- | Single cookie of given key and value. cookie :: String -> String -> CurlOption -cookie key value = CurlCookie $ key++"="++value +cookie key value = CurlCookie $ key <> "=" <> value -- | Useful for just giving the JSON as string when it is static -- anyway and doesn't need to be programmatically crafted. -rawJson :: String -> Maybe Value -rawJson = decode . fromString +rawJson :: ByteString -> Maybe Value +rawJson = decode --- |To avoid ambiguity in type checker you may pass this value instead --- of Nothing to 'curlAeson'. +-- |Useful with 'curlAesonRaw' when you just need to take the binary output. +binaryResponse :: ResponseParser ByteString +binaryResponse = Right + +-- |Useful with 'curlAesonRaw' when you just want to get the JSON Value +valueResponse :: ResponseParser Value +valueResponse = eitherDecode + +-- |Just a friendly name for 'eitherDecode'. Can be used with +-- 'curlAesonRaw' for deserializing the response using 'FromJSON' +-- instance. +jsonResponse :: FromJSON a => ResponseParser a +jsonResponse = eitherDecode + +-- |To avoid type ambiguity you may pass this value instead +-- of Nothing to 'curlAesonCustom'. noData :: Maybe Value noData = Nothing +-- |Holds the payload for raw sender. +data Payload = Payload + { contentType :: String -- ^Content media type (MIME) + , payload :: ByteString -- ^Data + } deriving (Show) + -- | This exception is is thrown when Curl doesn't finish cleanly or -- the parsing of JSON response fails. -data CurlAesonException = CurlAesonException { url :: URLString - , curlCode :: CurlCode - , curlOpts :: [CurlOption] - , received :: String - , errorMsg :: String - } deriving (Show, Typeable) +data CurlAesonException = CurlAesonException + { url :: URLString -- ^The request URI + , curlCode :: CurlCode -- ^Curl return code + , curlOpts :: [CurlOption] -- ^Curl options set + , received :: ByteString -- ^Received raw data from the + -- server. Before version 0.1 the type + -- was 'Prelude.String'. + , parseError :: Maybe String -- ^Parse error, if it failed during parse. + } deriving (Show) + instance Exception CurlAesonException +-- |Parser type from response to your data. Normally: 'eitherDecode' +type ResponseParser a = ByteString -> Either String a + -- $use -- --- To get bid and ask levels as a pair from a Bitcoin exchange using its public --- API: +-- Let\'s simulate a service by creating a file @\/tmp\/ticker.json@ +-- with the following content: -- --- @{-\# LANGUAGE OverloadedStrings #-} ---import Control.Monad ---import Data.Aeson ---import Network.Curl.Aeson +-- > {"bid":3,"ask":3.14} -- ---ticker :: 'IO' ('Double','Double') ---ticker = 'curlAesonGetWith' p \"https:\/\/bitcoin-central.net\/api\/v1\/ticker\/eur\" --- where --- p ('Object' o) = do --- bid <- o '.:' \"bid\" --- ask <- o '.:' \"ask\" --- 'return' (bid,ask) --- p _ = 'mzero' --- @ --- --- The same as above, but we define our own data type which is an --- instance of FromJSON: --- --- @{-\# LANGUAGE OverloadedStrings #-} ---import Control.Applicative ---import Control.Monad ---import Data.Aeson ---import Network.Curl.Aeson +-- This example shows how to hand-craft the parser for the bid and ask +-- values: -- ---data Ticker = Ticker { bid :: 'Double' --- , ask :: 'Double' --- } deriving ('Show') +-- > {-# LANGUAGE OverloadedStrings #-} +-- > import Control.Monad +-- > import Data.Aeson +-- > import Network.Curl.Aeson +-- > +-- > ticker :: IO (Double,Double) +-- > ticker = curlAesonGetWith p "file:///tmp/ticker.json" +-- > where +-- > p (Object o) = do +-- > bid <- o .: "bid" +-- > ask <- o .: "ask" +-- > return (bid,ask) +-- > p _ = mzero -- ---instance 'FromJSON' Ticker where --- parseJSON ('Object' o) = Ticker '<$>' o '.:' \"bid\" '<*>' o '.:' \"ask\" --- parseJSON _ = 'mzero' +-- The same as above, but we define our own data type which is an +-- instance of 'FromJSON': -- ---ticker :: 'IO' Ticker ---ticker = 'curlAesonGet' \"https:\/\/bitcoin-central.net\/api\/v1\/ticker\/eur\" --- @ +-- > {-# LANGUAGE DeriveGeneric #-} +-- > import GHC.Generics +-- > import Data.Aeson +-- > import Network.Curl.Aeson +-- > +-- > data Ticker = Ticker { bid :: Double +-- > , ask :: Double +-- > } deriving (Generic, Show) +-- > +-- > instance FromJSON Ticker +-- > +-- > ticker :: IO Ticker +-- > ticker = curlAesonGet "file:///tmp/ticker.json" diff --git a/src/Network/Curl/Aeson/Internal.hs b/src/Network/Curl/Aeson/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Network/Curl/Aeson/Internal.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Network.Curl.Aeson +-- Copyright : (c) 2022, Joel Lehtonen +-- License : BSD3 +-- +-- Maintainer: Joel Lehtonen +-- Stability : experimental +-- Portability: portable +-- +-- Internal support functions to get ByteString payload out of +-- libcurl. +module Network.Curl.Aeson.Internal where + +import Data.IORef +import qualified Data.ByteString as B +import qualified Data.ByteString.Unsafe as B +import qualified Data.ByteString.Internal as B +import qualified Data.ByteString.Lazy as BL +import Foreign.Ptr +import Network.Curl.Opts (ReadFunction) + +-- |Creates ReadFunction which feeds strict ByteString. +mkReadFunction :: B.ByteString -> IO ReadFunction +mkReadFunction bs = feeder <$> newIORef [bs] + +-- |Creates ReadFunction which feeds lazy ByteString. +mkReadFunctionLazy :: BL.ByteString -> IO ReadFunction +mkReadFunctionLazy bs = feeder <$> newIORef (BL.toChunks bs) + +-- |ReadFunction for curl to feed in the payload +feeder :: IORef [B.ByteString] -> ReadFunction +feeder input dst size nitems _ = do + -- Take next chunk + chunk <- atomicModifyIORef input $ takeChunk $ fromIntegral $ size*nitems + -- Now doing the hard copying + B.unsafeUseAsCStringLen chunk rawCopy + pure $ Just $ fromIntegral $ B.length chunk + where rawCopy (src, srcLen) = B.memcpy (castPtr dst) (castPtr src) srcLen + +-- |Takes chunk of size 1 to /len/ bytes. In case the chunk list is +-- empty, it returns zero-length string. May give unnecessarily short +-- chunks in case of small chunks way smaller than buffer. +takeChunk :: Int -> [B.ByteString] -> ([B.ByteString], B.ByteString) +takeChunk len [] = ([], "") +takeChunk len ("":xs) = takeChunk len xs +takeChunk len (chunk:xs) = + let (now, later) = B.splitAt len chunk + in (later:xs, now)