@@ -2,17 +2,9 @@
22{-# LANGUAGE OverloadedStrings #-}
33module Servant.Client where
44
5−import Control.Concurrent
6−import Control.Monad.Catch
7−import Data.ByteString.Lazy
85import Data.Proxy
9−import Data.Text
10−import Network.HTTP.Client hiding (Proxy)
11−import Network.HTTP.Types
12−import Network.URI
13−import System.IO.Unsafe
146
15−import Servant.Utils.BaseUrl
7+import Servant.Utils.Req
168
179-- * Accessing APIs as a Client
1810
@@ -23,53 +15,3 @@ client p = clientWithRoute p defReq
2315class HasClient layout where
2416 type Client layout :: *
2517 clientWithRoute :: Proxy layout -> Req -> Client layout
26−
27−data Req = Req
28− { reqPath :: String
29− , qs :: QueryText
30− , reqBody :: ByteString
31− }
32−
33−defReq :: Req
34−defReq = Req "" [] ""
35−
36−appendToPath :: String -> Req -> Req
37−appendToPath p req =
38− req { reqPath = reqPath req ++ "/" ++ p }
39−
40−appendToQueryString :: Text -- ^ param name
41− -> Maybe Text -- ^ param value
42− -> Req
43− -> Req
44−appendToQueryString pname pvalue req =
45− req { qs = qs req ++ [(pname, pvalue)]
46− }
47−
48−setRQBody :: ByteString -> Req -> Req
49−setRQBody b req = req { reqBody = b }
50−
51−reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
52−reqToRequest req (BaseUrl scheme host port) = fmap (setrqb . setQS ) $ parseUrl url
53−
54− where url = show $ nullURI { uriScheme = case scheme of
55− Http -> "http:"
56− Https -> "https:"
57− , uriAuthority = Just $
58− URIAuth { uriUserInfo = ""
59− , uriRegName = host
60− , uriPort = ":" ++ show port
61− }
62− , uriPath = reqPath req
63− }
64−
65− setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }
66− setQS = setQueryString $ queryTextToQuery (qs req)
67−
68−{-# NOINLINE __manager #-}
69−__manager :: MVar Manager
70−__manager = unsafePerformIO (newManager defaultManagerSettings >>= newMVar)
71−
72−__withGlobalManager :: (Manager -> IO a) -> IO a
73−__withGlobalManager action = modifyMVar __manager $ \ manager -> do
74− result <- action manager
75− return (manager, result)