From 6ad42aad20b88208d7ae2ce30df34ac56c67fd22 Mon Sep 17 00:00:00 2001
From: Chris Forno <jekor@jekor.com>
Date: Sat, 21 Dec 2024 23:07:45 +0100
Subject: [PATCH] Set required attribute for request bodies

While not generally necessary for documentation, setting the request
body to required does help with some client code generation (e.g.
the body type generated by openapi-typescript will be required).
---
 src/Servant/OpenApi.hs          | 9 ++++++---
 src/Servant/OpenApi/Internal.hs | 3 ++-
 2 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/src/Servant/OpenApi.hs b/src/Servant/OpenApi.hs
index 1cf5689..2371707 100644
--- a/src/Servant/OpenApi.hs
+++ b/src/Servant/OpenApi.hs
@@ -157,7 +157,8 @@ import           Servant.OpenApi.Internal.Orphans ()
 --                                 "$ref": "#/components/schemas/User"
 --                             }
 --                         }
---                     }
+--                     },
+--                     "required": true
 --                 },
 --                 "responses": {
 --                     "200": {
@@ -288,7 +289,8 @@ import           Servant.OpenApi.Internal.Orphans ()
 --                                 "$ref": "#/components/schemas/User"
 --                             }
 --                         }
---                     }
+--                     },
+--                     "required": true
 --                 },
 --                 "responses": {
 --                     "200": {
@@ -420,7 +422,8 @@ import           Servant.OpenApi.Internal.Orphans ()
 --                                 "$ref": "#/components/schemas/User"
 --                             }
 --                         }
---                     }
+--                     },
+--                     "required": true
 --                 },
 --                 "responses": {
 --                     "200": {
diff --git a/src/Servant/OpenApi/Internal.hs b/src/Servant/OpenApi/Internal.hs
index 7551058..360a94c 100644
--- a/src/Servant/OpenApi/Internal.hs
+++ b/src/Servant/OpenApi/Internal.hs
@@ -390,7 +390,7 @@ instance (KnownSymbol sym, ToParamSchema a, HasOpenApi sub, SBoolI (FoldRequired
         & in_ .~ ParamHeader
         & schema ?~ (Inline $ toParamSchema (Proxy :: Proxy a))
 
-instance (ToSchema a, AllAccept cs, HasOpenApi sub, KnownSymbol (FoldDescription mods)) => HasOpenApi (ReqBody' mods cs a :> sub) where
+instance (ToSchema a, AllAccept cs, HasOpenApi sub, KnownSymbol (FoldDescription mods), SBoolI (FoldRequired mods)) => HasOpenApi (ReqBody' mods cs a :> sub) where
   toOpenApi _ = toOpenApi (Proxy :: Proxy sub)
     & addRequestBody reqBody
     & addDefaultResponse400 tname
@@ -402,6 +402,7 @@ instance (ToSchema a, AllAccept cs, HasOpenApi sub, KnownSymbol (FoldDescription
       (defs, ref) = runDeclare (declareSchemaRef (Proxy :: Proxy a)) mempty
       reqBody = (mempty :: RequestBody)
         & description .~ transDesc (reflectDescription (Proxy :: Proxy mods))
+        & required .~ (if reflectBool (Proxy :: Proxy (FoldRequired mods)) then Just True else Nothing)
         & content .~ InsOrdHashMap.fromList [(t, mempty & schema ?~ ref) | t <- allContentType (Proxy :: Proxy cs)]
 
 -- | This instance is an approximation.