easy-api (empty) → 0.1.0.0

raw patch · 4 files changed

+114/−0 lines, 4 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, either, http-conduit, mtl, resourcet, text

Files

• LICENSE +20/−0
• Setup.hs +2/−0
• easy-api.cabal +19/−0
• src/Network/HTTP/API.hs +73/−0

@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2013 SaneTracker++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

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

@@ -0,0 +1,19 @@+name:                easy-api+version:             0.1.0.0+synopsis:            Utility code for building HTTP API bindings more quickly.+description:         Utility code for building HTTP API bindings more quickly.+homepage:            http://github.com/sanetracker/easy-api+license:             MIT+license-file:        LICENSE+author:              Ian Duncan+maintainer:          ian@iankduncan.com+category:            Web+build-type:          Simple+cabal-version:       >=1.8+source-repository    head+  type:                git+  location:            http://github.com/sanetracker/easy-api+library+  exposed-modules:     Network.HTTP.API+  build-depends:       base ==4.6.*, mtl ==2.1.*, bytestring ==0.10.*, text ==0.11.*, aeson, http-conduit, resourcet, either+  hs-source-dirs:      src

@@ -0,0 +1,73 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}+module Network.HTTP.API where+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Trans.Either+import Control.Monad.Trans.Resource+import Data.Aeson+import Data.ByteString (ByteString)+import Data.Maybe+import Data.Text.Encoding+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Network.HTTP.Conduit++data APIError = InvalidJSON | ExceptionalStatusCodeError String+  deriving (Show)++type RequestMiddleware = Request (ResourceT IO) -> Request (ResourceT IO)++runAPIClient :: String -> RequestMiddleware -> APIClient a -> IO (Either APIError a)+runAPIClient base middleware m = withManager $ \man -> do+  r <- parseUrl base+  runEitherT $ runReaderT (fromAPIClient m) $ ClientSettings r man middleware++jsonize :: (FromJSON a) => Response L.ByteString -> APIClient (Response a)+jsonize r = APIClient $ case decode $ responseBody r of+    Nothing -> lift $ left InvalidJSON+    Just jsonResp -> return $ r { responseBody = jsonResp }++data ClientSettings = ClientSettings+  { baseRequest :: Request (ResourceT IO)+  , clientManager :: Manager+  , requestMiddleware :: RequestMiddleware+  }++newtype APIClient a = APIClient { fromAPIClient :: ReaderT ClientSettings (EitherT APIError (ResourceT IO)) a }+  deriving (Functor, Applicative, Monad, MonadIO)++get :: FromJSON a => ByteString -> APIClient (Response a)+get p = APIClient $ do+  (ClientSettings req man middleware) <- ask+  let r = middleware $ req { path = p }+  resp <- lift $ lift $ httpLbs r man+  fromAPIClient $ jsonize resp++put :: (ToJSON a, FromJSON b) => ByteString -> a -> APIClient (Response b)+put p v = APIClient $ do+  (ClientSettings req man middleware) <- ask+  let r = middleware $ req { method = "PUT", path = p, requestBody = RequestBodyLBS $ encode v }+  resp <- lift $ lift $ httpLbs r man+  fromAPIClient $ jsonize resp++post :: (ToJSON a, FromJSON b) => ByteString -> a -> APIClient (Response b)+post p v = APIClient $ do+  (ClientSettings req man middleware) <- ask+  let r = middleware $ req { method = "POST", path = p, requestBody = RequestBodyLBS $ encode v }+  resp <- lift $ lift $ httpLbs r man+  fromAPIClient $ jsonize resp++patch :: (ToJSON a, FromJSON b) => ByteString -> a -> APIClient (Response b)+patch p v = APIClient $ do+  (ClientSettings req man middleware) <- ask+  let r = middleware $ req { method = "PATCH", path = p, requestBody = RequestBodyLBS $ encode v }+  resp <- lift $ lift $ httpLbs r man+  fromAPIClient $ jsonize resp++delete :: (ToJSON a, FromJSON b) => ByteString -> a -> APIClient (Response b)+delete p v = APIClient $ do+  (ClientSettings req man middleware) <- ask+  let r = middleware $ req { method = "DELETE", path = p, requestBody = RequestBodyLBS $ encode v }+  resp <- lift $ lift $ httpLbs r man+  fromAPIClient $ jsonize resp+