free-http (empty) → 0.1.0.1
raw patch · 10 files changed
+622/−0 lines, 10 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, free, http-client, http-types, mtl, text, time, transformers
Files
- LICENSE +20/−0
- README.md +72/−0
- Setup.hs +2/−0
- free-http.cabal +94/−0
- src/Network/HTTP/Client/Free/ArbitraryClient.hs +71/−0
- src/Network/HTTP/Client/Free/Examples.hs +183/−0
- src/Network/HTTP/Client/Free/HttpClient.hs +71/−0
- src/Network/HTTP/Client/Free/PureClient.hs +61/−0
- src/Network/HTTP/Client/Free/Types.hs +33/−0
- src/Network/HTTP/Client/Free/Util.hs +15/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 aaron levin++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.
+ README.md view
@@ -0,0 +1,72 @@+Free Your Client... and Your Requests Will Follow+=================================================++`free-http` is an http-client based on Free Monads. `free-http` exposes a Free Monad to express standard http verbs as well as several backends to interpet programs written in the free monad using various http clients (currently: a pure client, an `http-client`-backed client, and a random client).++See [here](https://github.com/aaronlevin/free-http/blob/master/src/Network/HTTP/Client/Free/Examples.hs#L152) for an example.++To use free-http, simply:++1. Import Network.HTTP.Client.Free to use the library.+2. Choose your base request type by defining your own instance of the `RequestType` type family or importing one from an interpreter. E.g.++ ```+ data MyClient+ type instance RequestType MyClient = Request+ ```++ or++ ```+ import Network.HTTP.Free.Client.HttpClient (HttpClient)+ ```++3. Choose your base response type by defining your own instance of the `ResponseTYpe` type family or importing one from an interpreter. E.g. ++ ```+ type instance ResponseType MyClient = Response ByteString+ ```++ or++ ```+ import Network.HTTP.Free.Client.HttpClient (HttpClient)+ ```++4. Write a program in the 'FreeHttp MyClient m a' free monad.+5. Import an interpreter, such as 'HttpClient'++ ```+ import Network.HTTP.Free.Client.HttpClient+ ```++6. Run your program against the interpreter:++ ```+ runHttp (myProgram :: FreeHttp MyClient IO String)+ ```++## Design Choices++### `RequestType` and `ResponseType`++Haskell is fortunate to have several very well-designed http clients: [http-client](https://hackage.haskell.org/package/http-client-0.4.16/docs/Network-HTTP-Client.html), [wreq](http://www.serpentine.com/wreq/), [http-conduit](https://hackage.haskell.org/package/http-conduit), [pipes-http](https://hackage.haskell.org/package/pipes-http), etc. Unfortunately, a few of those clients support several different *Request* and *Response* types. To keep `free-http` flexible, we use two type families defined as:++```+type family RequestType client :: *+type family ResponseType client :: *+```++Our `HttpF` functor is thus defined as:++```+data HttpF client a = HttpF StdMethod (RequestType client) (ResponseType client -> a)+ deriving Functor+```++This allows our `HttpF` functor to be agnostic of the foundational request and response type, while allowing interpreter authors to specify the concrete types they need for their http client libraries (e.g. `Request` in the case of `http-client`). A consequence of this is that `free-http` clients (you) need to specify, at some point, the foundation you're using. This can be done in two ways:++1. You can define your own foundation (see above).+2. You can import one from an interpreter.++To specify your request and response foundation, use replace the `client` type in `HttpF client a` or `FreeHttp client m a` to the type signalling your foundation. For example, the http-client, pure, and arbitrary interpreters use `HttpClient`, `PureClient`, and `ArbitraryClient` respectively.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ free-http.cabal view
@@ -0,0 +1,94 @@+name: free-http++version: 0.1.0.1++synopsis: An HTTP Client based on Free Monads.++description: `free-http` is an http-client based on Free Monads.+ `free-http` exposes a Free Monad to express standard http+ verbs as well as several backends to interpet programs+ written in the free monad using various http clients+ (currently: a pure client, an `http-client`-backed client,+ and a random client).++ To use free-http, simply:++ 1. Import Network.HTTP.Client.Free to use the library.+ 2. Choose your base request type by defining your own+ instance of the `RequestType` type family or importing+ one from an interpreter. E.g.++ data MyClient+ type instance RequestType MyClient = Request++ (or)++ import Network.HTTP.Free.Client.HttpClient (HttpClient)++ 3. Choose your base response type by defining your own+ instance of the `ResponseTYpe` type family or importing+ one from an interpreter. E.g. ++ type instance ResponseType MyClient = Response ByteString++ (or)++ import Network.HTTP.Free.Client.HttpClient (HttpClient)++ 4. Write a program in the 'FreeHttp MyClient m a' free monad.+ 5. Import an interpreter, such as 'HttpClient'++ import Network.HTTP.Free.Client.HttpClient++ 6. Run your program against the interpreter:++ runHttp (myProgram :: FreeHttp MyClient IO String)++homepage: https://github.com/aaronlevin/free-http++license: MIT++license-file: LICENSE++author: Aaron Levin++maintainer: vilevin@gmail.com++category: Network++build-type: Simple++extra-source-files: README.md+ , LICENSE++cabal-version: >=1.10++source-repository head+ type: git+ location: git://github.com/aaronlevin/free-http.git++library+ exposed-modules: Network.HTTP.Client.Free.ArbitraryClient+ Network.HTTP.Client.Free.HttpClient+ Network.HTTP.Client.Free.PureClient+ Network.HTTP.Client.Free.Types+ Network.HTTP.Client.Free.Util++ other-modules: Network.HTTP.Client.Free.Examples++ -- other-extensions: ++ build-depends: base > 4.6 && < 4.9+ , bytestring >= 0.10.0.0+ , free >= 4.0+ , http-client >= 0.4.0+ , http-types >= 0.8.0+ , mtl >= 2.0.0.0+ , QuickCheck >= 2.7+ , text >= 1.0.0.0+ , time >= 1.4.0.1+ , transformers >= 0.4.0.0++ hs-source-dirs: src++ default-language: Haskell2010
+ src/Network/HTTP/Client/Free/ArbitraryClient.hs view
@@ -0,0 +1,71 @@+{-| An interpreter that fails randomly+-}++{-# LANGUAGE TypeFamilies #-}++module Network.HTTP.Client.Free.ArbitraryClient where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans (MonadTrans, lift)+import Control.Monad.Trans.Free.Church (FT, iterT, iterTM, liftF)+import Control.Applicative ((<$>))+import Network.HTTP.Client.Free.Types (HttpF(HttpF), ResponseType)+import Test.QuickCheck (Arbitrary, arbitrary, sample')++-------------------------------------------------------------------------------+-- | Peel a layer of the 'HttpF' functor and generate a random Response.+iterTHttp :: ( r ~ ResponseType client+ , Arbitrary r+ , Monad m+ , MonadIO m+ )+ => HttpF client (m a)+ -> m a+iterTHttp (HttpF _ _ next) = head <$> liftIO (sample' arbitrary) >>= next++-------------------------------------------------------------------------------+-- | Peel a layer of the 'HttpF' functor and generate a random Response. This +-- time the base monad is 't m'.+iterTMHttp :: ( r ~ ResponseType client+ , Arbitrary r+ , Monad m+ , MonadIO m+ , MonadTrans t+ , Monad (t m)+ )+ => HttpF client (t m a)+ -> t m a+iterTMHttp (HttpF _ _ next) = head <$> (lift . liftIO) (sample' arbitrary) >>= next++-------------------------------------------------------------------------------+-- | The main http-client interpreter. The client is free to specify the base+-- effect monad so long as there is an instance of 'MonadIO' for it in scope.+runHttp :: ( r ~ ResponseType client+ , Arbitrary r+ , Monad m+ , MonadIO m+ )+ => ignore+ -- ^ a paramter that will be ignored. It is included so client's can+ -- hot-swap interpreters.+ -> FT (HttpF client) m a+ -> m a+runHttp = const (iterT iterTHttp)++-------------------------------------------------------------------------------+-- | The main http-client interpreter. The client is free to specify the base+-- effect monad ('m'), and in thise case this the result can be lifted into a+-- higher monad transformer stack ('t')+runTHttp :: ( r ~ ResponseType client+ , Arbitrary r+ , Monad m+ , MonadIO m+ , MonadTrans t+ , Monad (t m)+ )+ => ignore+ -- ^ a paramter that will be ignored. It is included so client's can+ -- hot-swap interpreters.+ -> FT (HttpF client) m a+ -> t m a+runTHttp = const (iterTM iterTMHttp)
+ src/Network/HTTP/Client/Free/Examples.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++module Network.HTTP.Client.Free.Examples (+) where++import Control.Applicative ((<$>), (<*>))+import Data.ByteString (ByteString)+import Data.ByteString.Char8 (pack)+import Data.Maybe (fromJust)+import Data.Time (UTCTime(UTCTime), fromGregorian)+import Network.HTTP.Types.Header+import Network.HTTP.Types.Status+import Network.HTTP.Types.Method (StdMethod (..))+import Network.HTTP.Types.Version (http09, http10, http11, HttpVersion)+import Network.HTTP.Client (defaultManagerSettings, newManager, parseUrl, responseStatus, Request)+import Network.HTTP.Client.Free (get)+import qualified Network.HTTP.Client.Free.ArbitraryClient as ArbitraryClient+import Network.HTTP.Client.Free.HttpClient (HttpClient)+import qualified Network.HTTP.Client.Free.HttpClient as HttpClient+import Network.HTTP.Client.Free.Types (FreeHttp, RequestType, ResponseType)+import Network.HTTP.Client.Internal (Cookie(Cookie), CookieJar, createCookieJar, Response(Response), ResponseClose(ResponseClose))+import Test.QuickCheck (choose, Gen, Arbitrary(arbitrary), elements, listOf, sample', suchThat)++-- | an arbitrary 'Status'+arbStatus :: Gen Status+arbStatus = elements [ status100+ , status101+ , status200+ , status201+ , status203+ , status204+ , status205+ , status206+ , status300+ , status301+ , status302+ , status303+ , status304+ , status305+ , status307+ , status400+ , status401+ , status402+ , status403+ , status404+ , status405+ , status406+ , status407+ , status408+ , status409+ , status410+ , status411+ , status412+ , status413+ , status414+ , status415+ , status416+ , status417+ , status418+ , status428+ , status429+ , status431+ , status500+ , status501+ , status502+ , status503+ , status504+ , status505+ , status511+ ]++-- | an arbitrary 'HttpVersion'+arbHttpVersion :: Gen HttpVersion+arbHttpVersion = elements [ http09+ , http10+ , http11+ ]++-- | an arbitrary 'HeaderName'+arbHeaderName :: Gen HeaderName+arbHeaderName = elements [ hAccept+ , hAcceptLanguage+ , hAuthorization+ , hCacheControl+ , hConnection+ , hContentEncoding+ , hContentLength+ , hContentMD5+ , hContentType+ , hCookie+ , hDate+ , hIfModifiedSince+ , hIfRange+ , hLastModified+ , hLocation+ , hRange+ , hReferer+ , hServer+ , hUserAgent+ ]++-- | an arbitrary Header. This is not performant, but you shouldn't+-- be using this client in production anyway.+arbHeader :: Gen Header+arbHeader = (,) <$> arbHeaderName <*> fmap pack arbitrary++-- | an arbitrary UTCTime+arbUtcTime :: Gen UTCTime+arbUtcTime = do+ rDay <- choose (1,29) :: Gen Int+ rMonth <- choose (1,12) :: Gen Int+ rYear <- choose (1970, 2015) :: Gen Integer+ rTime <- choose (0,86401) :: Gen Int+ return $ UTCTime (fromGregorian rYear rMonth rDay) (fromIntegral rTime)++-- | an arbtirary Cookie+arbCookie :: Gen Cookie+arbCookie = do+ cCreationTime <- arbUtcTime+ cLastAccessTime <- suchThat arbUtcTime (cCreationTime >=)+ cExpiryTime <- suchThat arbUtcTime (cLastAccessTime >=)+ cName <- fmap pack arbitrary+ cValue <- fmap pack arbitrary+ cDomain <- fmap pack arbitrary+ cPath <- fmap pack arbitrary+ cPersistent <- arbitrary+ cHostOnly <- arbitrary+ cSecureOnly <- arbitrary+ cHttpOnly <- arbitrary+ return $ Cookie cName+ cValue+ cExpiryTime+ cDomain+ cPath+ cCreationTime+ cLastAccessTime+ cPersistent+ cHostOnly+ cSecureOnly+ cHttpOnly++-- | unexported instance for arbitrary responses+instance Arbitrary (Response ByteString) where+ arbitrary = Response <$> arbStatus+ <*> arbHttpVersion+ <*> listOf arbHeader+ <*> (pack <$> arbitrary)+ <*> (createCookieJar <$> listOf arbCookie)+ <*> return (ResponseClose (return ()))++-- | A sample request+weirdReq :: Request+weirdReq = fromJust (parseUrl "http://weirdcanada.com/api")++-- | A program that checks to see if the weird canada api is up.+checkWeird :: ( Request ~ RequestType client+ , Response b ~ ResponseType client+ , Monad m+ )+ => FreeHttp client m Bool+checkWeird = do+ resp <- get weirdReq+ (return . (== status200) . responseStatus) resp++data ExampleClient+type instance RequestType ExampleClient = Request+type instance ResponseType ExampleClient = Response ByteString++main :: IO ()+main = do+ -- a result using the arbitrary interpreter+ arbResult <- ArbitraryClient.runHttp () (checkWeird :: FreeHttp ExampleClient IO Bool)+ putStrLn ("Arbitrary client returned: " ++ show arbResult)++ -- a result using the actual http client+ mgr <- newManager defaultManagerSettings+ realResult <- HttpClient.runHttp mgr (checkWeird :: FreeHttp HttpClient IO Bool)++ putStrLn ("http-client returned: " ++ show realResult)+++
+ src/Network/HTTP/Client/Free/HttpClient.hs view
@@ -0,0 +1,71 @@+{-| An Interpreter with http-client as the foundation+-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE TypeFamilies #-}++module Network.HTTP.Client.Free.HttpClient (+ HttpClient+ , runHttp+ , runTHttp+) where++import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans (MonadTrans, lift)+import Control.Monad.Trans.Free.Church (FT, iterT, iterTM, liftF)+import Data.ByteString.Lazy (ByteString)+import Network.HTTP.Client (Manager, Request, Response,+ httpLbs)+import Network.HTTP.Client.Free.Types (HttpF (HttpF), RequestType,+ ResponseType)+import Network.HTTP.Client.Free.Util (setMethod)+import Network.HTTP.Types.Method (renderStdMethod)++-------------------------------------------------------------------------------+-- | 'HttpClient' is an uninhabited type used to identify the http-client+-- based interpreter+data HttpClient++-------------------------------------------------------------------------------+-- | HttpClient expects 'Request's and returns 'Response ByteString's+type instance RequestType HttpClient = Request+type instance ResponseType HttpClient = Response ByteString++-------------------------------------------------------------------------------+-- | Peel a layer of the 'HttpF' functor and run an http request with the data+-- provided.+iterTHttp :: (Monad m, MonadIO m)+ => Manager+ -> HttpF HttpClient (m a)+ -> m a+iterTHttp manager (HttpF m r next) =+ let !req = setMethod m r in liftIO (httpLbs req manager) >>= next++-------------------------------------------------------------------------------+-- | Peel a layer of the 'HttpF' functor and run an http request with the data.+-- the base monad for this action is 't m'.+iterTMHttp :: (Monad m, MonadTrans t, Monad (t m), MonadIO m)+ => Manager+ -> HttpF HttpClient (t m a)+ -> t m a+iterTMHttp manager (HttpF m r next) =+ let !req = setMethod m r in (lift . liftIO $ httpLbs req manager) >>= next++-------------------------------------------------------------------------------+-- | The main http-client interpreter. The client is free to specify the base+-- effect monad so long as there is an instance of 'MonadIO' for it in scope.+runHttp :: (Monad m, MonadIO m)+ => Manager+ -> FT (HttpF HttpClient) m a+ -> m a+runHttp manager = iterT (iterTHttp manager)++-------------------------------------------------------------------------------+-- | The main http-client interpreter. The client is free to specify the base+-- effect monad ('m'), and in thise case this the result can be lifted into a+-- higher monad transformer stack ('t')+runTHttp :: (Monad m, MonadIO m, MonadTrans t, Monad (t m))+ => Manager+ -> FT (HttpF HttpClient) m a+ -> t m a+runTHttp manager = iterTM (iterTMHttp manager)
+ src/Network/HTTP/Client/Free/PureClient.hs view
@@ -0,0 +1,61 @@+{-| A pure interepreter+-}++{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}++module Network.HTTP.Client.Free.PureClient (+ runHttp+ , runTHttp+) where++import Control.Monad.Trans (MonadTrans)+import Control.Monad.Trans.Free.Church (FT, iterT, iterTM, liftF)+import Network.HTTP.Client (Manager, Request, Response,+ httpLbs)+import Network.HTTP.Client.Free.Types (HttpF (HttpF), RequestType,+ ResponseType)++-------------------------------------------------------------------------------+-- | Peel a layer of the 'HttpF' functor and, given the pure, mock function+-- that maps requests to responses, run the next method against the returned+-- request.+iterTHttp :: (Monad m)+ => (RequestType client -> ResponseType client)+ -- ^ a function to mock requests+ -> HttpF client (m a)+ -> m a+iterTHttp mock (HttpF _ req next) = next (mock req)++-------------------------------------------------------------------------------+-- | Peel a layer of the 'HttpF' functor and, given the pure, mock function+-- that maps requests to responses, run the next method against the returned+-- request. the base monad for this action is `t m a`+iterTMHttp :: (Monad m, MonadTrans t, Monad (t m))+ => (RequestType client -> ResponseType client)+ -> HttpF client (t m a)+ -> t m a+iterTMHttp mock (HttpF _ req next) = next (mock req)++-------------------------------------------------------------------------------+-- | A pure interpreter based on a client-supplied mocking function+runHttp :: Monad m+ => ignore+ -- ^ a parameter that will be ignored. It is included so client's can+ -- hot-swap interpreters (many will require a `Manager` type)+ -> (RequestType client -> ResponseType client)+ -> FT (HttpF client) m a+ -> m a+runHttp _ mock = iterT (iterTHttp mock)++-------------------------------------------------------------------------------+-- | A pure interpreter based on a client-supplied mocking function. The under-+-- lying monad is `t m`, so computations will be lifted into `t m`.+runTHttp :: (Monad m, MonadTrans t, Monad (t m))+ => ignore+ -- ^ a paramter that will be ignored. It is included so client's can+ -- host-swap interpreters (many will require a 'Manager' type)+ -> (RequestType client -> ResponseType client)+ -> FT (HttpF client) m a+ -> t m a+runTHttp _ mock = iterTM (iterTMHttp mock)
+ src/Network/HTTP/Client/Free/Types.hs view
@@ -0,0 +1,33 @@+{-| The primary Free Monad wrapping HTTP actions.+-}++{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}++module Network.HTTP.Client.Free.Types (+ -- * Type Familes+ RequestType+ , ResponseType++ -- * The base functor of our library+ , HttpF(HttpF)++ -- * Type aliases+ , FreeHttp+) where++import Control.Monad.Trans.Free.Church (FT)+import Network.HTTP.Types.Method (StdMethod)++-- | type family to represent the request type foundation+type family RequestType client :: *++-- | type family to represent the response type foundation+type family ResponseType client :: *++-- | Our functor from which the free-http free monad is generated from.+data HttpF client a = HttpF StdMethod (RequestType client) (ResponseType client -> a)+ deriving Functor++-- | a type alias for the free monad generated by 'HttpF'+type FreeHttp client m a = FT (HttpF client) m a
+ src/Network/HTTP/Client/Free/Util.hs view
@@ -0,0 +1,15 @@+{-| Utilities for working with networking types+-}++{-# LANGUAGE BangPatterns #-}++module Network.HTTP.Client.Free.Util (+ setMethod+) where++import Network.HTTP.Client (Request (method))+import Network.HTTP.Types.Method (StdMethod, renderStdMethod)++-- | set the method of a request, overriding the previous method.+setMethod :: StdMethod -> Request -> Request+setMethod m req = let !nMethod = renderStdMethod m in req { method = nMethod }