fix(WP-0016): Layer 3 compilation fixes — Sessions auth, Widgets import consolidation, Scientific type

- Sessions: replace raw authenticate/unsetSession with IHP login/logout/verifyPassword
- Widgets/New, Widgets/Show: consolidate imports to Web.View.Prelude
- Widgets/Show: unwrap Id newtype for childrenOf comparison, Double → Scientific in renderSignalValue

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-10 23:13:09 +00:00
parent 563983fa7f
commit 469ed6c758
3 changed files with 17 additions and 20 deletions

View File

@@ -4,7 +4,8 @@ import Web.Types
import Web.View.Sessions.New import Web.View.Sessions.New
import Generated.Types import Generated.Types
import IHP.LoginSupport.Helper.Controller import IHP.LoginSupport.Helper.Controller
import IHP.AuthSupport.Controller.Sessions (SessionsControllerConfig) import IHP.AuthSupport.Controller.Sessions (SessionsControllerConfig (..))
import IHP.AuthSupport.Authentication (verifyPassword)
import IHP.Prelude import IHP.Prelude
import IHP.ControllerPrelude import IHP.ControllerPrelude
@@ -14,17 +15,20 @@ instance Controller SessionsController where
render NewView { user } render NewView { user }
action CreateSessionAction = do action CreateSessionAction = do
(user, token) <- authenticate @User maybeUser <- query @User
case user of |> filterWhere (#email, param "email")
Just user -> do |> fetchOneOrNothing
setSession "userId" (show user.id) case maybeUser of
Just user | verifyPassword user (param "password") -> do
login user
redirectTo HubsAction redirectTo HubsAction
Nothing -> do _ -> do
setErrorMessage "Invalid email or password" setErrorMessage "Invalid email or password"
redirectTo NewSessionAction redirectTo NewSessionAction
action DeleteSessionAction = do action DeleteSessionAction = do
unsetSession "userId" currentUserOrNothing @User >>= \case
redirectTo NewSessionAction Just user -> logout user >> redirectTo NewSessionAction
Nothing -> redirectTo NewSessionAction
instance SessionsControllerConfig User instance SessionsControllerConfig User

View File

@@ -1,10 +1,6 @@
module Web.View.Widgets.New where module Web.View.Widgets.New where
import Web.Types import Web.View.Prelude
import Generated.Types
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
data NewView = NewView data NewView = NewView
{ widget :: !Widget { widget :: !Widget

View File

@@ -1,10 +1,7 @@
module Web.View.Widgets.Show where module Web.View.Widgets.Show where
import Web.Types import Web.View.Prelude
import Generated.Types import Data.Scientific (Scientific)
import IHP.Prelude
import IHP.ViewPrelude
import Web.Routes ()
import Application.Helper.View (widgetEnvelope) import Application.Helper.View (widgetEnvelope)
data ShowView = ShowView data ShowView = ShowView
@@ -135,7 +132,7 @@ instance View ShowView where
</div> </div>
|] |]
rootAnnotations = filter (\a -> isNothing a.parentId) annotations rootAnnotations = filter (\a -> isNothing a.parentId) annotations
childrenOf parent = filter (\a -> a.parentId == Just parent.id) annotations childrenOf parent = filter (\a -> a.parentId == Just (let Id uuid = parent.id in uuid)) annotations
categoryBreakdown = categoryBreakdown =
[ (cat, length (filter (\a -> a.category == cat) annotations)) [ (cat, length (filter (\a -> a.category == cat) annotations))
| cat <- ["friction","defect","wish","policy_concern","doc_gap","trust","other"] | cat <- ["friction","defect","wish","policy_concern","doc_gap","trust","other"]
@@ -241,7 +238,7 @@ renderSignalsSection sigs = [hsx|
</section> </section>
|] |]
renderSignalValue :: Double -> Html renderSignalValue :: Scientific -> Html
renderSignalValue v = [hsx|<span class="font-mono text-gray-700">{show v}</span>|] renderSignalValue v = [hsx|<span class="font-mono text-gray-700">{show v}</span>|]
renderAdapterBadge :: Maybe WidgetAdapterSpec -> Html renderAdapterBadge :: Maybe WidgetAdapterSpec -> Html