monad-http (empty) → 0.1.0.0

raw patch · 7 files changed

+450/−0 lines, 7 filesdep +MonadRandomdep +basedep +base-compatsetup-changed

Dependencies added: MonadRandom, base, base-compat, bytestring, exceptions, http-client, http-client-tls, http-types, monad-logger, monadcryptorandom, mtl, text, transformers, transformers-compat

Files

LICENSE +30/−0
README.md +8/−0
Setup.hs +2/−0
monad-http.cabal +50/−0
src/Control/Monad/Http.hs +32/−0
src/Control/Monad/Http/Class.hs +194/−0
src/Control/Monad/Trans/Http.hs +134/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2015 Futurice Oy++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 Oleg Grenrus nor the names of other+      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+OWNER 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.

+ README.md view

@@ -0,0 +1,8 @@+# haskell-monad-http++[![Build Status](https://travis-ci.org/futurice/haskell-monad-http.svg?branch=master)](https://travis-ci.org/futurice/haskell-monad-http)+[![Hackage](https://img.shields.io/hackage/v/monad-http.svg)](http://hackage.haskell.org/package/monad-http)+[![Stackage LTS 3](http://stackage.org/package/monad-http/badge/lts-3)](http://stackage.org/lts-3/package/monad-http)+[![Stackage Nightly](http://stackage.org/package/monad-http/badge/nightly)](http://stackage.org/nightly/package/monad-http)++A `MonadHTTP` class.

+ Setup.hs view

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

+ monad-http.cabal view

@@ -0,0 +1,50 @@+-- This file has been generated from package.yaml by hpack version 0.8.0.+--+-- see: https://github.com/sol/hpack++name:                monad-http+version:             0.1.0.0+synopsis:            A class of monads which can do http requests+description:         A class of monads which can do http requests+homepage:            https://github.com/futurice/haskell-monad-http#readme+bug-reports:         https://github.com/futurice/haskell-monad-http/issues+license:             BSD3+license-file:        LICENSE+author:              Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer:          Oleg Grenrus <oleg.grenrus@iki.fi>+category:            Web+tested-with:         GHC==7.8.4, GHC==7.10.2, GHC==7.10.3+build-type:          Simple+cabal-version:       >= 1.10++extra-source-files:+  README.md++source-repository head+  type: git+  location: https://github.com/futurice/haskell-monad-http++library+  hs-source-dirs:+    src+  ghc-options: -Wall+  build-depends:+    base                >=4.7      && <4.9,+    base-compat         >=0.6.0    && <0.9,+    bytestring          >=0.10.0.4 && <0.12,+    exceptions          >=0.8.0.2  && <0.9,+    http-client         >=0.4.18.1 && <0.5,+    http-client-tls     >=0.2.2    && <0.3,+    http-types          >=0.8.6    && <0.10,+    monad-logger        >=0.3.13.2 && <0.4,+    monadcryptorandom   >=0.6.1    && <0.8,+    MonadRandom         >=0.3.0.2  && <0.5,+    mtl                 >=2.1.3.1  && <2.3,+    text                >=1.2.0.6  && <1.3,+    transformers        >=0.3.0.0  && <0.6,+    transformers-compat >=0.4.0.3  && <0.5+  exposed-modules:+    Control.Monad.Http+    Control.Monad.Http.Class+    Control.Monad.Trans.Http+  default-language: Haskell2010

+ src/Control/Monad/Http.hs view

@@ -0,0 +1,32 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2015 Futurice Oy+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- 'MonadHttp' class with basic HTTP functionality.+----------------------------------------------------------------------------+module Control.Monad.Http (+    -- * Class+    MonadHttp(..),+    BodyReaderM,+    -- * Transformer+    HttpT(..),+    evalHttpT,+    -- * Utilities+    httpLbs,+    brConsume,+    -- * Re-exports+    Request(..),+    Response(..),+    ) where++import Control.Monad.Http.Class+import Control.Monad.Trans.Http+import Network.HTTP.Client      (Request (..), Response (..))

+ src/Control/Monad/Http/Class.hs view

