diff --git a/.readthedocs.yml b/.readthedocs.yml
new file mode 100644
index 000000000..fe06ed1d8
--- /dev/null
+++ b/.readthedocs.yml
@@ -0,0 +1,23 @@
+# Read the Docs configuration file for Sphinx projects
+# See https://docs.readthedocs.io/en/stable/config-file/v2.html for details
+
+# Required
+version: 2
+
+# Set the OS, Python version and other tools you might need
+build:
+  os: ubuntu-22.04
+  tools:
+    python: "3.12"
+    # You can also specify other tool versions:
+    # nodejs: "20"
+    # rust: "1.70"
+    # golang: "1.20"
+
+# Build documentation in the "docs/" directory with Sphinx
+sphinx:
+  configuration: docs/conf.py
+  # You can configure Sphinx to use a different builder, for instance use the dirhtml builder for simpler URLs
+  # builder: "dirhtml"
+  # Fail on all warnings to avoid broken references
+  # fail_on_warning: true
diff --git a/cabal.project b/cabal.project
index f504f44e7..042003d15 100644
--- a/cabal.project
+++ b/cabal.project
@@ -87,3 +87,7 @@ allow-newer: openapi3:hashable
 -- http2-5.3.3 is blacklisted, force http2-5.3.2 or http2-5.3.4
 constraints:
   http2 ==5.3.2 || ==5.3.4
+
+package HsOpenSSL
+  -- Fix compilation with GCC >= 14
+  ghc-options: -optc-Wno-incompatible-pointer-types
diff --git a/doc/conf.py b/doc/conf.py
index a34d7743b..3ac4b54f0 100644
--- a/doc/conf.py
+++ b/doc/conf.py
@@ -39,7 +39,12 @@
 # The suffix(es) of source filenames.
 # You can specify multiple suffix as a list of string:
 #
-source_suffix = ['.rst', '.md', '.lhs']
+source_suffix = {
+    '.rst': 'restructuredtext',
+    '.md': 'markdown',
+    '.lhs': 'markdown',
+}
+
 
 # The master toctree document.
 master_doc = 'index'
@@ -63,7 +68,7 @@
 #
 # This is also used if you do content translation via gettext catalogs.
 # Usually you set "language" from the command line for these cases.
-language = None
+language = 'en'
 
 # List of patterns, relative to source directory, that match files and
 # directories to ignore when looking for source files.
@@ -166,6 +171,4 @@
 
 # -- Markdown -------------------------------------------------------------
 
-source_parsers = {
-    '.lhs': CommonMarkParser,
-}
+extensions.append('recommonmark')
diff --git a/doc/cookbook/basic-streaming/Streaming.lhs b/doc/cookbook/basic-streaming/Streaming.lhs
index e027d8b87..7e4a4f90d 100644
--- a/doc/cookbook/basic-streaming/Streaming.lhs
+++ b/doc/cookbook/basic-streaming/Streaming.lhs
@@ -123,7 +123,7 @@ main = do
                     go !acc (S.Yield _ s) = go (acc + 1) s
         _ -> do
             putStrLn "Try:"
-            putStrLn "cabal new-run cookbook-basic-streaming server"
-            putStrLn "cabal new-run cookbook-basic-streaming client 10"
+            putStrLn "cabal run cookbook-basic-streaming server"
+            putStrLn "cabal run cookbook-basic-streaming client 10"
             putStrLn "time curl -H 'Accept: application/json' localhost:8000/slow/5"
 ```
diff --git a/doc/cookbook/cabal.project b/doc/cookbook/cabal.project
deleted file mode 100644
index f82acd464..000000000
--- a/doc/cookbook/cabal.project
+++ /dev/null
@@ -1,22 +0,0 @@
-packages:
-  basic-auth/
-  curl-mock/
-  db-mysql-basics/
-  db-sqlite-simple/
-  db-postgres-pool/
-  using-custom-monad/
-  jwt-and-basic-auth/
-  hoist-server-with-context/
-  file-upload/
-  structuring-apis/
-  https/
-  pagination/
-  sentry/
-  testing/
-  open-id-connect/
-  ../../servant
-  ../../servant-server
-  ../../servant-client-core
-  ../../servant-client
-  ../../servant-docs
-  ../../servant-foreign
diff --git a/doc/cookbook/cabal.project.local b/doc/cookbook/cabal.project.local
deleted file mode 100644
index e69de29bb..000000000
diff --git a/doc/cookbook/file-upload/FileUpload.lhs b/doc/cookbook/file-upload/FileUpload.lhs
index 87a294d34..17962907b 100644
--- a/doc/cookbook/file-upload/FileUpload.lhs
+++ b/doc/cookbook/file-upload/FileUpload.lhs
@@ -113,7 +113,7 @@ main = withSocketsDo . bracket (forkIO startServer) killThread $ \_threadid -> d
 If you run this, you should get:
 
 ``` bash
-$ cabal new-build cookbook-file-upload
+$ cabal build cookbook-file-upload
 [...]
 $ dist-newstyle/build/x86_64-linux/ghc-8.2.1/cookbook-file-upload-0.1/x/cookbook-file-upload/build/cookbook-file-upload/cookbook-file-upload
 Inputs:
diff --git a/doc/cookbook/generic/Generic.lhs b/doc/cookbook/generic/Generic.lhs
index 45180230a..c7ba443c5 100644
--- a/doc/cookbook/generic/Generic.lhs
+++ b/doc/cookbook/generic/Generic.lhs
@@ -107,7 +107,7 @@ main = do
         ("run-custom-monad":_) -> do
             putStrLn "Starting cookbook-generic with a custom monad at http://localhost:8000"
             run 8000 (appMyMonad AppCustomState)
