51 lines
1.4 KiB
Haskell
51 lines
1.4 KiB
Haskell
|
{-# LANGUAGE DeriveGeneric #-}
|
||
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
||
|
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
{-# LANGUAGE QuasiQuotes #-}
|
||
|
|
{-# LANGUAGE TemplateHaskell #-}
|
||
|
|
{-# LANGUAGE TypeFamilies #-}
|
||
|
|
{-# LANGUAGE TypeApplications #-}
|
||
|
|
{-# LANGUAGE FlexibleContexts #-}
|
||
|
|
|
||
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||
|
|
|
||
|
|
module Client.Handlers.VerifyEmail where
|
||
|
|
|
||
|
|
import Relude
|
||
|
|
|
||
|
|
import Client.ApiRequests
|
||
|
|
import Client.Types
|
||
|
|
import Server.Types
|
||
|
|
import Data.Morpheus.Client
|
||
|
|
import Yesod
|
||
|
|
import Yesod.Auth
|
||
|
|
|
||
|
|
declareLocalTypesInline "schema.gql" [raw|
|
||
|
|
mutation VerifyEmail($secret: String!) {
|
||
|
|
verifyEmail(secret: $secret)
|
||
|
|
}
|
||
|
|
|]
|
||
|
|
|
||
|
|
getVerifyEmailR = do
|
||
|
|
codeForm <- generateFormPost verifyForm
|
||
|
|
defaultLayout $ verifyEmailW codeForm
|
||
|
|
|
||
|
|
postVerifyEmailR :: (YesodAuth DataIdClient, AuthId DataIdClient ~ Text) => Handler Html
|
||
|
|
postVerifyEmailR = do
|
||
|
|
((result, widget), enctype) <- runFormPost verifyForm
|
||
|
|
case result of
|
||
|
|
FormSuccess verify -> apiRequest @VerifyEmail False verify >> setMessage "Sähköpostiosoite vahvistettu" >> redirect OwnProfileR
|
||
|
|
_ -> defaultLayout $ verifyEmailW (widget, enctype)
|
||
|
|
|
||
|
|
verifyEmailW (codeWidget, codeEnctype) = do
|
||
|
|
setTitle "Vahvista sähköpostiosoite"
|
||
|
|
[whamlet|
|
||
|
|
<h1>
|
||
|
|
Vahvista sähköpostiosoite
|
||
|
|
<form action="@{VerifyEmailR}" method="post" enctype="#{codeEnctype}">
|
||
|
|
^{codeWidget}
|
||
|
|
<input type="submit" value="Vahvista">
|
||
|
|
|]
|
||
|
|
|
||
|
|
verifyForm = renderDivs $ VerifyEmailArgs <$> areq textField "Vahvistuskoodi" Nothing
|