From 2fd7becbf875de2e0c961aa425c3f2a07cbe14d9 Mon Sep 17 00:00:00 2001 From: Dillon Kearns Date: Thu, 11 Aug 2022 11:43:43 -0700 Subject: [PATCH] Wire up encrypt/decrypt logic for magic hash on form submit and on page load with query param. --- examples/todos/app/Route/Login.elm | 287 ++++++++++++++++++++++------- examples/todos/elm.json | 5 +- examples/todos/port-data-source.ts | 9 + src/Form/Validation.elm | 21 ++- 4 files changed, 246 insertions(+), 76 deletions(-) diff --git a/examples/todos/app/Route/Login.elm b/examples/todos/app/Route/Login.elm index 1643e189..768a6b3c 100644 --- a/examples/todos/app/Route/Login.elm +++ b/examples/todos/app/Route/Login.elm @@ -2,8 +2,11 @@ module Route.Login exposing (ActionData, Data, Model, Msg, route) import Api.Scalar exposing (Uuid(..)) import DataSource exposing (DataSource) +import DataSource.Env +import DataSource.Http import DataSource.Port import Dict exposing (Dict) +import EmailAddress exposing (EmailAddress) import ErrorPage exposing (ErrorPage) import Form import Form.Field as Field @@ -15,15 +18,18 @@ import Html exposing (Html) import Html.Attributes as Attr import Json.Decode as Decode import Json.Encode as Encode +import List.Nonempty import MySession import Pages.Msg import Pages.PageUrl exposing (PageUrl) import Pages.Url import RouteBuilder exposing (StatefulRoute, StatelessRoute, StaticPayload) +import SendGrid import Server.Request as Request import Server.Response exposing (Response) import Server.Session as Session import Shared +import String.Nonempty exposing (NonemptyString) import Time import View exposing (View) @@ -56,30 +62,62 @@ type alias Login = } -form : Form.DoneForm String (DataSource (Combined String String)) data (List (Html (Pages.Msg.Msg Msg))) +now : DataSource Time.Posix +now = + DataSource.Port.get "now" + Encode.null + (Decode.int |> Decode.map Time.millisToPosix) + + +emailToMagicLink : EmailAddress -> DataSource String +emailToMagicLink email = + now + |> DataSource.andThen + (\now_ -> + DataSource.Port.get "encrypt" + (Encode.object + [ ( "text", Encode.string (EmailAddress.toString email) ) + , ( "expiresAt", (Time.posixToMillis now_ + (1000 * 60 * 30)) |> Encode.int ) + ] + |> Encode.encode 0 + |> Encode.string + ) + (Decode.string + |> Decode.map + (\encryptedString -> + "http://localhost:1234/login?magic=" ++ encryptedString + ) + ) + ) + + +form : Form.DoneForm String (DataSource (Combined String EmailAddress)) data (List (Html (Pages.Msg.Msg Msg))) form = Form.init - (\email -> + (\fieldEmail -> { combine = Validation.succeed - (\u -> - --attemptLogIn u - -- |> DataSource.map - -- (\maybeUserId -> - -- case maybeUserId of - -- Just (Uuid userId) -> - -- Validation.succeed userId - -- - -- Nothing -> - -- Validation.fail "Username and password do not match" Validation.global - -- ) - DataSource.succeed - (Validation.succeed u) + (\email -> + DataSource.Env.expect "TODOS_SEND_GRID_KEY" + |> DataSource.andThen (sendEmailDataSource email) + |> DataSource.map + (\emailSendResult -> + case emailSendResult of + Ok () -> + Validation.succeed email + + Err error -> + Validation.fail "Whoops, something went wrong sending an email to that address. Try again?" Validation.global + ) ) - |> Validation.andMap email + |> Validation.andMap + (fieldEmail + |> Validation.map (EmailAddress.fromString >> Result.fromMaybe "Invalid email address") + |> Validation.fromResult + ) , view = \info -> - [ email |> fieldView info "Email" + [ fieldEmail |> fieldView info "Email" , globalErrors info , Html.button [] [ if info.isTransitioning then @@ -94,22 +132,6 @@ form = |> Form.field "email" (Field.text |> Field.email |> Field.required "Required") -attemptLogIn : String -> DataSource (Maybe Uuid) -attemptLogIn username = - --DataSource.Port.get "hashPassword" - -- (Json.Encode.string password) - -- Json.Decode.string - -- |> DataSource.andThen - -- (\hashed -> - -- { username = username - -- , expectedPasswordHash = hashed - -- } - -- |> Data.User.login - -- |> Request.Hasura.dataSource - -- ) - DataSource.fail "" - - fieldView : Form.Context String data -> String @@ -155,19 +177,34 @@ type alias Request = data : RouteParams -> Request.Parser (DataSource (Response Data ErrorPage)) data routeParams = MySession.withSession - (Request.succeed ()) - (\() session -> - case session of - Ok (Just okSession) -> - ( okSession - , okSession - |> Session.get "userId" - |> Data - |> Server.Response.render - ) - |> DataSource.succeed + (Request.queryParam "magic") + (\magicLinkHash session -> + case magicLinkHash of + Just magicHash -> + parseMagicHashIfNotExpired magicHash + |> DataSource.map + (\emailIfValid -> + let + _ = + Debug.log "@decrypted" emailIfValid + in + case session of + Ok (Just okSession) -> + ( okSession + , okSession + |> Session.get "userId" + |> Data + |> Server.Response.render + ) - _ -> + _ -> + ( Session.empty + , { username = Nothing } + |> Server.Response.render + ) + ) + + Nothing -> ( Session.empty , { username = Nothing } |> Server.Response.render @@ -192,35 +229,24 @@ encryptInfo emailAddress requestTime = action : RouteParams -> Request.Parser (DataSource (Response ActionData ErrorPage)) action routeParams = Request.map2 - (\usernameDs requestTime -> - usernameDs + (\sendMagicLinkDataSource requestTime -> + sendMagicLinkDataSource |> DataSource.andThen (\usernameResult -> case usernameResult of - Err error -> - --(error |> render) - Server.Response.render (ActionData Nothing) + Err (Form.Response error) -> + Server.Response.render + { maybeError = Just error + , maybeFlash = Nothing + } |> DataSource.succeed Ok ( _, emailAddress ) -> - let - foo : DataSource String - foo = - encryptInfo emailAddress requestTime - in - foo - |> DataSource.map - (\encryptedName -> - let - _ = - Debug.log "@@@encrypted" - { encrypted = encryptedName - } - in - { maybeError = Nothing - } - |> Server.Response.render - ) + { maybeError = Nothing + , maybeFlash = Just "Check your inbox for your login link!" + } + |> Server.Response.render + |> DataSource.succeed ) ) (Request.formDataWithServerValidation [ form ]) @@ -240,16 +266,16 @@ head : head static = Seo.summary { canonicalUrlOverride = Nothing - , siteName = "elm-pages" + , siteName = "Login | elm-pages Todo List" , image = { url = Pages.Url.external "TODO" , alt = "elm-pages logo" , dimensions = Nothing , mimeType = Nothing } - , description = "TODO" + , description = "Login to manage your todo list in full-stack Elm!" , locale = Nothing - , title = "TODO title" -- metadata.title -- TODO + , title = "Login | elm-pages Todo List" } |> Seo.website @@ -265,6 +291,7 @@ type alias ActionData = { fields : List ( String, String ) , errors : Dict String (List String) } + , maybeFlash : Maybe String } @@ -296,3 +323,121 @@ view maybeUrl sharedModel app = () ] } + + +sendFake = + True + + +sendEmailDataSource : EmailAddress -> String -> DataSource (Result SendGrid.Error ()) +sendEmailDataSource recipient apiKey = + if sendFake then + emailToMagicLink recipient + |> DataSource.andThen + (\magicLinkString -> + let + emailBody : String + emailBody = + "Welcome! Please confirm that this is your email address.\n" ++ magicLinkString + in + log emailBody + |> DataSource.map Ok + ) + + else + let + senderEmail : Maybe EmailAddress + senderEmail = + EmailAddress.fromString "dillon@incrementalelm.com" + in + senderEmail + |> Maybe.map + (\justSender -> + emailToMagicLink recipient + |> DataSource.andThen + (\magicLinkString -> + SendGrid.textEmail + { subject = String.Nonempty.NonemptyString 'T' "odo app login" + , to = List.Nonempty.fromElement recipient + , content = String.Nonempty.NonemptyString 'W' ("elcome! Please confirm that this is your email address.\n" ++ magicLinkString) + , nameOfSender = "Todo App" + , emailAddressOfSender = justSender + } + |> sendEmail apiKey + ) + ) + |> Maybe.withDefault (DataSource.fail "Expected a valid sender email address.") + + +sendEmail : + String + -> SendGrid.Email + -> DataSource (Result SendGrid.Error ()) +sendEmail apiKey_ email_ = + DataSource.Http.uncachedRequest + { method = "POST" + , headers = [ ( "Authorization", "Bearer " ++ apiKey_ ) ] + , url = SendGrid.sendGridApiUrl + , body = SendGrid.encodeSendEmail email_ |> DataSource.Http.jsonBody + } + DataSource.Http.expectStringResponse + |> DataSource.map + (\response -> + case response of + DataSource.Http.BadUrl_ url -> + SendGrid.BadUrl url |> Err + + DataSource.Http.Timeout_ -> + Err SendGrid.Timeout + + DataSource.Http.NetworkError_ -> + Err SendGrid.NetworkError + + DataSource.Http.BadStatus_ metadata body -> + SendGrid.decodeBadStatus metadata body |> Err + + DataSource.Http.GoodStatus_ _ _ -> + Ok () + ) + + +parseMagicHash : String -> DataSource ( String, Time.Posix ) +parseMagicHash magicHash = + DataSource.Port.get "decrypt" + (Encode.string magicHash) + (Decode.string + |> Decode.map + (Decode.decodeString + (Decode.map2 Tuple.pair + (Decode.field "text" Decode.string) + (Decode.field "expiresAt" (Decode.int |> Decode.map Time.millisToPosix)) + ) + >> Result.mapError Decode.errorToString + ) + ) + |> DataSource.andThen DataSource.fromResult + + +parseMagicHashIfNotExpired : String -> DataSource (Maybe String) +parseMagicHashIfNotExpired magicHash = + DataSource.map2 + (\( email, expiresAt ) currentTime -> + let + isExpired = + (Time.posixToMillis currentTime |> Debug.log "current") > (Time.posixToMillis expiresAt |> Debug.log "expires") + in + if isExpired then + Nothing + + else + Just email + ) + (parseMagicHash magicHash) + now + + +log : String -> DataSource () +log message = + DataSource.Port.get "log" + (Encode.string message) + (Decode.succeed ()) diff --git a/examples/todos/elm.json b/examples/todos/elm.json index 6c85cb10..a3f42365 100644 --- a/examples/todos/elm.json +++ b/examples/todos/elm.json @@ -6,7 +6,8 @@ "../../src", ".elm-pages", "../../plugins", - "gen" + "gen", + "send-grid/src" ], "elm-version": "0.19.1", "dependencies": { @@ -38,6 +39,7 @@ "justinmimbs/date": "4.0.0", "lamdera/codecs": "1.0.0", "lamdera/core": "1.0.0", + "mgold/elm-nonempty-list": "4.2.0", "miniBill/elm-codec": "1.2.0", "noahzgordon/elm-color-extra": "1.0.2", "pablohirafuji/elm-syntax-highlight": "3.4.0", @@ -57,7 +59,6 @@ "fredcy/elm-parseint": "2.0.1", "j-maas/elm-ordered-containers": "1.0.0", "lukewestby/elm-string-interpolate": "1.0.4", - "mgold/elm-nonempty-list": "4.2.0", "rtfeldman/elm-hex": "1.0.0" } }, diff --git a/examples/todos/port-data-source.ts b/examples/todos/port-data-source.ts index 7d7b3778..5bdd74a6 100644 --- a/examples/todos/port-data-source.ts +++ b/examples/todos/port-data-source.ts @@ -40,3 +40,12 @@ export function decrypt(text: string) { ]); return decrypted.toString(); } + +export function now() { + return Date.now(); +} + +export function log(message) { + console.log(message); + return null; +} diff --git a/src/Form/Validation.elm b/src/Form/Validation.elm index b782940e..de501cd9 100644 --- a/src/Form/Validation.elm +++ b/src/Form/Validation.elm @@ -148,14 +148,29 @@ withErrorIf includeError (Validation _ key _) error (Validation viewField name ( {-| -} -map : (parsed -> mapped) -> Validation error parsed named constraint -> Combined error mapped +map : (parsed -> mapped) -> Validation error parsed named constraint -> Validation error mapped named constraint map mapFn (Validation viewField name ( maybeParsedA, errorsA )) = Validation Nothing name ( Maybe.map mapFn maybeParsedA, errorsA ) {-| -} -fromResult : Result ( String, error ) parsed -> Combined error parsed -fromResult result = +fromResult : Field error (Result error parsed) kind -> Combined error parsed +fromResult fieldResult = + fieldResult + |> andThen + (\parsedValue -> + case parsedValue of + Ok okValue -> + succeed okValue + + Err error -> + fail error fieldResult + ) + + +{-| -} +fromResultOld : Result ( String, error ) parsed -> Combined error parsed +fromResultOld result = case result of Ok parsed -> Validation Nothing Nothing ( Just parsed, Dict.empty )