-        _ -> putStrLn "To run, pass 'run' argument: cabal new-run cookbook-generic run"
+        _ -> putStrLn "To run, pass 'run' argument: cabal run cookbook-generic run"
 ```
 
 ## Using generics together with a custom monad
diff --git a/doc/cookbook/index.rst b/doc/cookbook/index.rst
index 79a0179bf..426ca5afb 100644
--- a/doc/cookbook/index.rst
+++ b/doc/cookbook/index.rst
@@ -28,6 +28,7 @@ you name it!
   using-free-client/UsingFreeClient.lhs
   custom-errors/CustomErrors.lhs
   uverb/UVerb.lhs
+  multiverb/MultiVerb.lhs
   basic-auth/BasicAuth.lhs
   basic-streaming/Streaming.lhs
   jwt-and-basic-auth/JWTAndBasicAuth.lhs
diff --git a/doc/cookbook/multiverb/MultiVerb.lhs b/doc/cookbook/multiverb/MultiVerb.lhs
new file mode 100644
index 000000000..840f6299b
--- /dev/null
+++ b/doc/cookbook/multiverb/MultiVerb.lhs
@@ -0,0 +1,249 @@
+# MultiVerb: Powerful endpoint types
+
+`MultiVerb` allows you to represent an API endpoint with multiple response types, status codes and headers.
+
+## Preliminaries
+
+```haskell
+{-# LANGUAGE GHC2021 #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
+
+import GHC.Generics
+import Generics.SOP qualified as GSOP
+import Network.Wai.Handler.Warp as Warp
+
+import Servant.API
+import Servant.API.MultiVerb
+import Servant.Server
+import Servant.Server.Generic
+```
+
+## Writing an endpoint
+
+Let us create an endpoint that captures an 'Int' and has the following logic:
+
+* If the number is negative, we return status code 400 and an empty body;
+* If the number is even, we return a 'Bool' in the response body;
+* If the number is odd, we return another 'Int' in the response body.
+
+Let us list all possible HTTP responses:
+```haskell
+
+type Responses =
+  '[ RespondEmpty 400 "Negative"
+   , Respond 200 "Odd number" Int
+   , Respond 200 "Even number" Bool
+   ]
+```
+
+Let us create the return type. We will create a sum type that lists the values on the Haskell side that correspond to our HTTP responses.
+In order to tie the two types together, we will use a mechanism called `AsUnion` to create a correspondance between the two:
+
+```haskell
+data Result
+  = NegativeNumber
+  | Odd Int
+  | Even Bool
+  deriving stock (Generic)
+  deriving (AsUnion Responses)
+    via GenericAsUnion Responses Result
+
+instance GSOP.Generic Result
+```
+
+These deriving statements above tie together the responses and the return values, and the order in which they are defined matters. For instance, if `Even` and `Odd` had switched places in the definition of `Result`, this would provoke an error:
+
+```
+• No instance for ‘AsConstructor
+    ((:) @Type Int ('[] @Type)) (Respond 200 "Even number" Bool)’
+        arising from the 'deriving' clause of a data type declaration
+```
+
+(_If you would prefer to write an intance of 'AsUnion' by yourself, read more in Annex 1 “Implementing AsUnion manually” section._)
+
+Finally, let us write our endpoint description:
+
+```haskell
+type MultipleChoicesInt =
+  Capture "int" Int
+  :> MultiVerb
+    'GET
+    '[JSON]
+    Responses
+    Result
+```
+
+This piece of code is to be read as "Create an endpoint that captures an integer, and accepts a GET request with the `application/json` MIME type,
+and can send one of the responses and associated result value."
+
+### Implementing AsUnion manually
+
+In the above example, the `AsUnion` typeclass is derived through the help of the `DerivingVia` mechanism,
+and the `GenericAsUnion` wrapper.
+
+If you would prefer implementing it yourself, you need to encode your responses as [Peano numbers](https://wiki.haskell.org/Peano_numbers),
+augmented with the `I`(identity) combinator.
+
+See how three options can be encoded as the Z (zero), S Z (successor to zero, so one),
+and S (S Z) (the sucessor to the successor to zero, so two). This encoding is static, so we know in advance how to decode them to
+Haskell datatypes. See the instance below for the encoding/decoding process:
+
+```
+instance AsUnion MultipleChoicesIntResponses MultipleChoicesIntResult where
+  toUnion NegativeNumber =       Z (I ())
+  toUnion (Even b)       =    S (Z (I b))
+  toUnion (Odd i)        = S (S (Z (I i)))
+
+  fromUnion       (Z (I ())) = NegativeNumber
+  fromUnion    (S (Z (I b))) = Even b
+  fromUnion (S (S (Z (I i)))) = Odd i
+  fromUnion (S (S (S x))) = case x of {}
+```
+
+## Integration in a routing table
+
+We want to integrate our endpoint into a wider routing table with another
+endpoint: `version`, which returns the version of the API
+
+```haskell
+data Routes mode = Routes
+  { choicesRoutes :: mode :- "choices" :> Choices
+  , version :: mode :- "version" :> Get '[JSON] Int
+  }
+  deriving stock (Generic)
+```
+
+```haskell
+type Choices = NamedRoutes Choices'
+data Choices' mode = Choices'
+  { choices :: mode :- MultipleChoicesInt
+  }
+  deriving stock (Generic)
+
+choicesServer :: Choices' AsServer
+choicesServer =
+  Choices'
+    { choices = choicesHandler
+    }
+
+routesServer :: Routes AsServer
+routesServer =
+  Routes
+    { choicesRoutes = choicesServer
+    , version = versionHandler
+    }
+
+choicesHandler :: Int -> Handler Result
+choicesHandler parameter =
+  if parameter < 0
+  then pure NegativeNumber
+  else
+    if even parameter
+    then pure $ Odd 3
+    else pure $ Even True
+
+versionHandler :: Handler Int
+versionHandler = pure 1
+```
+
+We can now plug everything together:
+
+
+```haskell
+main :: IO ()
+main = do
+  putStrLn "Starting server on http://localhost:5000"
+  let server = genericServe routesServer
+  Warp.run 5000 server
+```
+
+Now let us run the server and observe how it behaves:
+
+```
+$ http http://localhost:5000/version
+HTTP/1.1 200 OK
+Content-Type: application/json;charset=utf-8
+Date: Thu, 29 Aug 2024 14:22:20 GMT
+Server: Warp/3.4.1
+Transfer-Encoding: chunked
+
+1
+```
+
+
+```
+$ http http://localhost:5000/choices/3
+HTTP/1.1 200 OK
+Content-Type: application/json;charset=utf-8
+Date: Thu, 29 Aug 2024 14:22:30 GMT
+Server: Warp/3.4.1
+Transfer-Encoding: chunked
+
+true
+```
+
+```
+$ http http://localhost:5000/choices/2
+HTTP/1.1 200 OK
+Content-Type: application/json;charset=utf-8
+Date: Thu, 29 Aug 2024 14:22:33 GMT
+Server: Warp/3.4.1
+Transfer-Encoding: chunked
+
+3
+```
+
+```
+$ http http://localhost:5000/choices/-432
+HTTP/1.1 400 Bad Request
+Date: Thu, 29 Aug 2024 14:22:41 GMT
+Server: Warp/3.4.1
+Transfer-Encoding: chunked
+```
+
+You have now learned how to use the MultiVerb feature of Servant.
+
+## Annex 1: Implementing AsUnion manually
+
+Should you need to implement `AsUnion` manually, here is how to do it. `AsUnion` relies on 
+two methods, `toUnion` and  `fromUnion`. They respectively encode your response type to, and decode it from, an inductive type that resembles a [Peano number](https://wiki.haskell.org/Peano_numbers).
+
+Let's see it in action, with explanations below:
+
+```haskell
+instance => AsUnion MultipleChoicesIntResponses MultipleChoicesIntResult where
+  toUnion NegativeNumber = Z (I ())
+  toUnion (Even b)    = S (Z (I b))
+  toUnion (Odd i)  = S (S (Z (I i)))
+
+  fromUnion       (Z (I ())) = NegativeNumber
+  fromUnion    (S (Z (I b))) = Even b
+  fromUnion (S (S (Z (I i)))) = Odd i
+  fromUnion (S (S (S x))) = case x of {}
+```
+
+### Encoding our data to a Union
+
+Let's see how the implementation of `toUnion` works:
+
+In the first equation for `toUnion`, `NegativeNumber` gets translated by `toUnion` into `Z (I ())`.
+`I` is the constructor that holds a value. Here it is holds no meaningful value, because `NegativeNumber` does not have any argument.
+In the tradition of Peano numbers, we start with the `Z`, for Zero.
+
+Then `Even`, which holds a value, `b`, must then be encoded. Following Zero is its Successor, so we wrap the `Z` within a `S` constructor.
+Since it has one argument, we can store it in the `I` constructor.
+
+The pattern repeats with `Odd`, which hole a value (`i`) too. We add a `S`uccessor constructor to the previous encoding, 
+and we store the value inside `I`.
+
+### Decoding the Union
+
+Since every member of our sum type was encoded to a unique form as an inductive data structure, we can decode them quite easily:
+
+* `Z (I ())` is our `NegativeNumber` constructor;
+* `(S (Z (I b)))` is `Even` with `b`;
+* `(S (S (Z (I i))))` is `Odd` with `i`.
+
+Finally, the last equation of `fromUnion` is here to satisfy GHC's pattern checker. It does not serve any functional purpose.
diff --git a/doc/cookbook/multiverb/multiverb.cabal b/doc/cookbook/multiverb/multiverb.cabal
new file mode 100644
index 000000000..57199de36
--- /dev/null
+++ b/doc/cookbook/multiverb/multiverb.cabal
@@ -0,0 +1,34 @@
+cabal-version:       3.0
+name:                cookbook-multiverb
+version:             0.0.1
+synopsis:            MultiVerb cookbook
+homepage:            http://docs.servant.dev/
+license:             BSD-3-Clause
+license-file:        ../../../servant/LICENSE
+author:              Servant Contributors
+maintainer:          haskell-servant-maintainers@googlegroups.com
+category:            Servant
+build-type:          Simple
+
+executable cookbook-multiverb
+  main-is:             MultiVerb.lhs
+  build-depends:       base <  5 
+                     , aeson >= 2.2
+                     , aeson-pretty >= 0.8.8
+                     , async
+                     , http-client
+                     , mtl
+                     , servant
+                     , servant-client
+                     , generics-sop
+                     , sop-core
+                     , servant-server
+                     , servant-swagger
+                     , string-conversions
+                     , swagger2
+                     , wai
+                     , warp
+  default-language: Haskell2010
+  ghc-options:         -Wall -pgmL markdown-unlit
+  build-tool-depends:  markdown-unlit:markdown-unlit
+
diff --git a/doc/cookbook/testing/Testing.lhs b/doc/cookbook/testing/Testing.lhs
index 0f9d1fc7f..1a7c61e72 100644
--- a/doc/cookbook/testing/Testing.lhs
+++ b/doc/cookbook/testing/Testing.lhs
@@ -175,7 +175,7 @@ businessLogicSpec =
 Let's run our tests and see what happens:
 
 ```
-$ cabal new-test all
+$ cabal test all
 POST /user
   should create a user with a high enough ID
   should fail with a too-small ID FAILED [1]
@@ -364,7 +364,7 @@ Out of the box, `hspec-wai` provides a lot of useful tools for us to run tests
 against our application. What happens when we run these tests?
 
 ```
-$ cabal new-test all
+$ cabal test all
 ...
 
 GET /docs
diff --git a/doc/cookbook/using-free-client/UsingFreeClient.lhs b/doc/cookbook/using-free-client/UsingFreeClient.lhs
index 8b668582c..27893e3fe 100644
--- a/doc/cookbook/using-free-client/UsingFreeClient.lhs
+++ b/doc/cookbook/using-free-client/UsingFreeClient.lhs
@@ -66,8 +66,8 @@ main = do
             test
         _ -> do
             putStrLn "Try:"
-            putStrLn "cabal new-run cookbook-using-free-client server"
-            putStrLn "cabal new-run cookbook-using-free-client client"
+            putStrLn "cabal run cookbook-using-free-client server"
+            putStrLn "cabal run cookbook-using-free-client client"
 ```
 
 ## Test
diff --git a/doc/requirements.txt b/doc/requirements.txt
index c507e4386..f7081a039 100644
--- a/doc/requirements.txt
+++ b/doc/requirements.txt
@@ -1,4 +1,4 @@
-recommonmark==0.5.0
-Sphinx==1.8.4
-sphinx_rtd_theme>=0.4.2
-jinja2<3.1.0
+myst-parser ==4.0.0
+Sphinx ==7.4.7
+sphinx_rtd_theme ==2.0.0
+jinja2 ==3.1.4
diff --git a/servant-client-core/servant-client-core.cabal b/servant-client-core/servant-client-core.cabal
index 5cf45c168..0e85f0eeb 100644
--- a/servant-client-core/servant-client-core.cabal
+++ b/servant-client-core/servant-client-core.cabal
@@ -91,6 +91,7 @@ library
     Servant.Client.Core.Reexport
     Servant.Client.Core.Request
     Servant.Client.Core.Response
+    Servant.Client.Core.MultiVerb.ResponseUnrender
     Servant.Client.Core.RunClient
     Servant.Client.Free
     Servant.Client.Generic
diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs
index f3a53ad58..69b97541c 100644
--- a/servant-client-core/src/Servant/Client/Core/HasClient.hs
+++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE ApplicativeDo #-}
 {-# OPTIONS_GHC -Wno-missing-methods #-}
 module Servant.Client.Core.HasClient (
     clientIn,
@@ -8,7 +9,8 @@ module Servant.Client.Core.HasClient (
     (//),
     (/:),
     foldMapUnion,
-    matchUnion
+    matchUnion,
+    fromSomeClientResponse
     ) where
 
 import           Prelude ()
@@ -16,9 +18,10 @@ import           Prelude.Compat
 
 import           Control.Arrow
                  (left, (+++))
+import qualified Data.Text as Text
 import           Control.Monad
                  (unless)
-import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Lazy as BSL
 import           Data.Either
                  (partitionEithers)
 import           Data.Constraint (Dict(..))
@@ -42,13 +45,11 @@ import           Data.SOP.Constraint
 import           Data.SOP.NP
                  (NP (..), cpure_NP)
 import           Data.SOP.NS
-                 (NS (S))
+                 (NS (..))
 import           Data.String
                  (fromString)
 import           Data.Text
                  (Text, pack)
-import           Data.Proxy
-                 (Proxy (Proxy))
 import           GHC.TypeLits
                  (KnownNat, KnownSymbol, TypeError, symbolVal)
 import           Network.HTTP.Types
@@ -86,7 +87,12 @@ import           Servant.Client.Core.BasicAuth
 import           Servant.Client.Core.ClientError
 import           Servant.Client.Core.Request
 import           Servant.Client.Core.Response
+import           Servant.Client.Core.MultiVerb.ResponseUnrender
+import qualified Servant.Client.Core.Response as Response
 import           Servant.Client.Core.RunClient
+import           Servant.API.MultiVerb
+import qualified Network.HTTP.Media as M
+import           Data.Typeable
 
 -- * Accessing APIs as a Client
 
@@ -108,7 +114,6 @@ import           Servant.Client.Core.RunClient
 clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api
 clientIn p pm = clientWithRoute pm p defaultRequest
 
-
 -- | This class lets us define how each API combinator influences the creation
 -- of an HTTP request.
 --
@@ -125,7 +130,6 @@ class RunClient m => HasClient m api where
     -> Client mon api
     -> Client mon' api
 
-
 -- | A client querying function for @a ':<|>' b@ will actually hand you
 --   one function for querying @a@ and another one for querying @b@,
 --   stitching them together with ':<|>', which really is just like a pair.
@@ -322,7 +326,7 @@ data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch
   deriving (Eq, Show)
 
 class UnrenderResponse (cts :: [Type]) (a :: Type) where
-  unrenderResponse :: Seq.Seq H.Header -> BL.ByteString -> Proxy cts
+  unrenderResponse :: Seq.Seq H.Header -> BSL.ByteString -> Proxy cts
                    -> [Either (MediaType, String) a]
 
 instance {-# OVERLAPPABLE #-} AllMimeUnrender cts a => UnrenderResponse cts a where
@@ -364,15 +368,13 @@ instance {-# OVERLAPPING #-}
 
         method = reflectMethod $ Proxy @method
         acceptStatus = statuses (Proxy @as)
-    response <- runRequestAcceptStatus (Just acceptStatus) request {requestMethod = method, requestAccept = accept}
+    response@Response{responseBody=body, responseStatusCode=status, responseHeaders=headers}
+      <- runRequestAcceptStatus (Just acceptStatus) (request {requestMethod = method, requestAccept = accept})
     responseContentType <- checkContentTypeHeader response
     unless (any (matches responseContentType) accept) $ do
       throwClientError $ UnsupportedContentType responseContentType response
 
-    let status = responseStatusCode response
-        body = responseBody response
-        headers = responseHeaders response
-        res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) headers body
+    let res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) headers body
     case res of
       Left errors -> throwClientError $ DecodeFailure (T.pack (show errors)) response
       Right x -> return x
@@ -396,7 +398,7 @@ instance {-# OVERLAPPING #-}
         All (UnrenderResponse cts) xs =>
         Proxy cts ->
         Seq.Seq H.Header ->
-        BL.ByteString ->
+        BSL.ByteString ->
         NP ([] :.: Either (MediaType, String)) xs
       mimeUnrenders ctp headers body = cpure_NP
         (Proxy @(UnrenderResponse cts))
@@ -413,10 +415,10 @@ instance {-# OVERLAPPABLE #-}
 
   hoistClientMonad _ _ f ma = f ma
 
-  clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do
-      let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
+  clientWithRoute _pm Proxy req = withStreamingRequest req' $ \Response{responseBody=body} -> do
+      let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BSL.ByteString -> Either String chunk
           framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
-      fromSourceIO $ framingUnrender' $ responseBody gres
+      fromSourceIO $ framingUnrender' body
     where
       req' = req
           { requestAccept = fromList [contentType (Proxy :: Proxy ct)]
@@ -433,13 +435,14 @@ instance {-# OVERLAPPING #-}
 
   hoistClientMonad _ _ f ma = f ma
 
-  clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do
-      let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
+  clientWithRoute _pm Proxy req = withStreamingRequest req' $ 
+    \Response{responseBody=body, responseHeaders=headers} -> do
+      let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BSL.ByteString -> Either String chunk
           framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
-      val <- fromSourceIO $ framingUnrender' $ responseBody gres
+      val <- fromSourceIO $ framingUnrender' body
       return $ Headers
         { getResponse = val
-        , getHeadersHList = buildHeadersTo . toList $ responseHeaders gres
+        , getHeadersHList = buildHeadersTo $ toList headers
         }
 
     where
@@ -757,7 +760,7 @@ instance
 
         sourceIO = framingRender
             framingP
-            (mimeRender ctypeP :: chunk -> BL.ByteString)
+            (mimeRender ctypeP :: chunk -> BSL.ByteString)
             (toSourceIO body)
 
 -- | Make the querying function append @path@ to the request path.
@@ -862,7 +865,6 @@ data AsClientT (m :: Type -> Type)
 instance GenericMode (AsClientT m) where
     type AsClientT m :- api = Client m api
 
-
 type GClientConstraints api m =
   ( GenericServant api (AsClientT m)
   , Client m (ToServantApi api) ~ ToServant api (AsClientT m)
@@ -972,6 +974,52 @@ x // f = f x
 (/:) :: (a -> b -> c) -> b -> a -> c
 (/:) = flip
 
+instance
+  ( ResponseListUnrender cs as,
+    AllMime cs,
+    ReflectMethod method,
+    AsUnion as r,
+    RunClient m
+  ) =>
+  HasClient m (MultiVerb method cs as r)
+  where
+  type Client m (MultiVerb method cs as r) = m r
+
+  clientWithRoute _ _ req = do
+    response@Response{responseBody=body} <-
+      runRequestAcceptStatus
+        (Just (responseListStatuses @cs @as))
+        req
+          { requestMethod = method,
+            requestAccept = Seq.fromList accept
+          }
+
+    c <- getResponseContentType response
+    unless (any (M.matches c) accept) $ do
+      throwClientError $ UnsupportedContentType c response
+
+    -- NOTE: support streaming in the future
+    let sresp =
+          if BSL.null body
+            then SomeClientResponse $ response {Response.responseBody = ()}
+            else SomeClientResponse response
+    case responseListUnrender @cs @as c sresp of
+      StatusMismatch -> throwClientError (DecodeFailure "Status mismatch" response)
+      UnrenderError e -> throwClientError (DecodeFailure (Text.pack e) response)
+      UnrenderSuccess x -> pure (fromUnion @as x)
+    where
+      accept = allMime (Proxy @cs)
+      method = reflectMethod (Proxy @method)
+
+  hoistClientMonad _ _ f = f
+
+getResponseContentType :: (RunClient m) => Response -> m M.MediaType
+getResponseContentType response =
+  case lookup "Content-Type" (toList (responseHeaders response)) of
+    Nothing -> pure $ "application" M.// "octet-stream"
+    Just t -> case M.parseAccept t of
+      Nothing -> throwClientError $ InvalidContentTypeHeader response
+      Just t' -> pure t'
 
 {- Note [Non-Empty Content Types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1003,11 +1051,11 @@ checkContentTypeHeader response =
 
 decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
   => Response -> Proxy ct -> m a
-decodedAs response ct = do
+decodedAs response@Response{responseBody=body} ct = do
   responseContentType <- checkContentTypeHeader response
   unless (any (matches responseContentType) accept) $
     throwClientError $ UnsupportedContentType responseContentType response
-  case mimeUnrender ct $ responseBody response of
+  case mimeUnrender ct body of
     Left err -> throwClientError $ DecodeFailure (T.pack err) response
     Right val -> return val
   where
diff --git a/servant-client-core/src/Servant/Client/Core/MultiVerb/ResponseUnrender.hs b/servant-client-core/src/Servant/Client/Core/MultiVerb/ResponseUnrender.hs
new file mode 100644
index 000000000..1dcc9c933
--- /dev/null
+++ b/servant-client-core/src/Servant/Client/Core/MultiVerb/ResponseUnrender.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE ApplicativeDo #-}
+module Servant.Client.Core.MultiVerb.ResponseUnrender where
+
+import Control.Applicative
+import Control.Monad
+import Data.Kind (Type)
+import Data.SOP
+import Data.Typeable
+import GHC.TypeLits
+import Network.HTTP.Types.Status (Status)
+import qualified Data.ByteString.Lazy as BSL
+import qualified Network.HTTP.Media as M
+
+import Servant.API.ContentTypes
+import Servant.API.MultiVerb
+import Servant.API.Status
+import Servant.API.UVerb.Union (Union)
+import Servant.Client.Core.Response (ResponseF(..))
+import qualified Servant.Client.Core.Response as Response
+import Servant.API.Stream (SourceIO)
+import Data.ByteString (ByteString)
+
+data SomeClientResponse = forall a. Typeable a => SomeClientResponse (ResponseF a)
+
+fromSomeClientResponse 
+  :: forall a m. (Alternative m, Typeable a)
+  => SomeClientResponse
+  -> m (ResponseF a)
+fromSomeClientResponse (SomeClientResponse Response {..}) = do
+  body <- maybe empty pure $ cast @_ @a responseBody
+  pure $
+    Response
+      { responseBody = body,
+        ..
+      }
+
+class ResponseUnrender cs a where
+  type ResponseBody a :: Type
+  type ResponseStatus a :: Nat
+  responseUnrender
+    :: M.MediaType
+    -> ResponseF (ResponseBody a)
+    -> UnrenderResult (ResponseType a)
+
+class (Typeable as) => ResponseListUnrender cs as where
+  responseListUnrender
+    :: M.MediaType
+    -> SomeClientResponse
+    -> UnrenderResult (Union (ResponseTypes as))
+
+  responseListStatuses :: [Status]
+
+instance ResponseListUnrender cs '[] where
+  responseListUnrender _ _ = StatusMismatch
+  responseListStatuses = []
+
+instance
+  ( Typeable a,
+    Typeable (ResponseBody a),
+    ResponseUnrender cs a,
+    ResponseListUnrender cs as,
+    KnownStatus (ResponseStatus a)
+  ) =>
+  ResponseListUnrender cs (a ': as)
+  where
+  responseListUnrender c output =
+    Z . I <$> (responseUnrender @cs @a c =<< fromSomeClientResponse output)
+      <|> S <$> responseListUnrender @cs @as c output
+
+  responseListStatuses = statusVal (Proxy @(ResponseStatus a)) : responseListStatuses @cs @as
+
+instance
+  ( KnownStatus s,
+    MimeUnrender ct a
+  ) =>
+  ResponseUnrender cs (RespondAs (ct :: Type) s desc a)
+  where
+  type ResponseStatus (RespondAs ct s desc a) = s
+  type ResponseBody (RespondAs ct s desc a) = BSL.ByteString
+
+  responseUnrender _ output = do
+    guard (responseStatusCode output == statusVal (Proxy @s))
+    either UnrenderError UnrenderSuccess $
+      mimeUnrender (Proxy @ct) (Response.responseBody output)
+
+instance (KnownStatus s) => ResponseUnrender cs (RespondAs '() s desc ()) where
+  type ResponseStatus (RespondAs '() s desc ()) = s
+  type ResponseBody (RespondAs '() s desc ()) = ()
+
+  responseUnrender _ output =
+    guard (responseStatusCode output == statusVal (Proxy @s))
+
+instance
+  (KnownStatus s) 
+  => ResponseUnrender cs (RespondStreaming s desc framing ct)
+  where
+  type ResponseStatus (RespondStreaming s desc framing ct) = s
+  type ResponseBody (RespondStreaming s desc framing ct) = SourceIO ByteString
+
+  responseUnrender _ resp = do
+    guard (Response.responseStatusCode resp == statusVal (Proxy @s))
+    pure $ Response.responseBody resp
+
+instance
+  (AllMimeUnrender cs a, KnownStatus s)
+  => ResponseUnrender cs (Respond s desc a) where
+  type ResponseStatus (Respond s desc a) = s
+  type ResponseBody (Respond s desc a) = BSL.ByteString
+
+  responseUnrender c output = do
+    guard (responseStatusCode output == statusVal (Proxy @s))
+    let results = allMimeUnrender (Proxy @cs)
+    case lookup c results of
+      Nothing -> empty
+      Just f -> either UnrenderError UnrenderSuccess (f (responseBody output))
+
+instance
+  ( AsHeaders xs (ResponseType r) a,
+    ServantHeaders hs xs,
+    ResponseUnrender cs r
+  ) =>
+  ResponseUnrender cs (WithHeaders hs a r)
+  where
+  type ResponseStatus (WithHeaders hs a r) = ResponseStatus r
+  type ResponseBody (WithHeaders hs a r) = ResponseBody r
+
+  responseUnrender c output = do
+    x <- responseUnrender @cs @r c output
+    case extractHeaders @hs (responseHeaders output) of
+      Nothing -> UnrenderError "Failed to parse headers"
+      Just hs -> pure $ fromHeaders @xs (hs, x)
diff --git a/servant-client-core/src/Servant/Client/Core/Response.hs b/servant-client-core/src/Servant/Client/Core/Response.hs
index 16ca0667a..8a0196050 100644
--- a/servant-client-core/src/Servant/Client/Core/Response.hs
+++ b/servant-client-core/src/Servant/Client/Core/Response.hs
@@ -1,17 +1,17 @@
 {-# LANGUAGE DeriveDataTypeable    #-}
-{-# LANGUAGE DeriveFoldable        #-}
-{-# LANGUAGE DeriveFunctor         #-}
 {-# LANGUAGE DeriveGeneric         #-}
 {-# LANGUAGE DeriveTraversable     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Servant.Client.Core.Response (
     Response,
     StreamingResponse,
     ResponseF (..),
+    responseToInternalResponse,
     ) where
 
 import           Prelude ()
@@ -31,6 +31,7 @@ import           Network.HTTP.Types
 
 import           Servant.API.Stream
                  (SourceIO)
+import           Servant.Types.Internal.ResponseList
 
 data ResponseF a = Response
   { responseStatusCode  :: Status
@@ -51,3 +52,7 @@ instance NFData a => NFData (ResponseF a) where
 
 type Response = ResponseF LBS.ByteString
 type StreamingResponse = ResponseF (SourceIO BS.ByteString)
+
+responseToInternalResponse :: ResponseF a -> InternalResponse a
+responseToInternalResponse Response{responseStatusCode, responseHeaders,responseBody} =
+    InternalResponse responseStatusCode responseHeaders responseBody
diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal
index fdb9ce2ec..22b9e7227 100644
--- a/servant-client/servant-client.cabal
+++ b/servant-client/servant-client.cabal
@@ -161,6 +161,7 @@ test-suite spec
     , servant-client
     , servant-client-core
     , sop-core
+    , generics-sop
     , stm
     , text
     , transformers
diff --git a/servant-client/test/Servant/ClientTestUtils.hs b/servant-client/test/Servant/ClientTestUtils.hs
index 1d6b57b19..dbde8c193 100644
--- a/servant-client/test/Servant/ClientTestUtils.hs
+++ b/servant-client/test/Servant/ClientTestUtils.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP                   #-}
 {-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE DataKinds             #-}
 {-# LANGUAGE DeriveGeneric         #-}
@@ -16,6 +15,7 @@
 {-# OPTIONS_GHC -freduction-depth=100 #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+{-# LANGUAGE EmptyCase #-}
 
 module Servant.ClientTestUtils where
 
@@ -48,6 +48,7 @@ import           Data.Text.Encoding
                  (decodeUtf8, encodeUtf8)
 import           GHC.Generics
                  (Generic)
+import qualified Generics.SOP as GSOP
 import qualified Network.HTTP.Client              as C
 import qualified Network.HTTP.Types               as HTTP
 import           Network.Socket
@@ -75,6 +76,7 @@ import qualified Servant.Client.Core.Auth         as Auth
 import           Servant.Server
 import           Servant.Server.Experimental.Auth
 import           Servant.Test.ComprehensiveAPI
+import           Servant.API.MultiVerb
 
 -- This declaration simply checks that all instances are in place.
 _ = client comprehensiveAPIWithoutStreaming
@@ -119,7 +121,7 @@ data RecordRoutes mode = RecordRoutes
   , otherRoutes :: mode :- "other" :> Capture "someParam" Int :> NamedRoutes OtherRoutes
   } deriving Generic
 
-data OtherRoutes mode = OtherRoutes
+newtype OtherRoutes mode = OtherRoutes
   { something :: mode :- "something" :> Get '[JSON] [String]
   } deriving Generic
 
@@ -145,6 +147,36 @@ instance ToDeepQuery Filter where
     , (["name"], Just (Text.pack name'))
     ]
 
+-----------------------------
+-- MultiVerb test endpoint --
+-----------------------------
+
+-- This is the list of all possible responses
+type MultipleChoicesIntResponses = 
+  '[ RespondEmpty 400 "Negative"
+   , Respond 200 "Even number" Bool
+   , Respond 200 "Odd number" Int
+   ]
+
+data MultipleChoicesIntResult
+  = NegativeNumber
+  | Even Bool
+  | Odd Int
+  deriving stock (Generic)
+  deriving (AsUnion MultipleChoicesIntResponses)
+    via GenericAsUnion MultipleChoicesIntResponses MultipleChoicesIntResult
+
+instance GSOP.Generic MultipleChoicesIntResult
+
+-- This is our endpoint description
+type MultipleChoicesInt =
+  Capture "int" Int
+  :> MultiVerb
+    'GET
+    '[JSON]
+    MultipleChoicesIntResponses
+    MultipleChoicesIntResult
+
 type Api =
   Get '[JSON] Person
   :<|> "get" :> Get '[JSON] Person
@@ -187,6 +219,7 @@ type Api =
                                       WithStatus 301 Text]
   :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]
   :<|> NamedRoutes RecordRoutes
+  :<|> "multiple-choices-int" :> MultipleChoicesInt
   :<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text
 
 api :: Proxy Api
@@ -221,6 +254,8 @@ uverbGetSuccessOrRedirect :: Bool
                                               WithStatus 301 Text])
 uverbGetCreated :: ClientM (Union '[WithStatus 201 Person])
 recordRoutes :: RecordRoutes (AsClientT ClientM)
+multiChoicesInt :: Int -> ClientM MultipleChoicesIntResult
+captureVerbatim :: Verbatim -> ClientM Text
 
 getRoot
   :<|> getGet
@@ -249,6 +284,7 @@ getRoot
   :<|> uverbGetSuccessOrRedirect
   :<|> uverbGetCreated
   :<|> recordRoutes
+  :<|> multiChoicesInt
   :<|> captureVerbatim = client api
 
 server :: Application
@@ -282,15 +318,15 @@ server = serve api (
                                    }
        )
   :<|> return alice
-  :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
-  :<|> (Tagged $ \ request respond -> (respond $ Wai.responseLBS HTTP.ok200 (Wai.requestHeaders $ request) "rawSuccess"))
-  :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")
+  :<|> Tagged (\ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
+  :<|> Tagged (\ request respond -> respond $ Wai.responseLBS HTTP.ok200 (Wai.requestHeaders request) "rawSuccess")
+  :<|> Tagged (\ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")
   :<|> (\ a b c d -> return (a, b, c, d))
-  :<|> (return $ addHeader 1729 $ addHeader "eg2" True)
+  :<|> return (addHeader 1729 $ addHeader "eg2" True)
   :<|> (pure . Z . I . WithStatus $ addHeader 1729 $ addHeader "eg2" True)
-  :<|> (return $ addHeader "cookie1" $ addHeader "cookie2" True)
+  :<|> return (addHeader "cookie1" $ addHeader "cookie2" True)
   :<|> return NoContent
-  :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.found302 [("Location", "testlocation"), ("Set-Cookie", "testcookie=test")] "")
+  :<|> Tagged (\ _request respond -> respond $ Wai.responseLBS HTTP.found302 [("Location", "testlocation"), ("Set-Cookie", "testcookie=test")] "")
   :<|> emptyServer
   :<|> (\shouldRedirect -> if shouldRedirect
                               then respond (WithStatus @301 ("redirecting" :: Text))
@@ -303,6 +339,15 @@ server = serve api (
              { something = pure ["foo", "bar", "pweet"]
              }
          }
+  :<|> (\param -> 
+          if param < 0 
+          then pure NegativeNumber
+          else
+            if even param 
+            then pure $ Odd 3
+            else pure $ Even True
+            )
+    
   :<|> pure . decodeUtf8 . unVerbatim
   )
 
@@ -318,10 +363,10 @@ failApi = Proxy
 
 failServer :: Application
 failServer = serve failApi (
-       (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "")
+       Tagged (\ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "")
   :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
-  :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
-  :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
+  :<|> Tagged (\_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
+  :<|> Tagged (\_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")
   )
 
 -- * basic auth stuff
diff --git a/servant-client/test/Servant/MiddlewareSpec.hs b/servant-client/test/Servant/MiddlewareSpec.hs
index 648ca1311..9b7c2a943 100644
--- a/servant-client/test/Servant/MiddlewareSpec.hs
+++ b/servant-client/test/Servant/MiddlewareSpec.hs
@@ -16,9 +16,7 @@
 
 module Servant.MiddlewareSpec (spec) where
 
-import Control.Arrow
-  ( left,
-  )
+import Control.Arrow (left)
 import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)
 import Control.Exception (Exception, throwIO, try)
 import Control.Monad.IO.Class
@@ -114,4 +112,4 @@ spec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
     left show <$> runClientWithMiddleware getGet mid baseUrl `shouldReturn` Right alice
 
     ref <- readIORef ref
-    ref `shouldBe` ["req1", "req2", "req3", "resp3", "resp2", "resp1"]
\ No newline at end of file
+    ref `shouldBe` ["req1", "req2", "req3", "resp3", "resp2", "resp1"]
diff --git a/servant-server/servant-server.cabal b/servant-server/servant-server.cabal
index 441022e1d..fd0bc41f5 100644
--- a/servant-server/servant-server.cabal
+++ b/servant-server/servant-server.cabal
@@ -101,8 +101,9 @@ library
     Servant.Server.Internal.DelayedIO
     Servant.Server.Internal.ErrorFormatter
     Servant.Server.Internal.Handler
-    Servant.Server.Internal.Router
+    Servant.Server.Internal.ResponseRender
     Servant.Server.Internal.RouteResult
+    Servant.Server.Internal.Router
     Servant.Server.Internal.RoutingApplication
     Servant.Server.Internal.ServerError
     Servant.Server.StaticFiles
diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs
index a2818d18b..a8e0e5834 100644
--- a/servant-server/src/Servant/Server/Internal.hs
+++ b/servant-server/src/Servant/Server/Internal.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE EmptyCase #-}
 
 module Servant.Server.Internal
   ( module Servant.Server.Internal
@@ -42,7 +43,7 @@ import           GHC.Generics
 import           GHC.TypeLits (KnownNat, KnownSymbol, TypeError, ErrorMessage (..),  symbolVal)
 import qualified Network.HTTP.Media                         as NHM
 import           Network.HTTP.Types                         hiding
-                 (Header, ResponseHeaders)
+                 (statusCode, Header, ResponseHeaders)
 import           Network.Socket
                  (SockAddr)
 import           Network.Wai
@@ -87,7 +88,8 @@ import           Servant.Server.Internal.Router
 import           Servant.Server.Internal.RouteResult
 import           Servant.Server.Internal.RoutingApplication
 import           Servant.Server.Internal.ServerError
-
+import           Servant.Server.Internal.ResponseRender
+import           Servant.API.MultiVerb
 import           Servant.API.TypeLevel (AtMostOneFragment, FragmentUnique)
 
 class HasServer api context where
@@ -1121,3 +1123,47 @@ instance
             toServant server
           servantSrvN :: ServerT (ToServantApi api) n =
             hoistServerWithContext (Proxy @(ToServantApi api)) pctx nat servantSrvM
+
+
+instance
+  ( HasAcceptCheck cs,
+    ResponseListRender cs as,
+    AsUnion as r,
+    ReflectMethod method
+  ) =>
+  HasServer (MultiVerb method cs as r) ctx
+  where
+  type ServerT (MultiVerb method cs as r) m = m r
+
+  hoistServerWithContext _ _ f = f
+
+  route ::
+    forall env.
+    Proxy (MultiVerb method cs as r) ->
+    Context ctx ->
+    Delayed env (Handler r) ->
+    Router env
+  route _ _ action = leafRouter $ \env req k -> do
+    let acc = getAcceptHeader req
+        action' =
+          action
+            `addMethodCheck` methodCheck method req
+            `addAcceptCheck` acceptCheck' (Proxy @cs) acc
+    runAction action' env req k $ \output -> do
+      let mresp = responseListRender @cs @as acc (toUnion @as output)
+      someResponseToWai <$> case mresp of
+        Nothing -> FailFatal err406
+        Just resp
+          | allowedMethodHead method req -> pure (setEmptyBody resp)
+          | otherwise -> pure resp
+    where
+      method = reflectMethod (Proxy @method)
+
+class HasAcceptCheck cs where
+  acceptCheck' :: Proxy cs -> AcceptHeader -> DelayedIO ()
+
+instance (AllMime cs) => HasAcceptCheck cs where
+  acceptCheck' = acceptCheck
+
+instance HasAcceptCheck '() where
+  acceptCheck' _ _ = pure ()
diff --git a/servant-server/src/Servant/Server/Internal/Context.hs b/servant-server/src/Servant/Server/Internal/Context.hs
index c9b584c96..8f275877f 100644
--- a/servant-server/src/Servant/Server/Internal/Context.hs
+++ b/servant-server/src/Servant/Server/Internal/Context.hs
@@ -2,18 +2,22 @@
 {-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE GADTs                 #-}
-{-# LANGUAGE KindSignatures        #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
 {-# LANGUAGE TypeOperators         #-}
 
-module Servant.Server.Internal.Context where
+module Servant.Server.Internal.Context
+  ( module Servant.Server.Internal.Context
+  , module Servant.API.TypeLevel.List
+  ) where
 
-import           Data.Kind
+import           Data.Kind 
                  (Type)
 import           Data.Proxy
 import           GHC.TypeLits
+import           Servant.API.TypeLevel.List
+                 (type (.++))
 
 -- | 'Context's are used to pass values to combinators. (They are __not__ meant
 -- to be used to pass parameters to your handlers, i.e. they should not replace
@@ -48,15 +52,6 @@ instance Eq (Context '[]) where
 instance (Eq a, Eq (Context as)) => Eq (Context (a ': as)) where
     x1 :. y1 == x2 :. y2 = x1 == x2 && y1 == y2
 
--- | Append two type-level lists.
---
--- Hint: import it as
---
--- > import Servant.Server (type (.++))
-type family (.++) (l1 :: [Type]) (l2 :: [Type]) where
-  '[] .++ a = a
-  (a ': as) .++ b = a ': (as .++ b)
-
 -- | Append two contexts.
 (.++) :: Context l1 -> Context l2 -> Context (l1 .++ l2)
 EmptyContext .++ a = a
@@ -92,7 +87,7 @@ instance {-# OVERLAPPING #-}
 -- to have multiple values of the same type in your 'Context' and need to access
 -- them, we provide 'NamedContext'. You can think of it as sub-namespaces for
 -- 'Context's.
-data NamedContext (name :: Symbol) (subContext :: [Type])
+newtype NamedContext (name :: Symbol) (subContext :: [Type])
   = NamedContext (Context subContext)
 
 -- | 'descendIntoNamedContext' allows you to access `NamedContext's. Usually you
diff --git a/servant-server/src/Servant/Server/Internal/ResponseRender.hs b/servant-server/src/Servant/Server/Internal/ResponseRender.hs
new file mode 100644
index 000000000..2d428e2eb
--- /dev/null
+++ b/servant-server/src/Servant/Server/Internal/ResponseRender.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE EmptyCase #-}
+
+module Servant.Server.Internal.ResponseRender where
+
+import Data.ByteString (ByteString)
+import Data.Kind (Type)
+import Data.Typeable
+import GHC.TypeLits
+import qualified Data.ByteString.Lazy as BSL
+import qualified Network.Wai as Wai
+import Network.HTTP.Types (Status, hContentType)
+import Data.SOP
+import qualified Servant.Types.SourceT                      as S
+import qualified Data.ByteString.Builder                    as BB
+import qualified Data.Sequence as Seq 
+
+import Servant.API.ContentTypes (AcceptHeader (..), AllMimeRender, MimeRender, Accept, allMimeRender, mimeRender, contentType)
+import Servant.API.MultiVerb
+import Servant.API.Status
+import Servant.API.Stream (SourceIO)
+import Servant.API.UVerb.Union
+import Servant.Types.Internal.ResponseList
+import qualified Network.HTTP.Media as M
+import Data.Foldable (toList)
+import Data.Sequence ((<|))
+
+class (Typeable a) => IsWaiBody a where
+  responseToWai :: InternalResponse a -> Wai.Response
+
+instance IsWaiBody BSL.ByteString where
+  responseToWai r =
+    Wai.responseLBS
+      (statusCode r)
+      (toList (headers r))
+      (responseBody r)
+
+instance IsWaiBody () where
+  responseToWai r =
+    Wai.responseLBS
+      (statusCode r)
+      (toList (headers r))
+      mempty
+
+instance IsWaiBody (SourceIO ByteString) where
+  responseToWai r =
+    Wai.responseStream
+      (statusCode r)
+      (toList (headers r))
+      $ \output flush -> do
+        S.foreach
+          (const (pure ()))
+          (\chunk -> output (BB.byteString chunk) *> flush)
+          (responseBody r)
+
+data SomeResponse = forall a. (IsWaiBody a) => SomeResponse (InternalResponse a)
+
+class ResponseListRender cs as where
+  responseListRender
+    :: AcceptHeader
+    -> Union (ResponseTypes as)
+    -> Maybe SomeResponse
+  responseListStatuses :: [Status]
+
+instance ResponseListRender cs '[] where
+  responseListRender _ x = case x of {}
+  responseListStatuses = []
+
+class (IsWaiBody (ResponseBody a)) => ResponseRender cs a where
+  type ResponseStatus a :: Nat
+  type ResponseBody a :: Type
+  responseRender
+    :: AcceptHeader
+    -> ResponseType a
+    -> Maybe (InternalResponse (ResponseBody a))
+
+instance
+  ( ResponseRender cs a,
+    ResponseListRender cs as,
+    KnownStatus (ResponseStatus a)
+  ) =>
+  ResponseListRender cs (a ': as)
+  where
+  responseListRender acc (Z (I x)) = fmap SomeResponse (responseRender @cs @a acc x)
+  responseListRender acc (S x) = responseListRender @cs @as acc x
+
+  responseListStatuses = statusVal (Proxy @(ResponseStatus a)) : responseListStatuses @cs @as
+
+instance
+  ( AsHeaders xs (ResponseType r) a,
+    ServantHeaders hs xs,
+    ResponseRender cs r
+  ) =>
+  ResponseRender cs (WithHeaders hs a r)
+  where
+  type ResponseStatus (WithHeaders hs a r) = ResponseStatus r
+  type ResponseBody (WithHeaders hs a r) = ResponseBody r
+
+  responseRender acc x = addHeaders <$> responseRender @cs @r acc y
+    where
+      (hs, y) = toHeaders @xs x
+      addHeaders r =
+        r
+          { headers = headers r <> Seq.fromList (constructHeaders @hs hs)
+          }
+
+instance
+  ( KnownStatus s,
+    MimeRender ct a
+  ) =>
+  ResponseRender cs (RespondAs (ct :: Type) s desc a)
+  where
+  type ResponseStatus (RespondAs ct s desc a) = s
+  type ResponseBody (RespondAs ct s desc a) = BSL.ByteString
+
+  responseRender _ x =
+    pure . addContentType @ct $
+      InternalResponse
+        { statusCode = statusVal (Proxy @s),
+          responseBody = mimeRender (Proxy @ct) x,
+          headers = mempty
+        }
+
+instance (KnownStatus s) => ResponseRender cs (RespondAs '() s desc ()) where
+  type ResponseStatus (RespondAs '() s desc ()) = s
+  type ResponseBody (RespondAs '() s desc ()) = ()
+
+  responseRender _ _ =
+    pure $
+      InternalResponse
+        { statusCode = statusVal (Proxy @s),
+          responseBody = (),
+          headers = mempty
+        }
+
+instance
+  (Accept ct, KnownStatus s)
+  => ResponseRender cs (RespondStreaming s desc framing ct)
+  where
+  type ResponseStatus (RespondStreaming s desc framing ct) = s
+  type ResponseBody (RespondStreaming s desc framing ct) = SourceIO ByteString 
+  responseRender _ x =
+    pure . addContentType @ct $
+      InternalResponse
+        { statusCode = statusVal (Proxy @s),
+          responseBody = x,
+          headers = mempty
+        }
+
+instance
+  (AllMimeRender cs a, KnownStatus s)
+  => ResponseRender cs (Respond s desc a) where
+  type ResponseStatus (Respond s desc a) = s
+  type ResponseBody (Respond s desc a) = BSL.ByteString
+
+  -- Note: here it seems like we are rendering for all possible content types,
+  -- only to choose the correct one afterwards. However, render results besides the
+  -- one picked by 'M.mapAcceptMedia' are not evaluated, and therefore nor are the
+  -- corresponding rendering functions.
+  responseRender (AcceptHeader acc) x =
+    M.mapAcceptMedia (map (uncurry mkRenderOutput) (allMimeRender (Proxy @cs) x)) acc
+    where
+      mkRenderOutput :: M.MediaType -> BSL.ByteString -> (M.MediaType, InternalResponse BSL.ByteString)
+      mkRenderOutput c body =
+        (c,) . addContentType' c $
+          InternalResponse
+            { statusCode = statusVal (Proxy @s),
+              responseBody = body,
+              headers = mempty
+            }
+
+addContentType :: forall ct a. (Accept ct) => InternalResponse a -> InternalResponse a
+addContentType = addContentType' (contentType (Proxy @ct))
+
+addContentType' :: M.MediaType -> InternalResponse a -> InternalResponse a
+addContentType' c r = r {headers = (hContentType, M.renderHeader c) <| headers r}
+
+setEmptyBody :: SomeResponse -> SomeResponse
+setEmptyBody (SomeResponse r) = SomeResponse (go r)
+  where
+    go :: InternalResponse a -> InternalResponse BSL.ByteString
+    go InternalResponse {..} = InternalResponse {responseBody = mempty, ..}
+
+someResponseToWai :: SomeResponse -> Wai.Response
+someResponseToWai (SomeResponse r) = responseToWai r
diff --git a/servant/servant.cabal b/servant/servant.cabal
index e8d28d0b2..e2300a56e 100644
--- a/servant/servant.cabal
+++ b/servant/servant.cabal
@@ -104,7 +104,9 @@ library
     Servant.API.Sub
     Servant.API.TypeErrors
     Servant.API.TypeLevel
+    Servant.API.TypeLevel.List
     Servant.API.UVerb
+    Servant.API.MultiVerb
     Servant.API.UVerb.Union
     Servant.API.Vault
     Servant.API.Verbs
@@ -112,7 +114,9 @@ library
     Servant.API.WithResource
 
   -- Types
-  exposed-modules: Servant.Types.SourceT
+  exposed-modules:
+    Servant.Types.SourceT
+    Servant.Types.Internal.ResponseList
 
   -- Test stuff
   exposed-modules: Servant.Test.ComprehensiveAPI
@@ -131,6 +135,7 @@ library
     , containers    >=0.6.5.1  && <0.8
     , mtl           ^>=2.2.2   || ^>=2.3.1
     , sop-core      >=0.4.0.0  && <0.6
+    , generics-sop  ^>=0.5.1
     , text          >=1.2.3.0  && <2.2
     , transformers  >=0.5.2.0  && <0.7
 
diff --git a/servant/src/Servant/API/Alternative.hs b/servant/src/Servant/API/Alternative.hs
index f6b0f4df4..052469ad9 100644
--- a/servant/src/Servant/API/Alternative.hs
+++ b/servant/src/Servant/API/Alternative.hs
@@ -27,7 +27,7 @@ import           Data.Typeable
 --        :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] () -- POST /books
 -- :}
 data a :<|> b = a :<|> b
-    deriving (Typeable, Eq, Show, Functor, Traversable, Foldable, Bounded)
+    deriving stock (Typeable, Eq, Show, Functor, Traversable, Foldable, Bounded)
 infixr 3 :<|>
 
 instance (Semigroup a, Semigroup b) => Semigroup (a :<|> b) where
@@ -35,7 +35,6 @@ instance (Semigroup a, Semigroup b) => Semigroup (a :<|> b) where
 
 instance (Monoid a, Monoid b) => Monoid (a :<|> b) where
     mempty = mempty :<|> mempty
-    (a :<|> b) `mappend` (a' :<|> b') = (a `mappend` a') :<|> (b `mappend` b')
 
 instance Bifoldable (:<|>) where
     bifoldMap f g ~(a :<|> b) = f a `mappend` g b
diff --git a/servant/src/Servant/API/MultiVerb.hs b/servant/src/Servant/API/MultiVerb.hs
new file mode 100644
index 000000000..96aa8978c
--- /dev/null
+++ b/servant/src/Servant/API/MultiVerb.hs
@@ -0,0 +1,488 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE EmptyCase #-}
+
+-- | MultiVerb is a part of the type-level eDSL that allows you to express complex routes
+-- while retaining a high level of precision with good ergonomics.
+
+module Servant.API.MultiVerb
+  ( -- ** MultiVerb types
+    MultiVerb,
+    MultiVerb1,
+    -- ** Response types
+    Respond,
+    RespondAs,
+    RespondEmpty,
+    RespondStreaming,
+    -- ** Headers
+    WithHeaders,
+    DescHeader,
+    OptHeader,
+    AsHeaders (..),
+    ServantHeaders(..),
+    ServantHeader(..),
+    -- ** Unions of responses
+    AsUnion (..),
+    eitherToUnion,
+    eitherFromUnion,
+    maybeToUnion,
+    maybeFromUnion,
+    -- ** Internal machinery
+    AsConstructor (..),
+    GenericAsConstructor (..),
+    GenericAsUnion (..),
+    ResponseType,
+    ResponseTypes,
+    UnrenderResult(..),
+  ) where
+
+
+import Control.Applicative (Alternative(..), empty)
+import Control.Monad (ap, MonadPlus(..))
+import Data.ByteString (ByteString)
+import Data.Kind
+import Data.Proxy
+import Data.SOP
+import Data.Sequence (Seq(..))
+import GHC.TypeLits
+import Generics.SOP as GSOP
+import Network.HTTP.Types as HTTP
+import Web.HttpApiData (FromHttpApiData, ToHttpApiData, parseHeader, toHeader)
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Sequence as Seq
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+
+import Servant.API.TypeLevel.List
+import Servant.API.Stream (SourceIO)
+import Servant.API.UVerb.Union (Union)
+import Servant.API.Header (Header')
+
+-- | A type to describe a 'MultiVerb' response.
+--
+-- Includes status code, description, and return type. The content type of the
+-- response is determined dynamically using the accept header and the list of
+-- supported content types specified in the containing 'MultiVerb' type.
+data Respond (s :: Nat) (description :: Symbol) (a :: Type)
+
+-- | A type to describe a 'MultiVerb' response with a fixed content type.
+--
+-- Similar to 'Respond', but hardcodes the content type to be used for
+-- generating the response. This content type is distinct from the one
+-- given to 'MultiVerb', as it dictactes the response's content type, not the
+-- content type request that is to be accepted.
+data RespondAs responseContentType (s :: Nat) (description :: Symbol) (a :: Type)
+
+-- | A type to describe a 'MultiVerb' response with an empty body.
+--
+-- Includes status code and description.
+type RespondEmpty s description = RespondAs '() s description ()
+
+-- | A type to describe a streaming 'MultiVerb' response.
+--
+-- Includes status code, description, framing strategy and content type. Note
+-- that the handler return type is hardcoded to be 'SourceIO ByteString'.
+data RespondStreaming (s :: Nat) (description :: Symbol) (framing :: Type) (ct :: Type)
+
+-- | The result of parsing a response as a union alternative of type 'a'.
+--
+-- 'StatusMismatch' indicates that the response does not refer to the given
+-- alternative, because the status code does not match the one produced by that
+-- alternative.
+--
+-- 'UnrenderError' and 'UnrenderSuccess' represent respectively a failing and
+-- successful parse of the response body as a value of type 'a'.
+--
+-- The 'UnrenderResult' type constructor has monad and alternative instances
+-- corresponding to those of 'Either (Maybe (Last String)) a'.
+data UnrenderResult a = StatusMismatch | UnrenderError String | UnrenderSuccess a
+  deriving (Eq, Show, Functor)
+
+instance Applicative UnrenderResult where
+  pure = UnrenderSuccess
+  (<*>) = ap
+
+instance Monad UnrenderResult where
+  return = pure
+  StatusMismatch >>= _ = StatusMismatch
+  UnrenderError e >>= _ = UnrenderError e
+  UnrenderSuccess x >>= f = f x
+
+instance Alternative UnrenderResult where
+  empty = mzero
+  (<|>) = mplus
+
+instance MonadPlus UnrenderResult where
+  mzero = StatusMismatch
+  mplus StatusMismatch m = m
+  mplus (UnrenderError e) StatusMismatch = UnrenderError e
+  mplus (UnrenderError _) m = m
+  mplus m@(UnrenderSuccess _) _ = m
+
+type family ResponseType a :: Type
+
+type instance ResponseType (Respond s description a) = a
+
+type instance ResponseType (RespondAs responseContentType s description a) = a
+
+type instance ResponseType (RespondStreaming s description framing ct) = SourceIO ByteString
+
+
+-- | This type adds response headers to a 'MultiVerb' response.
+data WithHeaders (headers :: [Type]) (returnType :: Type) (response :: Type)
+
+-- | This is used to convert a response containing headers to a custom type
+-- including the information in the headers.
+class AsHeaders xs a b where
+  fromHeaders :: (NP I xs, a) -> b
+  toHeaders :: b -> (NP I xs, a)
+
+-- | Single-header empty response
+instance AsHeaders '[a] () a where
+  toHeaders a = (I a :* Nil, ())
+  fromHeaders = unI . hd . fst
+
+-- | Single-header non-empty response, return value is a tuple of the response and the header
+instance AsHeaders '[h] a (a, h) where
+  toHeaders (t, cc) = (I cc :* Nil, t)
+  fromHeaders (I cc :* Nil, t) = (t, cc)
+
+data DescHeader (name :: Symbol) (description :: Symbol) (a :: Type)
+
+-- | A wrapper to turn a response header into an optional one.
+data OptHeader h
+
+class ServantHeaders headers xs | headers -> xs where
+  constructHeaders :: NP I xs -> [HTTP.Header]
+  extractHeaders :: Seq HTTP.Header -> Maybe (NP I xs)
+
+instance ServantHeaders '[] '[] where
+  constructHeaders Nil = []
+  extractHeaders _ = Just Nil
+
+headerName :: forall name. (KnownSymbol name) => HTTP.HeaderName
+headerName =
+  CI.mk
+    . Text.encodeUtf8
+    . Text.pack
+    $ symbolVal (Proxy @name)
+
+instance
+  ( KnownSymbol name,
+    ServantHeader h name x,
+    FromHttpApiData x,
+    ServantHeaders headers xs
+  ) =>
+  ServantHeaders (h ': headers) (x ': xs)
+  where
+  constructHeaders (I x :* xs) =
+    constructHeader @h x
+      <> constructHeaders @headers xs
+
+  -- NOTE: should we concatenate all the matching headers instead of just taking the first one?
+  extractHeaders headers = do
+    let name' = headerName @name
+        (headers0, headers1) = Seq.partition (\(h, _) -> h == name') headers
+    x <- case headers0 of
+      Seq.Empty -> empty
+      ((_, h) :<| _) -> either (const empty) pure (parseHeader h)
+    xs <- extractHeaders @headers headers1
+    pure (I x :* xs)
+
+class ServantHeader h (name :: Symbol) x | h -> name x where
+  constructHeader :: x -> [HTTP.Header]
+
+instance
+  (KnownSymbol name, ToHttpApiData x) =>
+  ServantHeader (Header' mods name x) name x
+  where
+  constructHeader x = [(headerName @name, toHeader x)]
+
+instance
+  (KnownSymbol name, ToHttpApiData x) =>
+  ServantHeader (DescHeader name description x) name x
+  where
+  constructHeader x = [(headerName @name, toHeader x)]
+
+instance (ServantHeader h name x) => ServantHeader (OptHeader h) name (Maybe x) where
+  constructHeader = foldMap (constructHeader @h)
+
+type instance ResponseType (WithHeaders headers returnType response) = returnType
+
+
+type family ResponseTypes (as :: [Type]) where
+  ResponseTypes '[] = '[]
+  ResponseTypes (a ': as) = ResponseType a ': ResponseTypes as
+
+
+-- | 'MultiVerb' produces an endpoint which can return
+-- multiple values with various content types and status codes. It is similar to
+-- 'Servant.API.UVerb.UVerb' and behaves similarly, but it has some important differences:
+--
+--  * Descriptions and statuses can be attached to individual responses without
+--    using wrapper types and without affecting the handler return type.
+--  * The return type of the handler can be decoupled from the types of the
+--    individual responses. One can use a 'Union' type just like for 'Servant.API.UVerb.UVerb',
+--    but 'MultiVerb' also supports using an arbitrary type with an 'AsUnion'
+--    instance. Each response is responsible for their content type.
+--  * Headers can be attached to individual responses, also without affecting
+--    the handler return type.
+--
+-- ==== __Example__
+-- Let us create an endpoint that captures an 'Int' and has the following logic:
+--
+-- * If the number is negative, we return status code 400 and an empty body;
+-- * If the number is even, we return a 'Bool' in the response body;
+-- * If the number is odd, we return another 'Int' in the response body.
+--
+-- >  import qualified Generics.SOP as GSOP
+--
+-- > -- All possible HTTP responses
+-- > type Responses =
+-- >   '[ type RespondEmpty 400 "Negative"
+-- >    , type Respond 200 "Even number" Bool
+-- >    , type Respond 200 "Odd number" Int
+-- >    ]
+-- >
+-- > -- All possible return types
+-- > data Result
+-- >   = NegativeNumber
+-- >   | Odd Int
+-- >   | Even Bool
+-- >   deriving stock (Generic)
+-- >   deriving (AsUnion Responses)
+-- >     via GenericAsUnion Responses Result
+-- >
+-- > instance GSOP.Generic Result
+--
+-- These deriving statements above tie together the responses and the return values, and the order in which they are defined matters. For instance, if @Even@ and @Odd@ had switched places in the definition of @Result@, this would provoke an error:
+--
+--
+-- > • No instance for ‘AsConstructor
+-- >     ((:) @Type Int ('[] @Type)) (Respond 200 "Even number" Bool)’
+-- >         arising from the 'deriving' clause of a data type declaration
+--
+-- If you would prefer to write an intance of 'AsUnion' by yourself, read more in the typeclass' documentation.
+--
+-- Finally, let us write our endpoint description:
+--
+-- > type MultipleChoicesInt =
+-- >   Capture "int" Int
+-- >   :> MultiVerb
+-- >     'GET
+-- >     '[JSON]
+-- >     Responses
+-- >     Result
+data MultiVerb (method :: StdMethod) requestMimeTypes (as :: [Type]) (responses :: Type)
+
+-- | A 'MultiVerb' endpoint with a single response. Ideal to ensure that there can only be one response.
+type MultiVerb1 method requestMimeTypes a = MultiVerb method requestMimeTypes '[a] (ResponseType a)
+
+-- | This class is used to convert a handler return type to a union type
+-- including all possible responses of a 'MultiVerb' endpoint.
+--
+-- Any glue code necessary to convert application types to and from the
+-- canonical 'Union' type corresponding to a 'MultiVerb' endpoint should be
+-- packaged into an 'AsUnion' instance.
+--
+-- ==== __Example__
+-- Let us take the example endpoint from the 'MultiVerb' documentation. 
+-- There, we derived the 'AsUnion' instance with the help of Generics. 
+-- The manual way of implementing the instance is:
+--
+-- > instance AsUnion Responses Result where
+-- >   toUnion NegativeNumber = Z (I ())
+-- >   toUnion (Even b) = S (Z (I b))
+-- >   toUnion (Odd i) = S (S (Z (I i)))
+-- > 
+-- >   fromUnion       (Z (I ())) = NegativeNumber
+-- >   fromUnion    (S (Z (I b))) = Even b
+-- >   fromUnion (S (S (Z (I i)))) = Odd i
+-- >   fromUnion (S (S (S x))) = case x of {}
+-- The last 'fromUnion' equation is here to please the pattern checker.
+class AsUnion (as :: [Type]) (r :: Type) where
+  toUnion :: r -> Union (ResponseTypes as)
+  fromUnion :: Union (ResponseTypes as) -> r
+
+-- | Unions can be used directly as handler return types using this trivial
+-- instance.
+instance (rs ~ ResponseTypes as) => AsUnion as (Union rs) where
+  toUnion = id
+  fromUnion = id
+
+-- | A handler with a single response.
+instance (ResponseType r ~ a) => AsUnion '[r] a where
+  toUnion = Z . I
+  fromUnion = unI . unZ
+
+_foo :: Union '[Int]
+_foo = toUnion @'[Respond 200 "test" Int] @Int 3
+
+class InjectAfter as bs where
+  injectAfter :: Union bs -> Union (as .++ bs)
+
+instance InjectAfter '[] bs where
+  injectAfter = id
+
+instance (InjectAfter as bs) => InjectAfter (a ': as) bs where
+  injectAfter = S . injectAfter @as @bs
+
+class InjectBefore as bs where
+  injectBefore :: Union as -> Union (as .++ bs)
+
+instance InjectBefore '[] bs where
+  injectBefore x = case x of {}
+
+instance (InjectBefore as bs) => InjectBefore (a ': as) bs where
+  injectBefore (Z x) = Z x
+  injectBefore (S x) = S (injectBefore @as @bs x)
+
+eitherToUnion ::
+  forall as bs a b.
+  (InjectAfter as bs, InjectBefore as bs) =>
+  (a -> Union as) ->
+  (b -> Union bs) ->
+  (Either a b -> Union (as .++ bs))
+eitherToUnion f _ (Left a) = injectBefore @as @bs (f a)
+eitherToUnion _ g (Right b) = injectAfter @as @bs (g b)
+
+class EitherFromUnion as bs where
+  eitherFromUnion ::
+    (Union as -> a) ->
+    (Union bs -> b) ->
+    (Union (as .++ bs) -> Either a b)
+
+instance EitherFromUnion '[] bs where
+  eitherFromUnion _ g = Right . g
+
+instance (EitherFromUnion as bs) => EitherFromUnion (a ': as) bs where
+  eitherFromUnion f _ (Z x) = Left (f (Z x))
+  eitherFromUnion f g (S x) = eitherFromUnion @as @bs (f . S) g x
+
+maybeToUnion ::
+  forall as a.
+  (InjectAfter as '[()], InjectBefore as '[()]) =>
+  (a -> Union as) ->
+  (Maybe a -> Union (as .++ '[()]))
+maybeToUnion f (Just a) = injectBefore @as @'[()] (f a)
+maybeToUnion _ Nothing = injectAfter @as @'[()] (Z (I ()))
+
+maybeFromUnion ::
+  forall as a.
+  (EitherFromUnion as '[()]) =>
+  (Union as -> a) ->
+  (Union (as .++ '[()]) -> Maybe a)
+maybeFromUnion f =
+    leftToMaybe . eitherFromUnion @as @'[()] f (const (Z (I ())))
+    where
+        leftToMaybe = either Just (const Nothing)
+
+-- | This class can be instantiated to get automatic derivation of 'AsUnion'
+-- instances via 'GenericAsUnion'. The idea is that one has to make sure that for
+-- each response @r@ in a 'MultiVerb' endpoint, there is an instance of
+-- @AsConstructor xs r@ for some @xs@, and that the list @xss@ of all the
+-- corresponding @xs@ is equal to 'GSOP.Code' of the handler type. Then one can
+-- write:
+-- @
+--   type Responses = ...
+--   data Result = ...
+--     deriving stock (Generic)
+--     deriving (AsUnion Responses) via (GenericAsUnion Responses Result)
+--
+--   instance GSOP.Generic Result
+-- @
+-- and get an 'AsUnion' instance for free.
+--
+-- There are a few predefined instances for constructors taking a single type
+-- corresponding to a simple response, and for empty responses, but in more
+-- general cases one either has to define an 'AsConstructor' instance by hand,
+-- or derive it via 'GenericAsConstructor'.
+class AsConstructor xs r where
+  toConstructor :: ResponseType r -> NP I xs
+  fromConstructor :: NP I xs -> ResponseType r
+
+class AsConstructors xss rs where
+  toSOP :: Union (ResponseTypes rs) -> SOP I xss
+  fromSOP :: SOP I xss -> Union (ResponseTypes rs)
+
+instance AsConstructors '[] '[] where
+  toSOP x = case x of {}
+  fromSOP x = case x of {}
+
+instance AsConstructor '[a] (Respond code description a) where
+  toConstructor x = I x :* Nil
+  fromConstructor = unI . hd
+
+instance AsConstructor '[a] (RespondAs (responseContentTypes :: Type) code description a) where
+  toConstructor x = I x :* Nil
+  fromConstructor = unI . hd
+
+instance AsConstructor '[] (RespondEmpty code description) where
+  toConstructor _ = Nil
+  fromConstructor _ = ()
+
+newtype GenericAsConstructor r = GenericAsConstructor r
+
+type instance ResponseType (GenericAsConstructor r) = ResponseType r
+
+instance
+  (GSOP.Code (ResponseType r) ~ '[xs], GSOP.Generic (ResponseType r)) =>
+  AsConstructor xs (GenericAsConstructor r)
+  where
+  toConstructor = unZ . unSOP . GSOP.from
+  fromConstructor = GSOP.to . SOP . Z
+
+instance
+  (AsConstructor xs r, AsConstructors xss rs) =>
+  AsConstructors (xs ': xss) (r ': rs)
+  where
+  toSOP (Z (I x)) = SOP . Z $ toConstructor @xs @r x
+  toSOP (S x) = SOP . S . unSOP $ toSOP @xss @rs x
+
+  fromSOP (SOP (Z x)) = Z (I (fromConstructor @xs @r x))
+  fromSOP (SOP (S x)) = S (fromSOP @xss @rs (SOP x))
+
+-- | This type is meant to be used with @deriving via@ in order to automatically
+-- generate an 'AsUnion' instance using 'Generics.SOP'. 
+--
+-- See 'AsConstructor' for more information and examples.
+newtype GenericAsUnion rs a = GenericAsUnion a
+
+instance
+  (GSOP.Code a ~ xss, GSOP.Generic a, AsConstructors xss rs) =>
+  AsUnion rs (GenericAsUnion rs a)
+  where
+  toUnion (GenericAsUnion x) = fromSOP @xss @rs (GSOP.from x)
+  fromUnion = GenericAsUnion . GSOP.to . toSOP @xss @rs
+
+-- | A handler for a pair of empty responses can be implemented simply by
+-- returning a boolean value. The convention is that the "failure" case, normally
+-- represented by 'False', corresponds to the /first/ response.
+instance
+  AsUnion
+    '[ RespondEmpty s1 desc1,
+       RespondEmpty s2 desc2
+     ]
+    Bool
+  where
+  toUnion False = Z (I ())
+  toUnion True = S (Z (I ()))
+
+  fromUnion (Z (I ())) = False
+  fromUnion (S (Z (I ()))) = True
+  fromUnion (S (S x)) = case x of {}
+
+-- | A handler for a pair of responses where the first is empty can be
+-- implemented simply by returning a 'Maybe' value. The convention is that the
+-- "failure" case, normally represented by 'Nothing', corresponds to the /first/
+-- response.
+instance
+  {-# OVERLAPPABLE #-}
+  (ResponseType r1 ~ (), ResponseType r2 ~ a) =>
+  AsUnion '[r1, r2] (Maybe a)
+  where
+  toUnion Nothing = Z (I ())
+  toUnion (Just x) = S (Z (I x))
+
+  fromUnion (Z (I ())) = Nothing
+  fromUnion (S (Z (I x))) = Just x
+  fromUnion (S (S x)) = case x of {}
diff --git a/servant/src/Servant/API/TypeLevel/List.hs b/servant/src/Servant/API/TypeLevel/List.hs
new file mode 100644
index 000000000..e22c44670
--- /dev/null
+++ b/servant/src/Servant/API/TypeLevel/List.hs
@@ -0,0 +1,14 @@
+module Servant.API.TypeLevel.List 
+    (type (.++)
+    ) where
+
+import Data.Kind
+
+-- | Append two type-level lists.
+--
+-- Import it as
+--
+-- > import Servant.API.TypeLevel.List (type (.++))
+type family (.++) (l1 :: [Type]) (l2 :: [Type]) where
+  '[] .++ a = a
+  (a ': as) .++ b = a ': (as .++ b)
diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs
index 82c285d9d..d05bc5bba 100644
--- a/servant/src/Servant/Links.hs
+++ b/servant/src/Servant/Links.hs
@@ -183,6 +183,7 @@ import           Servant.API.WithNamedContext
 import           Servant.API.WithResource
                  (WithResource)
 import           Web.HttpApiData
+import           Servant.API.MultiVerb
 
 -- | A safe link datatype.
 -- The only way of constructing a 'Link' is using 'safeLink', which means any
@@ -665,3 +666,7 @@ instance {-# OVERLAPPABLE #-} TypeError (NoInstanceForSub
                                          HasLink ty) => HasLink (ty :> sub)
 
 instance {-# OVERLAPPABLE #-} TypeError (NoInstanceFor (HasLink api)) => HasLink api
+
+instance HasLink (MultiVerb method cs as r) where
+  type MkLink (MultiVerb method cs as r) a = a
+  toLink toA _ = toA
diff --git a/servant/src/Servant/Types/Internal/ResponseList.hs b/servant/src/Servant/Types/Internal/ResponseList.hs
new file mode 100644
index 000000000..ddc990e4c
--- /dev/null
+++ b/servant/src/Servant/Types/Internal/ResponseList.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveTraversable #-}
+
+-- | This module offers other servant libraries a minimalistic HTTP response type.
+--
+-- It is purely an internal API and SHOULD NOT be used by end-users of Servant.
+module Servant.Types.Internal.ResponseList where
+
+import Network.HTTP.Types (Status, Header)
+import Data.Sequence (Seq)
+import GHC.Generics (Generic)
+import Data.Data (Typeable)
+
+data InternalResponse a = InternalResponse
+  { statusCode :: Status
+  , headers :: Seq Header
+  , responseBody :: a
+  } deriving stock (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)