aeson-streams (empty) → 0.1.0

raw patch · 4 files changed

+230/−0 lines, 4 filesdep +HsOpenSSLdep +aesondep +attoparsecsetup-changed

Dependencies added: HsOpenSSL, aeson, attoparsec, base, bytestring, http-streams, io-streams

Files

LICENSE +27/−0
Network/Aeson/Client.hs +174/−0
Setup.hs +2/−0
aeson-streams.cabal +27/−0

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright: (c) Vo Minh Thu, 2014.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. 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.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS 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 AUTHORS 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.

+ Network/Aeson/Client.hs view

@@ -0,0 +1,174 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+module Network.Aeson.Client where++import Data.Aeson hiding (Result)+import Data.Attoparsec.ByteString (parseWith, IResult(..))+import qualified Data.ByteString.Lazy.Char8 as LB+import qualified Data.ByteString.Char8 as B+import Data.Maybe (fromMaybe)+import Network.Http.Client+import OpenSSL (withOpenSSL)+import System.IO (hFlush, hPutStrLn, stderr)+import qualified System.IO.Streams as Streams++-- | Execute a GET agains the specified URI (e.g. `/v1`) using the+-- supplied parameters.+apiGet :: FromJSON a =>+  Maybe (B.ByteString, B.ByteString)+  -> B.ByteString+  -> B.ByteString+  -> [(B.ByteString, Maybe B.ByteString)] -> IO (Maybe a)+apiGet mbasic base uri parameters = withOpenSSL $ do+  let url = B.concat [uri, queryString parameters]+  q <- buildRequest $ do+    http GET url+    maybe (return ()) (uncurry setAuthorizationBasic) mbasic++  c <- establishConnection base+  -- debug q+  sendRequest c q emptyBody+  receiveResponse' c++-- | Execute a POST agains the specified URI (e.g. `/v1`) using the+-- supplied parameters.+apiPost :: FromJSON a =>+  Maybe (B.ByteString, B.ByteString)+  -> B.ByteString+  -> B.ByteString+  -> [(B.ByteString, Maybe B.ByteString)] -> LB.ByteString -> IO (Maybe a)+apiPost mbasic base uri parameters body = withOpenSSL $ do+  let url = B.concat [uri, queryString parameters]+  q <- buildRequest $ do+    http POST url+    maybe (return ()) (uncurry setAuthorizationBasic) mbasic+    setContentLength (fromIntegral $ LB.length body)+    setContentType "application/json"++  c <- establishConnection base+  -- debug q+  body' <- Streams.fromLazyByteString body+  sendRequest c q (inputStreamBody body')+  receiveResponse' c++-- | Execute a DELETE agains the specified URI (e.g. `/v1`) using the+-- supplied parameters.+apiDelete :: FromJSON a =>+  Maybe (B.ByteString, B.ByteString)+  -> B.ByteString+  -> B.ByteString+  -> [(B.ByteString, Maybe B.ByteString)] -> IO (Result a)+apiDelete mbasic base uri parameters = withOpenSSL $ do+  let url = B.concat [uri, queryString parameters]+  q <- buildRequest $ do+    http DELETE url+    maybe (return ()) (uncurry setAuthorizationBasic) mbasic++  c <- establishConnection base+  -- debug q+  sendRequest c q emptyBody+  -- TODO assert 204 for upcloud++  r <- receiveResponse c $ \p' i -> do+    case getStatusCode p' of+      204 -> return Ok+      _ -> do+        x <- Streams.read i+        let more = Streams.read i >>= return . fromMaybe ""+        p <- parseWith more json $ fromMaybe "" x+        case p of+          Done _ value -> do+            -- debug value+            case fromJSON value of+              Success value' -> do+                return $ Value value'+              _ -> return JsonFailure+          _ -> return ParseFailure+  closeConnection c+  return r++data Result a =+    Ok+  -- ^ Success and empty result+  | Value a+  -- ^ Succes and non-empty result+  | JsonFailure+  -- ^ Can't turn JSON into a proper result+  | ParseFailure+  -- ^ Can't parse JSON+  deriving Show++-- | Execute a PUT agains the specified URI using the+-- supplied parameters.+apiPut ::+  Maybe (B.ByteString, B.ByteString)+  -> B.ByteString+  -> B.ByteString+  -> [(B.ByteString, Maybe B.ByteString)]+  -> LB.ByteString+  -> IO ()+apiPut mbasic base uri parameters body = withOpenSSL $ do+  let url = B.concat [uri, queryString parameters]+  q <- buildRequest $ do+    http PUT url+    setContentLength (fromIntegral $ LB.length body)+    setContentType "application/json"+    maybe (return ()) (uncurry setAuthorizationBasic) mbasic++  c <- establishConnection base+  -- debug q+  body' <- Streams.fromLazyByteString body+  sendRequest c q (inputStreamBody body')+  -- TODO assert 204 for upcloud++-- | Execute a PATCH agains the specified URI using the+-- supplied parameters.+apiPatch ::+  Maybe (B.ByteString, B.ByteString)+  -> B.ByteString+  -> B.ByteString+  -> [(B.ByteString, Maybe B.ByteString)]+  -> LB.ByteString+  -> IO ()+apiPatch mbasic base uri parameters body = withOpenSSL $ do+  let url = B.concat [uri, queryString parameters]+  q <- buildRequest $ do+    http PATCH url+    setContentLength (fromIntegral $ LB.length body)+    setContentType "application/json"+    maybe (return ()) (uncurry setAuthorizationBasic) mbasic++  c <- establishConnection base+  -- debug q+  body' <- Streams.fromLazyByteString body+  sendRequest c q (inputStreamBody body')+  -- TODO assert 204 for upcloud++receiveResponse' :: FromJSON a => Connection -> IO (Maybe a)+receiveResponse' c = do+  r <- receiveResponse c $ \_ i -> do+    x <- Streams.read i+    let more = Streams.read i >>= return . fromMaybe ""+    p <- parseWith more json $ fromMaybe "" x+    case p of+      Done _ value -> do+        -- debug value+        case fromJSON value of+          Success value' -> do+            return $ Just value'+          _ -> return Nothing+      _ -> return Nothing+  closeConnection c+  return r++queryString :: [(B.ByteString, Maybe B.ByteString)] -> B.ByteString+queryString [] = ""+queryString xs = B.cons '?' . B.intercalate "&" . map f $ xs+  where f (a, Just b) = B.concat [a, "=", b]+        f (a, _) = a++debug :: Show a => a -> IO ()+debug s = do+  hPutStrLn stderr $ show s+  hFlush stderr

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ aeson-streams.cabal view

@@ -0,0 +1,27 @@+name:                aeson-streams+version:             0.1.0+Cabal-Version:       >= 1.8+synopsis:            An HTTP client library for JSON-based APIs+description:         An HTTP client library for JSON-based APIs using aeson and http-streams.+category:            Web+license:             BSD3+license-file:        LICENSE+author:              Vo Minh Thu+maintainer:          thu@hypered.io+build-type:          Simple+homepage:            https://github.com/noteed/aeson-streams++source-repository head+  type: git+  location: git://github.com/noteed/aeson-streams.git++library+  build-depends:       aeson == 0.6.*,+                       attoparsec == 0.10.*,+                       base == 4.*,+                       bytestring > 0.9 && < 0.11,+                       HsOpenSSL == 0.10.*,+                       http-streams >= 0.7 && <= 0.9,+                       io-streams == 1.1.*+  exposed-modules:     Network.Aeson.Client+  ghc-options:         -Wall