dormouse-client: Simple, type-safe and testable HTTP client

This is a package candidate release! Here you can preview how this package release will appear once published to the main package index (which can be accomplished via the 'maintain' link below). Please note that once a package has been published to the main package index it cannot be undone! Please consult the package uploading documentation for more information.

[maintain] [Publish]

An HTTP client designed to be productive, easy to use, easy to test, flexible and safe!

It was designed with the following objectives in mind:

Please see https://dormouse.io for full documentation.


[Skip to Readme]

Properties

Versions 0.1.0.0, 0.1.0.0, 0.1.0.1, 0.2.0.0, 0.2.1.0
Change log ChangeLog.md
Dependencies aeson (>=1.4.2 && <2.0.0), attoparsec (>=0.13.2.4 && <0.14), base (>=4.7 && <5), bytestring (>=0.10.8 && <0.11.0), case-insensitive (>=1.2.1.0 && <2.0.0), containers (>=0.6.2.1 && <0.7), dormouse-uri, http-api-data (>=0.4.1.1 && <0.5), http-client (>=0.6.4.1 && <0.7.0), http-client-tls (>=0.3.5.3 && <0.4), http-types (>=0.12.3 && <0.13), mtl (>=2.2.2 && <3), safe-exceptions (>=0.1.7 && <0.2.0), streamly (>=0.7.2 && <0.8), streamly-bytestring (>=0.1.2 && <0.2), template-haskell (>=2.15.0 && <3.0.0), text (>=1.2.3 && <2.0.0) [details]
License BSD-3-Clause
Copyright 2020-2021 Phil Curzon
Author Phil Curzon
Maintainer phil@novelfs.org
Category Web
Home page https://dormouse.io/client.html
Bug tracker https://github.com/theinnerlight/dormouse/issues
Source repo head: git clone https://github.com/theinnerlight/dormouse
Uploaded by philcurzon at 2021-02-06T03:11:08Z

Modules

Downloads

Maintainer's Corner

Package maintainers

For package maintainers and hackage trustees


Readme for dormouse-client-0.1.0.0

[back to package description]

Dormouse-Client

Dormouse is an HTTP client that will help you REST.

It was designed with the following objectives in mind:

Example use:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

import Control.Monad.IO.Class
import Data.Aeson.TH 
import Dormouse.Client
import GHC.Generics (Generic)
import Dormouse.Url.QQ

data UserDetails = UserDetails 
  { name :: String
  , nickname :: String
  , email :: String
  } deriving (Eq, Show, Generic)

deriveJSON defaultOptions ''UserDetails

data EchoedJson a = EchoedJson 
  { echoedjson :: a
  } deriving (Eq, Show, Generic)

deriveJSON defaultOptions {fieldLabelModifier = drop 6} ''EchoedJson

main :: IO ()
main = do
  manager <- newManager tlsManagerSettings
  runDormouseClient (DormouseClientConfig { clientManager = manager }) $ do
    let 
      userDetails = UserDetails 
        { name = "James T. Kirk"
        , nickname = "Jim"
        , email = "james.t.kirk@starfleet.com"
        }
      req = accept json $ supplyBody json userDetails $ post [https|https://postman-echo.com/post|]
    response :: HttpResponse (EchoedJson UserDetails) <- expect req
    liftIO $ print response
    return ()

Building requests

GET requests

Building a GET request is simple using a Url (Please see the Dormouse-Uri documentation for more details of how to safely create and construct Urls).

postmanEchoGetUrl :: Url "http"
postmanEchoGetUrl = [http|http://postman-echo.com/get?foo1=bar1&foo2=bar2/|]

postmanEchoGetReq :: HttpRequest (Url "http") "GET" Empty EmptyPayload acceptTag
postmanEchoGetReq = get postmanEchoGetUrl

It is often useful to tell Dormouse about the expected Content-Type of the response in advance so that the correct Accept headers can be sent:

postmanEchoGetReq' :: HttpRequest (Url "http") "GET" Empty EmptyPayload acceptTag
postmanEchoGetReq' = accept json $ get postmanEchoGetUrl

POST requests

You can build POST requests in the same way

postmanEchoPostUrl :: Url "https"
postmanEchoPostUrl = [https|https://postman-echo.com/post|]

postmanEchoPostReq :: HttpRequest (Url "https") "POST" Empty EmptyPayload JsonPayload
postmanEchoPostReq = accept json $ post postmanEchoPostUrl

Expecting a response

Since we're expecting json, we also need data types and FromJSON instances to interpret the response with. Let's start with an example to handle the GET request.

{-# LANGUAGE DeriveGeneric #-}
data Args = Args 
  { foo1 :: String
  , foo2 :: String
  } deriving (Eq, Show, Generic)

data PostmanEchoResponse = PostmanEchoResponse
  { args :: Args
  } deriving (Eq, Show, Generic)

Once the request has been built, you can send it and expect a response of a particular type in any MonadDormouseClient m.

sendPostmanEchoGetReq :: MonadDormouseClient m => m PostmanEchoResponse
sendPostmanEchoGetReq = do
  (resp :: HttpResponse PostmanEchoResponse) <- expect postmanEchoGetReq'
  return $ responseBody resp

Running Dormouse

Dormouse is not opinionated about how you run it.

You can use a concrete type.

main :: IO ()
main = do
  manager <- newManager tlsManagerSettings
  postmanResponse <- runDormouseClient (DormouseClientConfig { clientManager = manager }) sendPostmanEchoGetReq
  print postmanResponse

You can integrate the DormouseClientT Monad Transformer into your transformer stack.

main :: IO ()
main = do
  manager <- newManager tlsManagerSettings
  postmanResponse <- runDormouseClientT (DormouseClientConfig { clientManager = manager }) sendPostmanEchoGetReq
  print postmanResponse

You can also integrate into your own Application monad using the sendHttp function from Dormouse.Client.MonadIOImpl and by providing an instance of HasDormouseConfig for your application environment.

data MyEnv = MyEnv 
  { dormouseEnv :: DormouseClientConfig
  }

instance HasDormouseClientConfigMyEnv where
  getDormouseClientConfig = dormouseEnv

newtype AppM a = AppM
  { unAppM :: ReaderT Env IO a 
  } deriving (Functor, Applicative, Monad, MonadReader Env, MonadIO, MonadThrow)

instance MonadDormouseClient (AppM) where
  send = IOImpl.sendHttp

runAppM :: Env -> AppM a -> IO a
runAppM deps app = flip runReaderT deps $ unAppM app