network-api-support (empty) → 0.0.1
raw patch · 5 files changed
+179/−0 lines, 5 filesdep +basedep +bytestringdep +case-insensitivesetup-changed
Dependencies added: base, bytestring, case-insensitive, certificate, failure, http-conduit, http-types, resourcet, text, tls, tls-extra, transformers
Files
- LICENSE +27/−0
- Setup.hs +3/−0
- network-api-support.cabal +53/−0
- src/Network/Api/Support.hs +14/−0
- src/Network/Api/Support/Core.hs +82/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2012, Mark Hibberd <mark@hibberd.id.au>+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 apiengine 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 THE COPYRIGHT HOLDER 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ network-api-support.cabal view
@@ -0,0 +1,53 @@+Name: network-api-support+Version: 0.0.1+License: BSD3+License-File: LICENSE+Author: Mark Hibberd <mark@hibberd.id.au>+Maintainer: Mark Hibberd <mark@hibberd.id.au>+Copyright: (c) 2012 Mark Hibberd+Synopsis: Toolkit for building http client libraries over Network.Http.Conduit+Category: Network APIs+Homepage: https://github.com/apiengine/network-api-support+Bug-reports: https://github.com/apiengine/network-api-support/issues+Cabal-Version: >= 1.8+Build-Type: Simple+Description:+ Toolkit for building http client libraries over Network.Http.Conduit.+ .+ /Note/: This library is under heavy development, currently+ the library is functional but undocumented. Examples of use+ can be found in the pin and postmark client libraries.+ Basically expect improvements and change.++Source-Repository head+ Type: git+ Location: https://github.com/apiengine/network-api-support.git++Flag small_base+ Description: Choose the new, split-up base package.++Library+ Build-Depends:+ base >= 3 && < 5+ , bytestring >= 0.9+ , case-insensitive >= 0.4+ , certificate >= 1.2+ , failure >= 0.2+ , http-conduit >= 1.4+ , http-types >= 0.6+ , resourcet >= 0.3+ , text >= 0.11+ , tls >= 0.9+ , tls-extra >= 0.4+ , transformers >= 0.2++ GHC-Options:+ -Wall -fno-warn-orphans++ Hs-Source-Dirs:+ src++ Exposed-Modules:+ Network.Api.Support+ Network.Api.Support.Core+
+ src/Network/Api/Support.hs view
@@ -0,0 +1,14 @@+-- |+-- Module: Network.Api.Support+-- Copyright: (c) 2012 Mark Hibberd+-- License: BSD3+-- Maintainer: Mark Hibberd <mark@hibberd.id.au>+-- Portability: portable+--+-- Toolkit for building http client libraries over Network.Http.Conduit+--+module Network.Api.Support (module X) where++import Network.Api.Support.Core as X++
+ src/Network/Api/Support/Core.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}+module Network.Api.Support.Core (+ (<&>)+, checkDomainOnly+, setApiKey+, setParams+, setMethod+, setPost+, setGet+, setDelete+, setPut+, setHeaders+, runRequest+, RequestTransformer+) where++import Control.Failure+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Resource++import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as BL+import Data.CaseInsensitive+import Data.Certificate.X509 (X509)+import Data.Text+import Data.Monoid++import Network.HTTP.Conduit+import Network.HTTP.Types+import Network.TLS (TLSCertificateUsage)+import Network.TLS.Extra (certificateVerifyDomain)++infixr 5 <&>++(<&>) :: Monoid m => m -> m -> m+(<&>) = mappend++checkDomainOnly :: B8.ByteString -> [X509] -> IO TLSCertificateUsage+checkDomainOnly host' certs = return $ certificateVerifyDomain (B8.unpack host') certs++withCustomManager :: (MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m) =>+ ManagerSettings -> (Manager -> ResourceT m a) -> m a+withCustomManager settings f = runResourceT $+ allocate (newManager settings) closeManager >>= \(_, manager) -> f manager++type RequestTransformer m = Endo (Request (ResourceT m))++setApiKey :: B.ByteString -> RequestTransformer m+setApiKey key = Endo $ applyBasicAuth key ""++setParams :: (Monad m) => [(B.ByteString, B.ByteString)] -> RequestTransformer m+setParams params = Endo $ urlEncodedBody params++setMethod :: B.ByteString -> RequestTransformer m+setMethod m = Endo $ \r -> r { method = m }++setGet :: RequestTransformer m+setGet = setMethod "GET"++setPut :: RequestTransformer m+setPut = setMethod "PUT"++setPost :: RequestTransformer m+setPost = setMethod "POST"++setDelete :: RequestTransformer m+setDelete = setMethod "DELETE"++setHeaders :: [(CI Ascii, B.ByteString)] -> RequestTransformer m+setHeaders m = Endo $ \r -> r { requestHeaders = m }++runRequest ::+ (MonadIO m, MonadBaseControl IO m, MonadThrow m, MonadUnsafeIO m, Failure HttpException m) =>+ ManagerSettings -> Text -> RequestTransformer m -> (Response BL.ByteString -> b) -> m b+runRequest settings url transform responder =+ parseUrl (unpack url) >>= \url' ->+ (liftM responder . withCustomManager settings . httpLbs) ((appEndo transform $ url' {+ checkStatus = const . const $ Nothing+ }))+