git.iko.soy/servant
on 10fa62e help sign in
servant/src/Servant/Client.hs
71 lines 2.1 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-- | Convenience function for creating 'URIAuth's.
18mkHost :: String -> Int -> URIAuth
19mkHost hostName port = URIAuth "" hostName (":" ++ show port)
21-- | 'client' allows you to produce operations to query an API from a client.
22client :: HasClient layout => Proxy layout -> Client layout
23client p = clientWithRoute p defReq
25class HasClient layout where
26 type Client layout :: *
27 clientWithRoute :: Proxy layout -> Req -> Client layout
29data Req = Req
30 { reqPath :: String
31 , qs :: QueryText
32 , reqBody :: ByteString
33 }
35defReq :: Req
36defReq = Req "" [] ""
38appendToPath :: String -> Req -> Req
39appendToPath p req =
40 req { reqPath = reqPath req ++ "/" ++ p }
42appendToQueryString :: Text -- ^ param name
43 -> Maybe Text -- ^ param value
44 -> Req
45 -> Req
46appendToQueryString pname pvalue req =
47 req { qs = qs req ++ [(pname, pvalue)]
48 }
50setRQBody :: ByteString -> Req -> Req
51setRQBody b req = req { reqBody = b }
53reqToRequest :: (Functor m, MonadThrow m) => Req -> URIAuth -> m Request
54reqToRequest req host = fmap (setrqb . setQS ) $ parseUrl url
56 where url = show $ nullURI { uriScheme = "http:"
57 , uriAuthority = Just host
58 , uriPath = reqPath req
59 }
61 setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }
62 setQS = setQueryString $ queryTextToQuery (qs req)
64{-# NOINLINE __manager #-}
65__manager :: MVar Manager
66__manager = unsafePerformIO (newManager defaultManagerSettings >>= newMVar)
68__withGlobalManager :: (Manager -> IO a) -> IO a
69__withGlobalManager action = modifyMVar __manager $ \ manager -> do
70 result <- action manager
71 return (manager, result)