git.iko.soy/rowtype-yoga/purescript-yoga-fastify-om
on main help sign in
rowtype-yoga/purescript-yoga-fastify-om/test/01-BasicAPI.purs
234 lines 6.2 kB history raw
1module Test.BasicAPI where
3import Prelude
5import Control.Monad.Reader.Trans (ask)
6import Data.Either (Either(..))
7import Data.Generic.Rep (class Generic)
8import Data.Maybe (Maybe(..))
9import Data.Newtype (class Newtype)
10import Data.Show.Generic (genericShow)
11import Data.Tuple (Tuple(..))
13import Effect (Effect)
14import Effect.Aff as Aff
15import Effect.Class (liftEffect)
16import Effect.Class.Console as Console
17import Foreign (Foreign, unsafeToForeign)
18import Foreign.Object as FObject
19import Type.Proxy (Proxy(..))
20import Yoga.Fastify.Fastify (Fastify, Host(..), Port(..))
21import Yoga.Fastify.Fastify as F
22import Yoga.Fastify.Om.API (registerAPI)
23import Yoga.Fastify.Om.Route (GET, POST, Route, Request, Handler, handle, respond, reject, buildOpenAPISpec, class HeaderValueType, BearerToken, Enum, class RenderJSONSchema, class HasEnum, enum)
24import Yoga.HTTP.API.Route.OpenAPI (class CollectSchemas, class CollectSchemaNames)
25import Yoga.HTTP.API.Path (class ParseParam, parseParam, type (/), type (:), type (:?))
26import Yoga.JSON (class ReadForeign, class WriteForeign, writeJSON)
27import Yoga.JSON.Generics (genericWriteForeignEnum, genericReadForeignEnum)
28import Yoga.JSON.Generics.EnumSumRep as GenericJSON
30main :: Effect Unit
31main = Aff.launchAff_ do
32 server <- createServer # liftEffect
33 address <- F.listen { port: Port 3000, host: Host "0.0.0.0" } server
34 Console.log $ "Server listening on " <> address
36-- Example Types
38type User =
39 { id :: UserId
40 , name :: String
41 , email :: String
42 , role :: UserRole
43 }
45type CreateUserRequest =
46 { name :: String
47 , email :: String
48 , role :: UserRole
49 }
51type ErrorResponse = { error :: String }
53-- Routes
55-- GET /health
56type HealthRoute = Route GET "health"
57 (Request {})
58 ( ok :: { body :: { status :: String } }
59 , notFound :: { body :: ErrorResponse }
60 )
62healthHandler :: Handler HealthRoute ()
63healthHandler = handle do
64 respond @"ok" { status: "healthy" }
66newtype UserId = UserId Int
68derive instance Newtype UserId _
69derive newtype instance Eq UserId
70derive newtype instance WriteForeign UserId
71derive newtype instance ReadForeign UserId
73instance RenderJSONSchema UserId where
74 renderJSONSchema _ = unsafeToForeign $ FObject.fromFoldable
75 [ Tuple "type" (unsafeToForeign "integer") ]
77instance CollectSchemas UserId where
78 collectSchemas _ = FObject.empty
80instance CollectSchemaNames UserId ()
82instance ParseParam UserId where
83 parseParam s = parseParam s >>= \n ->
84 if n > 0 then Right (UserId n)
85 else Left "UserId must be positive"
87instance HeaderValueType UserId where
88 headerValueType _ = "integer"
90-- GET /users/:id (with authentication)
91type UserRoute = Route GET
92 ("users" / "id" : UserId)
93 { headers :: { authorization :: BearerToken } }
94 ( ok :: { body :: User }
95 , notFound :: { body :: ErrorResponse }
96 , unauthorized :: { body :: ErrorResponse }
97 )
99userHandler :: Handler UserRoute ()
100userHandler = handle do
101 { path } <- ask
103 when (path.id /= UserId 1) do
104 reject @404 { error: "User not found" }
106 respond @200
107 { id: UserId 1
108 , name: "Alice"
109 , email: "alice@example.com"
110 , role: Admin
111 }
113-- GET /users?limit=10
114type UsersWithLimitRoute = Route GET
115 ("users" :? { limit :: Int })
116 (Request {})
117 ( ok :: { body :: { users :: Array User, limit :: Maybe Int } }
118 )
120usersWithLimitHandler :: Handler UsersWithLimitRoute ()
121usersWithLimitHandler = handle do
122 { query } <- ask
123 respond @"ok"
124 { users:
125 [ { id: UserId 1, name: "Alice", email: "alice@example.com", role: Admin }
126 , { id: UserId 2, name: "Bob", email: "bob@example.com", role: Member }
127 ]
128 , limit: query.limit
129 }
131-- POST /users (with authentication)
132type CreateUserRoute = Route POST
133 "users"
134 ( Request
135 { headers :: { authorization :: BearerToken }
136 , body :: CreateUserRequest
137 }
138 )
139 ( created :: { body :: User }
140 , badRequest :: { body :: ErrorResponse }
141 , unauthorized :: { body :: ErrorResponse }
142 )
144createUserHandler :: Handler CreateUserRoute ()
145createUserHandler = handle do
146 { body } <- ask
147 when (body.name == "") do
148 reject @400 { error: "Name cannot be empty" }
149 respond @201
150 { id: UserId 999
151 , name: body.name
152 , email: body.email
153 , role: body.role
154 }
156-- GET /openapi - Serve OpenAPI spec
157type OpenAPIRoute = Route GET
158 "openapi"
159 (Request {})
160 ( ok :: { body :: String }
161 )
163-- Define all API routes for OpenAPI generation
164type AllApiRoutes =
165 { health :: HealthRoute
166 , user :: UserRoute
167 , usersWithLimit :: UsersWithLimitRoute
168 , createUser :: CreateUserRoute
169 }
171openapiHandler :: Handler OpenAPIRoute ()
172openapiHandler = handle do
173 respond @"ok"
174 $ writeJSON
175 $
176 buildOpenAPISpec @AllApiRoutes
177 { title: "Example API"
178 , version: "1.0.0"
179 }
181-- Full API type including all registered routes
182type FullAPI =
183 { health :: HealthRoute
184 , user :: UserRoute
185 , usersWithLimit :: UsersWithLimitRoute
186 , createUser :: CreateUserRoute
187 , openapi :: OpenAPIRoute
188 }
190-- Server Setup
192createServer :: Effect Fastify
193createServer = do
194 fastify <- F.fastify {}
196 registerAPI @FullAPI
197 { health: healthHandler
198 , user: userHandler
199 , usersWithLimit: usersWithLimitHandler
200 , createUser: createUserHandler
201 , openapi: openapiHandler
202 }
203 fastify
205 pure fastify
207-- User role enum
208data UserRole = Admin | Member | Guest
210derive instance Generic UserRole _
211instance Show UserRole where
212 show = genericShow
214instance WriteForeign UserRole where
215 writeImpl = genericWriteForeignEnum GenericJSON.defaultOptions
217instance ReadForeign UserRole where
218 readImpl = genericReadForeignEnum GenericJSON.defaultOptions
220instance RenderJSONSchema UserRole where
221 renderJSONSchema _ = do
222 let
223 enumValues = enum (Proxy :: Proxy (Enum UserRole))
224 baseSchema = FObject.fromFoldable
225 [ Tuple "type" (unsafeToForeign "string")
226 ]
227 case enumValues of
228 Nothing -> unsafeToForeign baseSchema
229 Just vals -> unsafeToForeign $ FObject.insert "enum" (unsafeToForeign vals) baseSchema
231instance CollectSchemas UserRole where
232 collectSchemas _ = FObject.empty
234instance CollectSchemaNames UserRole ()