git.iko.soy/typeable/openapi3
on 00aae14 help sign in
typeable/openapi3/examples/hackage.hs
82 lines 2.5 kB history raw
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveAnyClass #-}
3{-# LANGUAGE OverloadedLists #-}
4{-# LANGUAGE OverloadedStrings #-}
5module Main where
7import Control.Lens
8import Data.Aeson
9import Data.Proxy
10import Data.Text (Text)
11import GHC.Generics
13import Data.OpenApi
14import Data.OpenApi.Declare
15import Data.OpenApi.Lens
16import Data.OpenApi.Operation
18type Username = Text
20data UserSummary = UserSummary
21 { summaryUsername :: Username
22 , summaryUserid :: Int
23 } deriving (Generic)
25instance ToSchema UserSummary where
26 declareNamedSchema _ = do
27 usernameSchema <- declareSchemaRef (Proxy :: Proxy Username)
28 useridSchema <- declareSchemaRef (Proxy :: Proxy Int)
29 return $ NamedSchema (Just "UserSummary") $ mempty
30 & type_ ?~ OpenApiObject
31 & properties .~
32 [ ("summaryUsername", usernameSchema )
33 , ("summaryUserid" , useridSchema )
34 ]
35 & required .~ [ "summaryUsername"
36 , "summaryUserid" ]
39type Group = Text
41data UserDetailed = UserDetailed
42 { username :: Username
43 , userid :: Int
44 , groups :: [Group]
45 } deriving (Generic, ToSchema)
47newtype Package = Package { packageName :: Text }
48 deriving (Generic, ToSchema)
50hackageOpenApi :: OpenApi
51hackageOpenApi = spec & components.schemas .~ defs
52 where
53 (defs, spec) = runDeclare declareHackageOpenApi mempty
55declareHackageOpenApi :: Declare (Definitions Schema) OpenApi
56declareHackageOpenApi = do
57 -- param schemas
58 let usernameParamSchema = toParamSchema (Proxy :: Proxy Username)
60 -- responses
61 userSummaryResponse <- declareResponse "application/json" (Proxy :: Proxy UserSummary)
62 userDetailedResponse <- declareResponse "application/json" (Proxy :: Proxy UserDetailed)
63 packagesResponse <- declareResponse "application/json" (Proxy :: Proxy [Package])
65 return $ mempty
66 & paths .~
67 [ ("/users", mempty & get ?~ (mempty
68 & at 200 ?~ Inline userSummaryResponse))
69 , ("/user/{username}", mempty & get ?~ (mempty
70 & parameters .~ [ Inline $ mempty
71 & name .~ "username"
72 & required ?~ True
73 & in_ .~ ParamPath
74 & schema ?~ Inline usernameParamSchema ]
75 & at 200 ?~ Inline userDetailedResponse))
76 , ("/packages", mempty & get ?~ (mempty
77 & at 200 ?~ Inline packagesResponse))
78 ]
80main :: IO ()
81main = putStrLn . read . show . encode $ hackageOpenApi