{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
-- | A representative API's complete OpenAPI 3.1 document.
--
-- The document carries @info@ (title/version/description), a @server@, @tags@,
-- and a unique @operationId@ per operation so both the executable and tests
-- exercise a realistic generated contract.
--
-- On servant >= 0.20.3 the API also includes a 'MultiVerb' endpoint, so the
-- contract covers multiple status codes, an empty-body response, and a
-- response carrying headers.
module GenOpenApi.Spec (spec) where
import Control.Lens
import Data.Aeson (ToJSON)
import Data.Char (isAlphaNum, toUpper)
import Data.OpenApi (ToSchema)
import Data.OpenApi qualified as O
import Data.Proxy (Proxy (..))
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Servant.API
#if MIN_VERSION_servant(0,20,3)
import Servant.API.MultiVerb (MultiVerb, Respond, RespondEmpty, WithHeaders)
#endif
import Servant.OpenApi (toOpenApi)
-- A small but representative Todo-style CRUD API: a response record with a
-- nested optional field, a request body, a path capture, and a no-content
-- delete.
data Todo = Todo
{ todoId :: Int,
title :: Text,
completed :: Bool,
notes :: Maybe Text
}
deriving (Generic)
instance ToJSON Todo
instance ToSchema Todo
data NewTodo = NewTodo
{ newTitle :: Text,
newNotes :: Maybe Text
}
deriving (Generic)
instance ToJSON NewTodo
instance ToSchema NewTodo
#if MIN_VERSION_servant(0,20,3)
-- | Responses for the MultiVerb status endpoint: an empty-body 404, a plain
-- 200 carrying the todo, and a 203 whose response also carries a header — so
-- the linted document exercises MultiVerb's multi-status, empty-body, and
-- header-carrying rendering paths.
type TodoStatusResponses =
'[ RespondEmpty 404 "No todo with that id"
, Respond 200 "The todo's current state" Todo
, WithHeaders '[Header "X-Revision" Int] Todo
(Respond 203 "Non-authoritative todo state" Todo)
]
#endif
type TodoAPI =
"todos" :> Get '[JSON] [Todo]
:<|> "todos" :> ReqBody '[JSON] NewTodo :> Post '[JSON] Todo
:<|> "todos" :> Capture "id" Int :> Get '[JSON] Todo
:<|> "todos" :> Capture "id" Int :> ReqBody '[JSON] NewTodo :> Put '[JSON] Todo
:<|> "todos" :> Capture "id" Int :> Delete '[JSON] NoContent
#if MIN_VERSION_servant(0,20,3)
:<|> "todos" :> "status" :> Capture "id" Int
:> MultiVerb 'GET '[JSON] TodoStatusResponses ()
#endif
-- | The generated bare document enriched into a complete OpenAPI 3.1 contract.
spec :: O.OpenApi
spec =
toOpenApi (Proxy :: Proxy TodoAPI)
& O.info . O.title .~ "Todo API"
& O.info . O.version .~ "1.0.0"
& O.info . O.description ?~ "A small, representative Todo CRUD API."
& O.servers .~ ["https://api.example.com"]
& O.applyTags [O.Tag "todos" (Just "Operations on todo items") Nothing]
& withOperationIds
-- | Assign a unique @operationId@ to every operation, derived from its HTTP
-- method and path (e.g. @GET \/todos\/{id}@ → @getTodosId@). Operations whose
-- method is absent on a path are left untouched.
withOperationIds :: O.OpenApi -> O.OpenApi
withOperationIds = O.paths %~ imap setForPath
where
setForPath path =
(O.get . _Just . O.operationId %~ orSet ("get" <> key))
. (O.post . _Just . O.operationId %~ orSet ("create" <> key))
. (O.put . _Just . O.operationId %~ orSet ("update" <> key))
. (O.delete . _Just . O.operationId %~ orSet ("delete" <> key))
where
key = camel path
orSet v = Just . maybe v id
-- | Turn a path like @"\/todos\/{id}"@ into @"TodosId"@.
camel :: FilePath -> Text
camel = T.pack . concatMap capitalize . words . map keepAlnum
where
keepAlnum c = if isAlphaNum c then c else ' '
capitalize [] = []
capitalize (c : cs) = toUpper c : cs