Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix multiverb instances #834

Merged
merged 2 commits into from
Mar 5, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 3 additions & 7 deletions assets/esbuild.config.js
Original file line number Diff line number Diff line change
Expand Up @@ -89,13 +89,9 @@ console.log(__dirname);

if (process.argv.includes("--watch")) {
(async () => {
const result = await esbuild.build(config);
chokidar.watch(watchDirectories).on('all', (event, path) => {
console.log(`rebuilding ${path}`)
result.rebuild()
})
})();

const context = esbuild.context(config);
await context.watch();
})
} else {
esbuild.build(config).catch(() => process.exit(1))
}
2 changes: 1 addition & 1 deletion cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,7 @@ source-repository-package
source-repository-package
type: git
location: https://github.com/haskell-servant/servant
tag: 527e99e78952717b1b2cc50c8059dbece6dc979f
tag: bce6b4bd14c4cb953561366cd43600eb6b8fc17c
subdir:
./servant
./servant-server
Expand Down
28 changes: 10 additions & 18 deletions src/web/FloraWeb/Pages/Routes/Sessions.hs
Original file line number Diff line number Diff line change
@@ -1,9 +1,7 @@
{-# OPTIONS_GHC -Wno-orphans #-}

module FloraWeb.Pages.Routes.Sessions where

import Data.Text
import Generics.SOP (I (..), NS (..))
import Generics.SOP qualified as GSOP
import Lucid
import Servant.API
import Servant.API.ContentTypes.Lucid
Expand All @@ -28,7 +26,7 @@ type NewSessionResponses =
'[ -- User is already logged-in, redirect to home page
WithHeaders
'[Header "Location" Text]
((), Text)
Text
(RespondEmpty 301 "Already logged-in")
, -- User is not logged-in, dispay the login page
Respond 200 "Log-in required" (Html ())
Expand All @@ -38,14 +36,11 @@ data NewSessionResult
= AlreadyAuthenticated Text
| AuthenticationRequired (Html ())
deriving stock (Generic)
deriving
(AsUnion NewSessionResponses)
via GenericAsUnion 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 GSOP.Generic NewSessionResult

type CreateSession =
"new"
Expand All @@ -70,14 +65,11 @@ data CreateSessionResult
= AuthenticationFailure (Html ())
| AuthenticationSuccess (Text, SetCookie)
deriving stock (Generic)
deriving
(AsUnion CreateSessionResponses)
via GenericAsUnion CreateSessionResponses CreateSessionResult

instance AsUnion CreateSessionResponses CreateSessionResult where
toUnion (AuthenticationFailure body) = Z (I body)
toUnion (AuthenticationSuccess (location, cookie)) = S (Z (I (location, cookie)))

fromUnion (Z (I body)) = AuthenticationFailure body
fromUnion (S (Z (I headers))) = AuthenticationSuccess headers
fromUnion (S (S x)) = case x of {}
instance GSOP.Generic CreateSessionResult

type DeleteSession =
"delete"
Expand Down
19 changes: 7 additions & 12 deletions src/web/FloraWeb/Pages/Routes/Settings.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -40,11 +40,11 @@ type GetTwoFactorSettingsPage =
type TwoFactorSetupResponses =
'[ WithHeaders
'[Header "Location" Text]
((), Text)
Text
(RespondEmpty 301 "2FA Validation Success")
, WithHeaders
'[Header "Location" Text]
((), Text)
Text
(RespondEmpty 301 "")
, Respond 400 "2FA Validation Failed" (Html ())
]
Expand All @@ -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
Expand Down
Loading