scarf-sh/tie
1
1
Fork 0
mirror of https://github.com/scarf-sh/tie.git synced 2024-11-22 10:31:56 +03:00
Code Issues Packages Projects Releases Wiki Activity

Proper content negotiation for request bodies

Browse Source
This commit is contained in:
Alex Biehl 2022-09-03 11:40:52 +02:00 committed by Alexander Biehl
parent 19767f0b06
commit b110894945
17 changed files with 176 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
Request.template.hs
View File

@ -24,6 +24,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -126,7 +127,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -140,16 +144,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)

1
src/Tie/Codegen/Cabal.hs
View File

@ -17,6 +17,7 @@ codegenCabalFile packageName exposedModules extraPackages =
"containers",
"ghc-prim",
"http-api-data",
"http-media",
"http-types",
"text",
"time",

17
test/golden/additional-properties.yaml.out
View File

@ -107,6 +107,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -209,7 +210,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -223,16 +227,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -545,6 +549,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/bug-1.yaml.out
View File

@ -93,6 +93,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -195,7 +196,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -209,16 +213,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -333,6 +337,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/csv.yaml.out
View File

@ -107,6 +107,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -209,7 +210,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -223,16 +227,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -391,6 +395,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/datetime.yaml.out
View File

@ -93,6 +93,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -195,7 +196,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -209,16 +213,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -392,6 +396,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/enum-bug.yaml.out
View File

@ -96,6 +96,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -198,7 +199,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -212,16 +216,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -718,6 +722,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/enum.yaml.out
View File

@ -160,6 +160,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -262,7 +263,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -276,16 +280,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -865,6 +869,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/haskell-ext.yaml.out
View File

@ -97,6 +97,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -199,7 +200,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -213,16 +217,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -392,6 +396,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/headers.yaml.out
View File

@ -124,6 +124,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -226,7 +227,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -240,16 +244,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -511,6 +515,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/lists.yaml.out
View File

@ -123,6 +123,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -225,7 +226,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -239,16 +243,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -603,6 +607,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/numbers.yaml.out
View File

@ -93,6 +93,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -195,7 +196,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -209,16 +213,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -408,6 +412,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/object-without-type.yaml.out
View File

@ -93,6 +93,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -195,7 +196,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -209,16 +213,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -333,6 +337,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/oneof.yaml.out
View File

@ -123,6 +123,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -225,7 +226,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -239,16 +243,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -860,6 +864,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/petstore.yaml.out
View File

@ -124,6 +124,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -226,7 +227,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -240,16 +244,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -625,6 +629,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/test1.yaml.out
View File

@ -127,6 +127,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -229,7 +230,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -243,16 +247,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -921,6 +925,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time

17
test/golden/weird-cookie-trick.yaml.out
View File

@ -93,6 +93,7 @@ import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Network.HTTP.Media
import Network.HTTP.Types (HeaderName, hContentType)
import qualified Network.Wai as Wai
import System.IO.Unsafe (unsafeInterleaveIO)
@ -195,7 +196,10 @@ requiredHeader name withHeader = \request respond ->
withHeader x request respond
{-# INLINEABLE requiredHeader #-}
data BodyParser a = BodyParser ByteString ((a -> Wai.Application) -> Wai.Application)
data BodyParser a
= BodyParser
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
@ -209,16 +213,16 @@ parseRequestBody :: [BodyParser a] -> (a -> Wai.Application) -> Wai.Application
parseRequestBody parsers withBody = \request respond -> do
let contentType =
fromMaybe
"text/html"
"application/octet-stream"
(List.lookup hContentType (Wai.requestHeaders request))
bodyParser =
List.find
(\(BodyParser expectedContentType _) -> expectedContentType == contentType)
parsers
Network.HTTP.Media.mapAccept
[(mediaType, parser) | BodyParser mediaType parser <- parsers]
contentType
case bodyParser of
Just (BodyParser _ parseBody) ->
Just parseBody ->
parseBody withBody request respond
Nothing ->
respond (Wai.responseBuilder (toEnum 415) [] mempty)
@ -333,6 +337,7 @@ library
, containers
, ghc-prim
, http-api-data
, http-media
, http-types
, text
, time