git.iko.soy/servant
on bab2bc7 help sign in
servant/src/Servant/Client.hs
65 lines 1.9 kB history raw
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Servant.Client where
5import Control.Concurrent
6import Control.Monad.Catch
7import Data.ByteString.Lazy
8import Data.Proxy
9import Data.Text
10import Network.HTTP.Client hiding (Proxy)
11import Network.HTTP.Types
12import Network.URI
13import System.IO.Unsafe
15-- * Accessing APIs as a Client
17-- | 'client' allows you to produce operations to query an API from a client.
18client :: HasClient layout => Proxy layout -> Client layout
19client p = clientWithRoute p defReq
21class HasClient layout where
22 type Client layout :: *
23 clientWithRoute :: Proxy layout -> Req -> Client layout
25data Req = Req
26 { reqPath :: String
27 , qs :: QueryText
28 , reqBody :: ByteString
29 }
31defReq :: Req
32defReq = Req "" [] ""
34appendToPath :: String -> Req -> Req
35appendToPath p req =
36 req { reqPath = reqPath req ++ "/" ++ p }
38appendToQueryString :: Text -- ^ param name
39 -> Maybe Text -- ^ param value
40 -> Req
41 -> Req
42appendToQueryString pname pvalue req =
43 req { qs = qs req ++ [(pname, pvalue)]
44 }
46setRQBody :: ByteString -> Req -> Req
47setRQBody b req = req { reqBody = b }
49reqToRequest :: (Functor m, MonadThrow m) => Req -> URI -> m Request
50reqToRequest req uri = fmap (setrqb . setQS ) $ parseUrl url
52 where url = show $ nullURI { uriPath = reqPath req }
53 `relativeTo` uri
55 setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }
56 setQS = setQueryString $ queryTextToQuery (qs req)
58{-# NOINLINE __manager #-}
59__manager :: MVar Manager
60__manager = unsafePerformIO (newManager defaultManagerSettings >>= newMVar)
62__withGlobalManager :: (Manager -> IO a) -> IO a
63__withGlobalManager action = modifyMVar __manager $ \ manager -> do
64 result <- action manager
65 return (manager, result)