git.iko.soy/servant
on c08ca32 help sign in
servant/src/Servant/API/Get.hs
45 lines 1.7 kB history raw
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Servant.API.Get where
5import Control.Monad
6import Control.Monad.IO.Class
7import Control.Monad.Trans.Either
8import Data.Aeson
9import Data.Proxy
10import Data.String.Conversions
11import Network.HTTP.Types
12import Network.URI
13import Network.Wai
14import Servant.Client
15import Servant.Server
17import qualified Network.HTTP.Client as Client
19-- | Endpoint for simple GET requests. The server doesn't receive any arguments
20-- and serves the contained type as JSON.
21data Get a
23instance ToJSON result => HasServer (Get result) where
24 type Server (Get result) = EitherT (Int, String) IO result
25 route Proxy action _globalPathInfo request respond
26 | null (pathInfo request) && requestMethod request == methodGet = do
27 e <- runEitherT action
28 respond $ Just $ case e of
29 Right output ->
30 responseLBS ok200 [("Content-Type", "application/json")] (encode output)
31 Left (status, message) ->
32 responseLBS (mkStatus status (cs message)) [] (cs message)
33 | otherwise = respond Nothing
35instance FromJSON result => HasClient (Get result) where
36 type Client (Get result) = URI -> EitherT String IO result
37 clientWithRoute Proxy req uri = do
38 innerRequest <- liftIO $ reqToRequest req uri
40 innerResponse <- liftIO $ __withGlobalManager $ \ manager ->
41 Client.httpLbs innerRequest manager
42 when (Client.responseStatus innerResponse /= ok200) $
43 left ("HTTP GET request failed with status: " ++ show (Client.responseStatus innerResponse))
44 maybe (left "HTTP GET request returned invalid json") return $
45 decode' (Client.responseBody innerResponse)