From 6d4358020876a34772228f117aaf0d3f0dfd940f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ga=C3=ABl=20Deest?= <gael.deest@tweag.io>
Date: Mon, 4 Apr 2022 10:51:24 +0200
Subject: [PATCH] Prototype

---
 servant/servant.cabal                        |  1 +
 servant/src/Servant/API.hs                   |  5 +++++
 servant/src/Servant/API/RedirectOf.hs        | 12 ++++++++++++
 servant/src/Servant/Test/ComprehensiveAPI.hs | 11 ++++++++++-
 4 files changed, 28 insertions(+), 1 deletion(-)
 create mode 100644 servant/src/Servant/API/RedirectOf.hs

diff --git a/servant/servant.cabal b/servant/servant.cabal
index 32b63feb..96ba21cb 100644
--- a/servant/servant.cabal
+++ b/servant/servant.cabal
@@ -50,6 +50,7 @@ library
     Servant.API.QueryParam
     Servant.API.Raw
     Servant.API.RemoteHost
+    Servant.API.RedirectOf
     Servant.API.ReqBody
     Servant.API.ResponseHeaders
     Servant.API.Status
diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs
index 22309dce..69a4ceb0 100644
--- a/servant/src/Servant/API.hs
+++ b/servant/src/Servant/API.hs
@@ -57,6 +57,9 @@ module Servant.API (
   -- * Response Headers
   module Servant.API.ResponseHeaders,
 
+  -- * Redirections
+  module Servant.API.RedirectOf,
+
   -- * Untyped endpoints
   module Servant.API.Raw,
   -- | Plugging in a wai 'Network.Wai.Application', serving directories
@@ -118,6 +121,8 @@ import           Servant.API.Raw
                  (Raw)
 import           Servant.API.RemoteHost
                  (RemoteHost)
+import           Servant.API.RedirectOf
+                 (RedirectOf(..))
 import           Servant.API.ReqBody
                  (ReqBody, ReqBody')
 import           Servant.API.ResponseHeaders
diff --git a/servant/src/Servant/API/RedirectOf.hs b/servant/src/Servant/API/RedirectOf.hs
new file mode 100644
index 00000000..bc0e6701
--- /dev/null
+++ b/servant/src/Servant/API/RedirectOf.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Servant.API.RedirectOf where
+
+import Data.Proxy (Proxy(..))
+import Servant.Links
+
+data RedirectOf api where
+   RedirectOf
+     :: (IsElem endpoint api, HasLink endpoint)
+     => Proxy endpoint -> (forall a. MkLink endpoint a -> a) -> RedirectOf api
diff --git a/servant/src/Servant/Test/ComprehensiveAPI.hs b/servant/src/Servant/Test/ComprehensiveAPI.hs
index 67417869..e0d1dfac 100644
--- a/servant/src/Servant/Test/ComprehensiveAPI.hs
+++ b/servant/src/Servant/Test/ComprehensiveAPI.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds     #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
 -- | This is a module containing an API with all `Servant.API` combinators. It
@@ -44,11 +45,13 @@ type ComprehensiveAPIWithoutStreaming =
 comprehensiveAPIWithoutStreaming :: Proxy ComprehensiveAPIWithoutStreaming
 comprehensiveAPIWithoutStreaming = Proxy
 
+type CaptureEndpoint = Capture' '[Description "example description"] "bar" Int :> GET
+
 -- | @:: API -> API@, so we have linear structure of the API.
 type ComprehensiveAPIWithoutStreamingOrRaw' endpoint =
     GET
     :<|> "get-int"          :> Get '[JSON] Int
-    :<|> "capture"          :> Capture' '[Description "example description"] "bar" Int :> GET
+    :<|> CaptureEndpoint
     :<|> "capture-lenient"  :> Capture' '[Lenient] "foo" Int :> GET
     :<|> "header"           :> Header "foo" Int :> GET
     :<|> "header-lenient"   :> Header' '[Required, Lenient] "bar" Int :> GET
@@ -78,3 +81,9 @@ type ComprehensiveAPIWithoutStreamingOrRaw = ComprehensiveAPIWithoutStreamingOrR
 
 comprehensiveAPIWithoutStreamingOrRaw :: Proxy ComprehensiveAPIWithoutStreamingOrRaw
 comprehensiveAPIWithoutStreamingOrRaw = Proxy
+
+redirectEndpoints :: [RedirectOf ComprehensiveAPI]
+redirectEndpoints =
+  [ RedirectOf (Proxy @GET) id
+  , RedirectOf (Proxy @CaptureEndpoint) (\mkLink -> mkLink 42)
+  ]