2014-10-25 01:27:39 +02:00
|
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2014-10-28 09:04:27 +01:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2014-10-30 14:54:00 +01:00
|
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
2014-10-25 01:27:39 +02:00
|
|
|
module Servant.API.Get where
|
|
|
|
|
|
|
|
import Control.Monad.Trans.Either
|
|
|
|
import Data.Aeson
|
|
|
|
import Data.Proxy
|
|
|
|
import Data.String.Conversions
|
2014-10-30 14:54:00 +01:00
|
|
|
import Data.Typeable
|
2014-10-25 01:27:39 +02:00
|
|
|
import Network.HTTP.Types
|
|
|
|
import Network.Wai
|
|
|
|
import Servant.Client
|
2014-11-07 11:57:41 +01:00
|
|
|
import Servant.Common.BaseUrl
|
|
|
|
import Servant.Common.Req
|
2014-10-28 09:04:27 +01:00
|
|
|
import Servant.Docs
|
2014-10-25 01:27:39 +02:00
|
|
|
import Servant.Server
|
|
|
|
|
|
|
|
-- | Endpoint for simple GET requests. The server doesn't receive any arguments
|
|
|
|
-- and serves the contained type as JSON.
|
|
|
|
data Get a
|
2014-10-30 14:54:00 +01:00
|
|
|
deriving Typeable
|
2014-10-25 01:27:39 +02:00
|
|
|
|
|
|
|
instance ToJSON result => HasServer (Get result) where
|
|
|
|
type Server (Get result) = EitherT (Int, String) IO result
|
2014-10-28 10:42:49 +01:00
|
|
|
route Proxy action request respond
|
2014-10-25 01:27:39 +02:00
|
|
|
| null (pathInfo request) && requestMethod request == methodGet = do
|
|
|
|
e <- runEitherT action
|
2014-10-28 14:34:28 +01:00
|
|
|
respond . succeedWith $ case e of
|
2014-10-25 01:27:39 +02:00
|
|
|
Right output ->
|
|
|
|
responseLBS ok200 [("Content-Type", "application/json")] (encode output)
|
|
|
|
Left (status, message) ->
|
|
|
|
responseLBS (mkStatus status (cs message)) [] (cs message)
|
2014-10-28 14:34:28 +01:00
|
|
|
| null (pathInfo request) && requestMethod request /= methodGet =
|
|
|
|
respond $ failWith WrongMethod
|
|
|
|
| otherwise = respond $ failWith NotFound
|
2014-10-25 01:27:39 +02:00
|
|
|
|
|
|
|
instance FromJSON result => HasClient (Get result) where
|
2014-11-05 13:03:57 +01:00
|
|
|
type Client (Get result) = BaseUrl -> EitherT String IO result
|
2014-10-30 14:54:00 +01:00
|
|
|
clientWithRoute Proxy req host =
|
|
|
|
performRequest methodGet req 200 host
|
2014-10-28 09:04:27 +01:00
|
|
|
|
|
|
|
instance ToSample a => HasDocs (Get a) where
|
|
|
|
docsFor Proxy (endpoint, action) =
|
|
|
|
single endpoint' action'
|
|
|
|
|
|
|
|
where endpoint' = endpoint & method .~ DocGET
|
2014-11-13 08:19:14 +01:00
|
|
|
action' = action & response.respBody .~ sampleByteString p
|
2014-10-28 09:04:27 +01:00
|
|
|
p = Proxy :: Proxy a
|