diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,24 @@ +Copyright (c) 2013, Joel Lehtonen +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 the nor the + names of its 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 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/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/curl-aeson.cabal b/curl-aeson.cabal new file mode 100644 --- /dev/null +++ b/curl-aeson.cabal @@ -0,0 +1,38 @@ +name: curl-aeson +version: 0.0.3 +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, + bytestring, + curl >= 1.3.7, + text + +source-repository head + type: git + location: git://github.com/zouppen/haskell-curl-aeson.git diff --git a/src/Network/Curl/Aeson.hs b/src/Network/Curl/Aeson.hs new file mode 100644 --- /dev/null +++ b/src/Network/Curl/Aeson.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} +-- | +-- Module : Network.Curl.Aeson +-- Copyright : (c) 2013, Joel Lehtonen +-- License : BSD3 +-- +-- Maintainer: Joel Lehtonen +-- Stability : experimental +-- Portability: portable +-- +-- Functions for communicating with JSON over HTTP connection. + +module Network.Curl.Aeson + ( -- * How to use this library + -- $use + + -- * Sending HTTP request + curlAesonGet + , curlAesonGetWith + , curlAeson + -- * Helper functions + , cookie + , rawJson + , (...) + , noData + -- * Exception handling + , CurlAesonException(..) + ) where + +import Control.Exception +import Control.Monad +import Data.Aeson +import Data.Aeson.Types +import Data.ByteString.Lazy.Char8 (pack,unpack) +import Data.Maybe +import Data.Text (Text) +import Data.Typeable +import Network.Curl + +-- | 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 + +-- | 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 + +-- | Send single HTTP 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 it is parseable +-- with 'decode'. +-- +-- 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 + -- 'pure' if you want it in AST format. + -> String -- ^ Request method + -> URLString -- ^ Request URL + -> [CurlOption] -- ^ Session cookies, or other cURL + -- options. Use empty list if you don't need + -- any. + -> 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 $ pack 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 [unpack $ encode a] + ,CurlHttpHeaders ["Content-type: application/json"] + ] + +-- | Helper function for writing parsers for JSON objects which are +-- not needed to be parsed completely. +-- +-- In this example we are parsing JSON from +-- . Note the use of the +-- @OverloadedStrings@ language extension which enables 'Text' values +-- to be written as string literals. +-- +-- @p ('Object' o) = 'pure' obj'...'\"glossary\"'...'\"title\" +--p _ = 'mzero' +-- @ +(...) :: FromJSON b + => Parser Object -- ^ Parser to JSON object to look into + -> Text -- ^ Key to look for + -> Parser b -- ^ Parser to the resulting field +(...) p s = do + o <- p + o .: s + +-- Precedence should be higher than >> and >>= but lower than ++ +infixl 4 ... + +-- | Single cookie of given key and value. +cookie :: String -> String -> CurlOption +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 . pack + +-- |To avoid ambiguity in type checker you may pass this value instead +-- of Nothing to 'curlAeson'. +noData :: Maybe Value +noData = Nothing + +-- | 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) +instance Exception CurlAesonException + +-- $use +-- +-- To get bid and ask levels as a pair from a Bitcoin exchange using its public +-- API: +-- +-- @{-\# 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' +-- @ +-- +-- 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 +-- +--data Ticker = Ticker { bid :: 'Double' +-- , ask :: 'Double' +-- } deriving ('Show') +-- +--instance 'FromJSON' Ticker where +-- parseJSON ('Object' o) = Ticker '<$>' o '.:' \"bid\" '<*>' o '.:' \"ask\" +-- parseJSON _ = 'mzero' +-- +--ticker :: 'IO' Ticker +--ticker = 'curlAesonGet' \"https:\/\/bitcoin-central.net\/api\/v1\/ticker\/eur\" +-- @