@@ -0,0 +1,194 @@+{-# LANGUAGE CPP           #-}+{-# LANGUAGE GADTs         #-}+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2015 Futurice Oy+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+----------------------------------------------------------------------------+module Control.Monad.Http.Class (+    MonadHttp(..),+    BodyReaderM,+    httpLbs,+    brConsume,+) where++import Prelude        ()+import Prelude.Compat++import qualified Data.ByteString      as S+import qualified Data.ByteString.Lazy as L+import qualified Network.HTTP.Client  as H++import Control.Monad.Trans.Class (lift)++import Control.Monad.Trans.Except   (ExceptT (..), runExceptT)+import Control.Monad.Trans.Identity (IdentityT (..))+import Control.Monad.Trans.Maybe    (MaybeT (..))++import Control.Monad.Trans.Error  (Error, ErrorT (..))+import Control.Monad.Trans.Reader (ReaderT (..))+import Control.Monad.Trans.RWS    (RWST (..))+import Control.Monad.Trans.State  (StateT (..))+import Control.Monad.Trans.Writer (WriterT (..))++import qualified Control.Monad.Trans.RWS.Strict    as Strict (RWST (..))+import qualified Control.Monad.Trans.State.Strict  as Strict (StateT (..))+import qualified Control.Monad.Trans.Writer.Strict as Strict (WriterT (..))++import Control.Monad.CryptoRandom (CRandT (..))++import Control.Monad.Logger (LoggingT (..), NoLoggingT (..))+import Control.Monad.Random (RandT, liftRandT, runRandT)++#if !MIN_VERSION_MonadRandom(0, 4, 0)+import Control.Monad.Random (RandomGen)+#endif++import Control.Monad.Trans.Http (HttpT (..), liftHttpT)++type BodyReaderM m = m S.ByteString++------------------------------------------------------------------------------+-- MonadHttp+------------------------------------------------------------------------------++-- | The monad capable to do HTTP requests.+class+#if MIN_VERSION_base(4,8,0)+  Monad m+#else+  (Applicative m, Monad m)+#endif+  => MonadHttp m where+    withResponse :: H.Request -> (H.Response (BodyReaderM m) -> m a) -> m a++    -- ^ Get a single chunk of data from the response body, or an empty+    -- bytestring if no more data is available.+    --+    -- Note that in order to consume the entire request body, you will need to+    -- repeatedly call this function until you receive an empty @ByteString@ as+    -- a result.+    brRead :: BodyReaderM m -> m S.ByteString+    brRead = id++-- like in https://hackage.haskell.org/package/exceptions-0.8.0.2/docs/src/Control-Monad-Catch.html#instance%20MonadThrow%20(IdentityT%20m)+instance MonadHttp m => MonadHttp (IdentityT m) where+    withResponse req f = lift $ withResponse req (runIdentityT . f . fmap lift)++instance MonadHttp m => MonadHttp (ReaderT r m) where+    withResponse req f =+        ReaderT $ \r ->+            withResponse req $ \res ->+                runReaderT (f $ fmap lift res) r++instance MonadHttp m => MonadHttp (StateT r m) where+    withResponse req f =+        StateT $ \s ->+            withResponse req $ \res ->+                runStateT (f $ fmap lift res) s++instance MonadHttp m => MonadHttp (Strict.StateT r m) where+    withResponse req f =+        Strict.StateT $ \s ->+            withResponse req $ \res ->+                Strict.runStateT (f $ fmap lift res) s++instance (MonadHttp m, Monoid w) => MonadHttp (WriterT w m) where+    withResponse req f =+        WriterT $ withResponse req $ \res ->+            runWriterT (f $ fmap lift res)++instance (MonadHttp m, Monoid w) => MonadHttp (Strict.WriterT w m) where+    withResponse req f =+        Strict.WriterT $ withResponse req $ \res ->+            Strict.runWriterT (f $ fmap lift res)++instance (MonadHttp m, Monoid w) => MonadHttp (RWST r w s m) where+    withResponse req f =+        RWST $ \r s ->+            withResponse req $ \res ->+                runRWST (f $ fmap lift res) r s++instance (MonadHttp m, Monoid w) => MonadHttp (Strict.RWST r w s m) where+    withResponse req f =+        Strict.RWST $ \r s ->+            withResponse req $ \res ->+                Strict.runRWST (f $ fmap lift res) r s++instance MonadHttp m => MonadHttp (MaybeT m) where+    withResponse req f =+        MaybeT $ withResponse req $ \res ->+            runMaybeT (f $ fmap lift res)++instance MonadHttp m => MonadHttp (ExceptT e m) where+    withResponse req f =+        ExceptT $ withResponse req $ \res ->+            runExceptT (f $ fmap lift res)++instance (MonadHttp m, Error e) => MonadHttp (ErrorT e m) where+    withResponse req f =+        ErrorT $ withResponse req $ \res ->+            runErrorT (f $ fmap lift res)++instance+#if MIN_VERSION_MonadRandom(0, 4, 0)+  MonadHttp m+#else+  (MonadHttp m, RandomGen g)+#endif+  => MonadHttp (RandT g m) where+    withResponse req f =+        liftRandT $ \r ->+            withResponse req $ \res ->+                runRandT (f $ fmap lift res) r++#if MIN_VERSION_monadcryptorandom(0, 7, 0)+instance MonadHttp m => MonadHttp (CRandT g e m) where+    withResponse req f =+        CRandT $ withResponse req $ \res ->+            unCRandT (f $ fmap CRandT res)+#else+instance (MonadHttp m, Error e) => MonadHttp (CRandT g e m) where+    withResponse req f =+        CRandT $ withResponse req $ \res ->+            unCRandT (f $ fmap CRandT res)+#endif++instance MonadHttp m => MonadHttp (LoggingT m) where+    withResponse req f =+        LoggingT $ \r ->+            withResponse req $ \res ->+                runLoggingT (f $ fmap lift res) r++instance MonadHttp m => MonadHttp (NoLoggingT m) where+    withResponse req f = lift $ withResponse req (runNoLoggingT . f . fmap lift)++-- | A convenience wrapper around 'withResponse' which reads in the entire+-- response body and immediately releases resources.+httpLbs :: MonadHttp m => H.Request -> m (H.Response L.ByteString)+httpLbs req = withResponse req $ \res -> do+    bss <- brConsume $ H.responseBody res+    return res { H.responseBody = L.fromChunks bss }++-- | Strictly consume all remaining chunks of data from the stream.+brConsume :: MonadHttp m => BodyReaderM m -> m [S.ByteString]+brConsume brRead' =+    go id+  where+    go front = do+        x <- brRead'+        if S.null x+            then return $ front []+            else go (front . (x:))++------------------------------------------------------------------------------+-- HttpT+------------------------------------------------------------------------------++-- | /TODO:/ Generalise to MonadIO + MonadMask?+instance m ~ IO => MonadHttp (HttpT m) where+    withResponse req f = HttpT (\mgr -> H.withResponse req mgr (flip runHttpT mgr . f . fmap liftHttpT))

+ src/Control/Monad/Trans/Http.hs view

@@ -0,0 +1,134 @@+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances  #-}+----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2015 Futurice Oy+-- License     :  BSD-3-Clause+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+----------------------------------------------------------------------------+module Control.Monad.Trans.Http (+    HttpT(..),+    evalHttpT,+    mapHttpT,+    liftHttpT,+    ) where++import Prelude        ()+import Prelude.Compat++import qualified Network.HTTP.Client     as H+import qualified Network.HTTP.Client.TLS as H++import Control.Monad.Cont.Class   (MonadCont (..))+import Control.Monad.IO.Class     (MonadIO (..))+import Control.Monad.Reader.Class (MonadReader (..))+import Control.Monad.RWS.Class    (MonadRWS)+import Control.Monad.State.Class  (MonadState (..))+import Control.Monad.Trans.Class  (MonadTrans (..))+import Control.Monad.Writer.Class (MonadWriter (..))++#if MIN_VERSION_mtl(2,2,0)+import Control.Monad.Except (MonadError (..))+#else+import Control.Monad.Error (MonadError (..))+#endif++import Control.Monad.Catch  (MonadCatch (..), MonadMask (..), MonadThrow (..))+import Control.Monad.Logger (MonadLogger (..), MonadLoggerIO (..))++import Control.Monad.Random.Class (MonadRandom (..), MonadSplit (..))++import Control.Monad.CryptoRandom (MonadCRandom (..), MonadCRandomR (..))++-- | Http monad transformer, essentially 'ReaderT' 'H.Manager'.+newtype HttpT m a = HttpT { runHttpT :: H.Manager -> m a }++-- | Lower 'HttpT' with default 'H.Manager' created with 'H.tlsManagerSettings'.+evalHttpT :: MonadIO m => HttpT m a -> m a+evalHttpT m = liftIO (H.newManager H.tlsManagerSettings) >>= runHttpT m++instance Functor m => Functor (HttpT m) where+    fmap f = mapHttpT (fmap f)++instance Applicative m => Applicative (HttpT m) where+    pure    = liftHttpT . pure+    f <*> v = HttpT $ \r -> runHttpT f r <*> runHttpT v r++instance Monad m => Monad (HttpT m) where+    return = liftHttpT . return+    m >>= k  = HttpT $ \r -> do+        a <- runHttpT m r+        runHttpT (k a) r++instance MonadIO m => MonadIO (HttpT m) where+    liftIO = liftHttpT . liftIO++instance MonadThrow m => MonadThrow (HttpT m) where+    throwM = liftHttpT . throwM++instance MonadCatch m => MonadCatch (HttpT m) where+    catch m c = HttpT $ \r -> runHttpT m r `catch` \e -> runHttpT (c e) r++instance MonadMask m => MonadMask (HttpT m) where+    mask a = HttpT $ \r -> mask $ \u -> runHttpT (a $ mapHttpT u) r+    uninterruptibleMask a =+        HttpT $ \r -> uninterruptibleMask $ \u -> runHttpT (a $ mapHttpT u) r++instance MonadLogger m => MonadLogger (HttpT m) where+    monadLoggerLog a b c d = liftHttpT $ monadLoggerLog a b c d++instance MonadLoggerIO m => MonadLoggerIO (HttpT m) where+    askLoggerIO = liftHttpT askLoggerIO++instance MonadTrans HttpT where+    lift = liftHttpT++instance MonadReader r m => MonadReader r (HttpT m) where+  ask = lift ask+  local = mapHttpT . local++instance MonadState s m => MonadState s (HttpT m) where+    get = lift get+    put = lift . put++instance MonadCont m => MonadCont (HttpT m) where+    callCC f = HttpT $ \i -> callCC $ \c -> runHttpT (f (HttpT . const . c)) i++instance MonadError e m => MonadError e (HttpT m) where+    throwError = lift . throwError+    catchError r h =+        HttpT $ \i -> runHttpT r i `catchError` \e -> runHttpT (h e) i++instance MonadWriter w m => MonadWriter w (HttpT m) where+    tell   = lift . tell+    listen = mapHttpT listen+    pass   = mapHttpT pass++instance MonadRWS r w s m => MonadRWS r w s (HttpT m)++instance MonadRandom m => MonadRandom (HttpT m) where+    getRandom = lift getRandom+    getRandoms = lift getRandoms+    getRandomR = lift . getRandomR+    getRandomRs = lift . getRandomRs++instance MonadSplit g m => MonadSplit g (HttpT m) where+    getSplit = lift getSplit++instance MonadCRandom e m => MonadCRandom e (HttpT m) where+    getCRandom = lift getCRandom+    getBytes = lift . getBytes+    getBytesWithEntropy = \i -> lift . getBytesWithEntropy i+    doReseed = lift . doReseed++instance MonadCRandomR e m => MonadCRandomR e (HttpT m) where+    getCRandomR = lift . getCRandomR++mapHttpT :: (m a -> m b) -> HttpT m a -> HttpT m b+mapHttpT f m = HttpT $ f . runHttpT m++liftHttpT :: m a -> HttpT m a+liftHttpT = HttpT . const