mirror of
https://github.com/dillonkearns/elm-pages-v3-beta.git
synced 2024-12-26 05:13:24 +03:00
Wire up encrypt/decrypt logic for magic hash on form submit and on page load with query param.
This commit is contained in:
Dillon Kearns
parent
8314fa06c5
commit
2fd7becbf8
@ -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 ())
|
||||
|
||||
@ -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"
|
||||
}
|
||||
},
|
||||
|
||||
@ -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;
|
||||
}
|
||||
|
||||
@ -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 )
|
||||
|
||||
Loading…
Reference in New Issue
Block a user