git.iko.soy/servant-reflex
on master help sign in
servant-reflex/testserver/API.hs
69 lines 2.3 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE TypeOperators #-}
5module API where
7import Data.Aeson
8import Data.Aeson.Types (typeMismatch)
9import Data.Text (Text)
10import Servant.API
12newtype Question = Question { unQuestion :: Text } deriving (Show)
14instance ToJSON Question where
15 toJSON (Question txt) = object ["question" .= txt]
17instance FromJSON Question where
18 parseJSON (Object v) = Question <$> v .: "question"
19 parseJSON x = typeMismatch "Couldn't find key 'question'" x
21newtype Answer = Answer { unAnswer :: Text } deriving (Show)
23instance ToJSON Answer where
24 toJSON (Answer txt) = object ["answer" .= txt]
26instance FromJSON Answer where
27 parseJSON (Object v) = Answer <$> v .: "answer"
28 parseJSON x = typeMismatch "Couldn't find key 'answer'" x
31-- | API spec for server, client, and docs
32type API = "getunit" :> Get '[JSON] ()
33 :<|> "getint" :> Get '[JSON] Int
34 :<|> "sayhi" :> QueryParam "username" Text
35 :> QueryParams "greetings" Text
36 :> QueryFlag "gusto"
37 :> Get '[JSON] Text
38 :<|> "double" :> ReqBody '[JSON] Double
39 :> Post '[JSON] Double
40 :<|> "a" :> "b" :> QueryFlag "gusto" :> Get '[JSON] Text
41 :<|> "qna" :> ReqBody '[JSON] Question
42 :> Post '[JSON] Answer
43 :<|> "secret" :> BasicAuth "realm" () :> Get '[JSON] Int
44 :<|> Raw
46type GET = Get '[JSON] ()
48-- Imported the comprehensive API example for testing.
49-- https://github.com/haskell-servant/servant/blob/master/servant/src/Servant/API/Internal/Test/ComprehensiveAPI.hs
50type ComprehensiveAPI =
51 GET :<|>
52 Get '[JSON] Int :<|>
53 Capture "foo" Int :> GET :<|>
54 Header "foo" Int :> GET :<|>
55 HttpVersion :> GET :<|>
56 IsSecure :> GET :<|>
57 QueryParam "foo" Int :> GET :<|>
58 QueryParams "foo" Int :> GET :<|>
59 QueryFlag "foo" :> GET :<|>
60-- Raw :<|>
61 RemoteHost :> GET :<|>
62 ReqBody '[JSON] Int :> GET :<|>
63 Get '[JSON] (Headers '[Header "foo" Int] ()) :<|>
64 "foo" :> GET :<|>
65 Vault :> GET :<|>
66 Verb 'POST 204 '[JSON] () :<|>
67 Verb 'POST 204 '[JSON] Int
68-- This one isn't in scope
69-- :<|> WithNamedContext "foo" '[] GET