diff --git a/Web/Controller/Sessions.hs b/Web/Controller/Sessions.hs index f9ccad9..ce8b45f 100644 --- a/Web/Controller/Sessions.hs +++ b/Web/Controller/Sessions.hs @@ -4,7 +4,8 @@ import Web.Types import Web.View.Sessions.New import Generated.Types 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.ControllerPrelude @@ -14,17 +15,20 @@ instance Controller SessionsController where render NewView { user } action CreateSessionAction = do - (user, token) <- authenticate @User - case user of - Just user -> do - setSession "userId" (show user.id) + maybeUser <- query @User + |> filterWhere (#email, param "email") + |> fetchOneOrNothing + case maybeUser of + Just user | verifyPassword user (param "password") -> do + login user redirectTo HubsAction - Nothing -> do + _ -> do setErrorMessage "Invalid email or password" redirectTo NewSessionAction action DeleteSessionAction = do - unsetSession "userId" - redirectTo NewSessionAction + currentUserOrNothing @User >>= \case + Just user -> logout user >> redirectTo NewSessionAction + Nothing -> redirectTo NewSessionAction instance SessionsControllerConfig User diff --git a/Web/View/Widgets/New.hs b/Web/View/Widgets/New.hs index 4e3a0f9..b3342d0 100644 --- a/Web/View/Widgets/New.hs +++ b/Web/View/Widgets/New.hs @@ -1,10 +1,6 @@ module Web.View.Widgets.New where -import Web.Types -import Generated.Types -import IHP.Prelude -import IHP.ViewPrelude -import Web.Routes () +import Web.View.Prelude data NewView = NewView { widget :: !Widget diff --git a/Web/View/Widgets/Show.hs b/Web/View/Widgets/Show.hs index 9675d60..3ef034c 100644 --- a/Web/View/Widgets/Show.hs +++ b/Web/View/Widgets/Show.hs @@ -1,10 +1,7 @@ module Web.View.Widgets.Show where -import Web.Types -import Generated.Types -import IHP.Prelude -import IHP.ViewPrelude -import Web.Routes () +import Web.View.Prelude +import Data.Scientific (Scientific) import Application.Helper.View (widgetEnvelope) data ShowView = ShowView @@ -135,7 +132,7 @@ instance View ShowView where |] 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 = [ (cat, length (filter (\a -> a.category == cat) annotations)) | cat <- ["friction","defect","wish","policy_concern","doc_gap","trust","other"] @@ -241,7 +238,7 @@ renderSignalsSection sigs = [hsx| |] -renderSignalValue :: Double -> Html +renderSignalValue :: Scientific -> Html renderSignalValue v = [hsx|{show v}|] renderAdapterBadge :: Maybe WidgetAdapterSpec -> Html