Introduce x-tie-haskell-request-body-as-stream

src/Tie/Codegen/Imports.hs

@@ -104,6 +104,10 @@ codegenModuleHeader moduleName =
       <> PP.line
       <> "import"
     <+> "qualified"
+    <+> "Data.ByteString"
+      <> PP.line
+      <> "import"
+    <+> "qualified"
     <+> "Data.List"
       <> PP.line
       <> "import"

src/Tie/Codegen/Operation.hs

@@ -163,9 +163,8 @@ codegenApiTypeOperation resolver Operation {..} = do
           ( PP.concatWith
               (\x y -> x <+> "->" <> PP.line <> y)
               ( paramsCode
-                  ++ [ codegenRequestBodyComment body
-                         <> codegenFieldType jsonRequestBodyContent
-                       | Just body@RequestBody {jsonRequestBodyContent} <- [requestBody]
+                  ++ [ codegenRequestBodyComment body <> codegenRequestBodyType body
+                       | Just body<- [requestBody]
                      ]
                   ++ ["m" <+> toApiResponseTypeName name]
               )
@@ -187,6 +186,10 @@ codegenApiTypeOperation resolver Operation {..} = do
       Just comment ->
         "--" <+> PP.pretty comment <> PP.line
 
+    codegenRequestBodyType RequestBody {provideRequestBodyAsStream, jsonRequestBodyContent}
+      | provideRequestBodyAsStream = "IO" <+> "Data.ByteString.ByteString"
+      | otherwise = codegenFieldType jsonRequestBodyContent
+
     codegenParamSchemaAndComment param = do
       code <- codegenParamSchema param
       pure (codegenParamComment param <> code)
@@ -293,6 +296,9 @@ codegenRequestBodyGuard :: Maybe RequestBody -> PP.Doc ann -> PP.Doc ann
 codegenRequestBodyGuard requestBody continuation = case requestBody of
   Nothing ->
     continuation
+  Just RequestBody {provideRequestBodyAsStream = True} ->
+    "let" <+> "body" <+> "=" <+> "Network.Wai.getRequestBodyChunk" <+> "request" <+> "in" <> PP.line <>
+      PP.indent 4 ("(" <> continuation <> ")")
   Just RequestBody {jsonRequestBodyContent} ->
     let parsers =
           -- TODO support forms

src/Tie/Operation.hs

@@ -39,6 +39,8 @@ module Tie.Operation
   )
 where
 
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Types as Aeson
 import Control.Monad.Writer (WriterT (..), runWriterT)
 import Control.Monad.Writer.Strict (tell)
 import qualified Data.HashMap.Strict.InsOrd as InsOrd
@@ -72,7 +74,8 @@ type StatusCode = Int
 -- | Request body descriptor
 data RequestBody = RequestBody
   { description :: Maybe Text,
-    jsonRequestBodyContent :: Named Type
+    jsonRequestBodyContent :: Named Type,
+    provideRequestBodyAsStream :: Bool
   }
 
 data Header = Header
@@ -307,11 +310,24 @@ requestBodyToRequestBody ::
   OpenApi.RequestBody ->
   m RequestBody
 requestBodyToRequestBody resolver Errors {..} requestBody = do
+  let extensions = 
+        OpenApi._unDefs (OpenApi._requestBodyExtensions requestBody)
+
+      provideRequestBodyAsStream 
+        | Just extensionValue <- InsOrd.lookup "tie-haskell-request-body-as-stream" extensions 
+        , Just flag <-  Aeson.parseMaybe Aeson.parseJSON extensionValue
+        = flag
+        | otherwise = 
+          False
+
   -- TODO support form inputs as well
-  OpenApi.MediaTypeObject {..} <-
-    whenNothing
-      (InsOrd.lookup "application/json" (OpenApi._requestBodyContent requestBody))
-      (traceShow requestBody $ unsupportedMediaType)
+  OpenApi.MediaTypeObject {..} <- whenNothing (
+      asum [
+        InsOrd.lookup "application/json" (OpenApi._requestBodyContent requestBody),
+        InsOrd.lookup "application/x-ndjson" (OpenApi._requestBodyContent requestBody)
+      ]
+    )
+    (traceShow requestBody $ unsupportedMediaType)
   referencedSchema <-
     whenNothing
       _mediaTypeObjectSchema
@@ -321,7 +337,8 @@ requestBodyToRequestBody resolver Errors {..} requestBody = do
   pure
     RequestBody
       { description = OpenApi._requestBodyDescription requestBody,
-        jsonRequestBodyContent = type_
+        jsonRequestBodyContent = type_,
+        provideRequestBodyAsStream
       }
 
 responseToResponse ::

test/golden/additional-properties.yaml.out

@@ -18,6 +18,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -471,6 +472,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -521,6 +523,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -611,6 +614,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -678,6 +682,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map

test/golden/bug-1.yaml.out

@@ -18,6 +18,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -457,6 +458,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map

test/golden/csv.yaml.out

@@ -18,6 +18,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -471,6 +472,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -523,6 +525,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map

test/golden/datetime.yaml.out

@@ -18,6 +18,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -457,6 +458,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -507,6 +509,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map

test/golden/enum-bug.yaml.out

@@ -18,6 +18,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -460,6 +461,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -510,6 +512,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -598,6 +601,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -686,6 +690,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -743,6 +748,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -822,6 +828,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map

test/golden/enum.yaml.out

@@ -18,6 +18,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -524,6 +525,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -574,6 +576,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -663,6 +666,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -746,6 +750,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -796,6 +801,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -846,6 +852,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -924,6 +931,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map
@@ -996,6 +1004,7 @@ import qualified Data.Aeson.Encoding
 import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
+import qualified Data.ByteString
 import qualified Data.List
 import qualified Data.List.NonEmpty
 import qualified Data.Map

test/golden/haskell-ext.yaml

@@ -25,6 +25,22 @@ paths:
             application/json:
               schema:
                 $ref: "#/components/schemas/Test"              
+    post:
+      operationId: test2
+      summary: test2
+      requestBody:
+        x-tie-haskell-request-body-as-stream: true
+        description: Some nice request body
+        content:
+          application/json:
+            schema:      # Request body contents
+              properties: 
+                nise: 
+                  type: string
+      responses:
+        '201':
+          description: Successful response
+
 components:
   schemas:
     Test: