eidolon/src/Login.purs

102 lines
3 KiB
Plaintext
Raw Normal View History

2016-11-30 20:22:35 +00:00
module Login 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, getValue, hide, on, preventDefault, ready, select, setProp)
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-12-03 18:09:22 +00:00
import Data.Either (Either(..), either)
2016-11-30 20:22:35 +00:00
import Data.Tuple (Tuple(..))
import Data.Argonaut as A
2016-12-03 02:14:13 +00:00
import Data.Argonaut.Decode (decodeJson)
2016-11-30 20:22:35 +00:00
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 18:17:36 +00:00
import Common (Challenge(..), Elem(..), Err(..), fail, fromForeign, fromHex, fromUtf8, 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
log "logging in"
2016-12-03 20:53:55 +00:00
display =<< select ".js-hidden"
hide =<< select ".noscript"
2016-11-30 20:22:35 +00:00
login <- select "#login"
on "click" (onLoginClick login) login
onLoginClick
:: forall eff. JQuery
-> JQueryEvent
-> JQuery
-> Eff ( dom :: DOM
, console :: CONSOLE
, ajax :: AJAX
| eff
) Unit
onLoginClick login ev x = unsafePartial $ do
log "click!"
preventDefault ev
hide login
setProp "disabled" true <$> select ".login input"
fusername <- getValue =<< select "#username"
fpassword <- getValue =<< select "#password"
let username = fromForeign fusername
password = fromForeign fpassword
if not (isNothing username && isNothing password)
then do
progress "Obtaining Challenge..."
2016-12-03 02:14:13 +00:00
let data1 = UE.fromArray $ [ Tuple "username" username ]
2016-11-30 20:22:35 +00:00
_ <- runAff
(\e -> fail Login $ show e)
2016-12-03 02:14:13 +00:00
(\y -> resp1Success (fromJust password) y.response)
2016-11-30 20:22:35 +00:00
$ post "/login" data1
log "success so far"
else
log "error"
resp1Success :: forall eff. String
-> A.Json
-> Eff ( dom :: DOM
, console :: CONSOLE
, ajax :: AJAX
| eff
) Unit
resp1Success pass j = do
log $ show j
let eitherChallenge = decodeJson j
case eitherChallenge of
2016-12-03 18:14:34 +00:00
Left _ -> do
2016-12-03 18:06:24 +00:00
let eitherErr = decodeJson j
either (fail Login) (\(Err e) -> fail Login e.err) eitherErr
2016-11-30 20:22:35 +00:00
Right (Challenge challenge) -> do
progress "HMAC 1"
2016-12-03 02:14:13 +00:00
let salted = runFn2 hmacSha3 (fromUtf8 pass) (fromHex challenge.salt)
-- log $ "salted: " <> salted
2016-11-30 20:22:35 +00:00
progress "HMAC 2"
2016-12-03 02:14:13 +00:00
let response = runFn2 hmacSha3 (fromUtf8 salted) (fromUtf8 challenge.token)
-- log $ "resp: " <> response
2016-11-30 20:22:35 +00:00
progress "sending response"
2016-12-03 02:14:13 +00:00
let data2 = UE.fromArray $ [ Tuple "token" (Just challenge.token), Tuple "response" (Just response) ]
2016-11-30 20:22:35 +00:00
_ <- runAff
(\e -> fail Login $ show e)
(\x -> welcome x.response Login)
$ post "/login" data2
pure unit