Simplify things

cabal.project

@@ -61,7 +61,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/haskell-servant/servant
-    tag: 831423ead6e2f0ed0d04d5b21cd61f2e0994a18d
+    tag: d89d3ea1f78e9738b77f5651ac74e7cf691d42e0
     subdir:
       ./servant
       ./servant-server

src/web/FloraWeb/Pages/Routes/Sessions.hs

@@ -3,7 +3,7 @@
 module FloraWeb.Pages.Routes.Sessions where
 
 import Data.Text
-import Generics.SOP (I (..), NP (..), NS (..))
+import Generics.SOP (I (..), NP (..))
 import Generics.SOP qualified as GSOP
 import Lucid
 import Servant.API
@@ -15,26 +15,24 @@ import Web.FormUrlEncoded
 
 import Flora.Model.PersistentSession
 
-instance AsConstructor '[r] (WithHeaders hs r (RespondEmpty code desc)) where
-  toConstructor x = I x :* Nil
-  fromConstructor (I x :* Nil) = x
-
 type Routes = NamedRoutes Routes'
 
 type NewSession =
   "new"
     :> MultiVerb
-         'GET
-         '[HTML]
-         NewSessionResponses
-         NewSessionResult
+        'GET
+        '[HTML]
+        NewSessionResponses
+        NewSessionResult
+
+type DefaultReturn headers response = NP I (response : headers)
 
 type NewSessionResponses =
   '[ -- User is already logged-in, redirect to home page
      WithHeaders
-       '[Header "Location" Text]
-       ((), Text)
-       (RespondEmpty 301 "Already logged-in")
+      '[Header "Location" Text]
+      Text
+      (RespondEmpty 301 "Already logged-in")
    , -- User is not logged-in, dispay the login page
      Respond 200 "Log-in required" (Html ())
    ]
@@ -51,35 +49,23 @@ deriving via
   instance
     AsUnion NewSessionResponses NewSessionResult
 
--- instance AsUnion NewSessionResponses NewSessionResult where
---   toUnion (AlreadyAuthenticated location) = Z (I ((), location))
---   toUnion (AuthenticationRequired response) = S (Z (I response))
---
---   fromUnion (Z (I ((), location))) = AlreadyAuthenticated location
---   fromUnion (S (Z (I response))) = AuthenticationRequired response
---   fromUnion (S (S x)) = case x of {}
-
--- instance AsHeaders '[Text, SetCookie] () (Text, SetCookie) where
---   toHeaders (location, cookie) = (I location :* I cookie :* Nil, ())
---   fromHeaders (I location :* I cookie :* Nil, ()) = (location, cookie)
-
 type CreateSession =
   "new"
     :> ReqBody '[FormUrlEncoded] LoginForm
     :> MultiVerb
-         'POST
-         '[HTML]
-         CreateSessionResponses
-         CreateSessionResult
+        'POST
+        '[HTML]
+        CreateSessionResponses
+        CreateSessionResult
 
 type CreateSessionResponses =
   '[ -- Failure, send login page back
      Respond 401 "Authentication failed" (Html ())
    , -- Success, redirected to home page
      WithHeaders
-       '[Header "Location" Text, Header "Set-Cookie" SetCookie]
-       (Text, SetCookie)
-       (RespondEmpty 301 "Authentication succeeded")
+      '[Header "Location" Text, Header "Set-Cookie" SetCookie]
+      (Text, SetCookie)
+      (RespondEmpty 301 "Authentication succeeded")
    ]
 
 data CreateSessionResult

src/web/FloraWeb/Pages/Routes/Settings.hs

@@ -9,7 +9,7 @@ module FloraWeb.Pages.Routes.Settings
 where
 
 import Data.Text (Text)
-import Generics.SOP (I (..), NS (..))
+import Generics.SOP qualified as GSOP
 import Lucid
 import Servant
 import Servant.API.ContentTypes.Lucid
@@ -39,13 +39,13 @@ type GetTwoFactorSettingsPage =
 
 type TwoFactorSetupResponses =
   '[ WithHeaders
-       '[Header "Location" Text]
-       ((), Text)
-       (RespondEmpty 301 "2FA Validation Success")
+      '[Header "Location" Text]
+      Text
+      (RespondEmpty 301 "2FA Validation Success")
    , WithHeaders
-       '[Header "Location" Text]
-       ((), Text)
-       (RespondEmpty 301 "")
+      '[Header "Location" Text]
+      Text
+      (RespondEmpty 301 "")
    , Respond 400 "2FA Validation Failed" (Html ())
    ]
 
@@ -54,16 +54,11 @@ data TwoFactorSetupResult
   | TwoFactorSetupNotEnabled Text
   | TwoFactorSetupFailure (Html ())
   deriving stock (Generic)
+  deriving
+    (AsUnion TwoFactorSetupResponses)
+    via GenericAsUnion TwoFactorSetupResponses TwoFactorSetupResult
 
-instance AsUnion TwoFactorSetupResponses TwoFactorSetupResult where
-  toUnion (TwoFactorSetupSuccess location) = Z (I ((), location))
-  toUnion (TwoFactorSetupNotEnabled location) = S (Z (I ((), location)))
-  toUnion (TwoFactorSetupFailure response) = S (S (Z (I response)))
-
-  fromUnion (Z (I ((), location))) = TwoFactorSetupSuccess location
-  fromUnion (S (Z (I ((), location)))) = TwoFactorSetupNotEnabled location
-  fromUnion (S (S (Z (I response)))) = TwoFactorSetupFailure response
-  fromUnion (S (S (S x))) = case x of {}
+instance GSOP.Generic TwoFactorSetupResult
 
 data TwoFactorConfirmationForm = TwoFactorConfirmationForm
   { code :: Text