eidolon/src/Activate.purs

78 lines
2.4 KiB
Plaintext
Raw Normal View History

2016-11-30 20:22:35 +00:00
module Activate where
2016-12-03 02:14:13 +00:00
import Prelude (Unit, bind, not, pure, show, unit, ($), (&&), (<>), (=<<), (==))
import Control.Monad.Aff (runAff)
2016-11-30 20:22:35 +00:00
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
2016-12-03 20:53:55 +00:00
import Control.Monad.Eff.JQuery (JQuery, JQueryEvent, display, hide, getValue, on, preventDefault, ready, select)
2016-11-30 20:22:35 +00:00
import DOM (DOM)
2016-12-03 02:14:13 +00:00
import Data.Function.Uncurried (runFn2)
import Data.Maybe (Maybe(..), fromJust, isNothing)
2016-11-30 20:22:35 +00:00
import Data.Tuple (Tuple(..))
2016-12-03 02:14:13 +00:00
import Network.HTTP.Affjax (AJAX, post)
2016-11-30 20:22:35 +00:00
import Data.FormURLEncoded as UE
2016-12-03 02:14:13 +00:00
import Partial.Unsafe (unsafePartial)
2016-11-30 20:22:35 +00:00
2016-12-03 02:14:13 +00:00
import Common (Elem(..), fail, fromForeign, fromHex, fromUtf8, getAttr, hmacSha3, progress, welcome)
2016-11-30 20:22:35 +00:00
-- main :: forall e. Eff (console :: CONSOLE | e) Unit
-- main = do
-- log "Hello sailor!"
main :: forall eff. Eff ( ajax :: AJAX
, dom :: DOM
, console :: CONSOLE
| eff
) Unit
main =
ready $ do
2016-12-03 02:14:13 +00:00
log "activating"
2016-12-03 20:53:55 +00:00
display =<< select ".js-hidden"
hide =<< select ".noscript"
2016-11-30 20:22:35 +00:00
activate <- select "#activate"
on "click" (onActivateClick activate) activate
onActivateClick
:: forall eff. JQuery
-> JQueryEvent
-> JQuery
-> Eff (dom :: DOM
, console :: CONSOLE
, ajax :: AJAX
| eff
) Unit
onActivateClick activate ev _ = unsafePartial $ do
preventDefault ev
token <- getAttr "data-token" activate
-- log $ "token: " <> token
2016-11-30 20:22:35 +00:00
salt <- getAttr "data-salt" activate
-- log $ "salt: " <> salt
2016-11-30 20:22:35 +00:00
fpassword1 <- getValue =<< select "#password1"
fpassword2 <- getValue =<< select "#password2"
let password1 = fromForeign fpassword1
password2 = fromForeign fpassword2
if not (isNothing password1 && isNothing password2)
then
if password1 == password2
then do
progress "Salting password"
-- log $ fromJust password1 <> " " <> salt
2016-12-03 02:14:13 +00:00
let salted = runFn2 hmacSha3 (fromUtf8 $ fromJust password1) (fromHex salt)
-- log salted
2016-11-30 20:22:35 +00:00
progress "Requesting account activation..."
2016-12-03 02:14:13 +00:00
let dat = UE.fromArray [ Tuple "salted" (Just salted) ]
2016-11-30 20:22:35 +00:00
_ <- runAff
(\e -> fail Activate $ show e)
(\x -> welcome x.response Activate)
$ post ("/activate/" <> token) dat
pure unit
else
fail Activate "Passwords must match"
else
fail Activate "Passwords error"