generated from coulomb/repo-seed
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:
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
Reference in New Issue
Block a user