got it in working state

This commit is contained in:
nek0 2016-12-03 03:14:13 +01:00
parent 05f2826745
commit 136767ab4f
8 changed files with 93 additions and 92 deletions

View file

@ -25,9 +25,9 @@ import Crypto.Hash.CryptoAPI (SHA1)
-- new hmac -- new hmac
import Crypto.MAC.HMAC as New import Crypto.MAC.HMAC as New
import Crypto.Hash.Algorithms (SHA3_512) import Crypto.Hash.Algorithms (Keccak_512)
import Data.Text.Encoding (encodeUtf8) import Data.Text.Encoding (encodeUtf8, decodeUtf8)
import Data.Serialize (encode) import Data.Serialize (encode)
import Data.Maybe import Data.Maybe
import qualified Data.ByteString as B import qualified Data.ByteString as B
@ -73,9 +73,8 @@ postLoginR = do
queriedUser <- runDB $ getJust (fromJust savedUserId) queriedUser <- runDB $ getJust (fromJust savedUserId)
let salted = userSalted queriedUser let salted = userSalted queriedUser
let hexSalted = toHex salted let hexSalted = toHex salted
let expected = hmacSHA3 (tokenToken token) (encodeUtf8 hexSalted) let expected = hmacKeccak (encodeUtf8 $ toHex $ tokenToken token) (encodeUtf8 hexSalted)
if if encodeUtf8 hexResponse == expected
fromHex' (T.unpack hexResponse) == expected
then do then do
-- Success!! -- Success!!
runDB $ delete tokenId runDB $ delete tokenId
@ -120,5 +119,5 @@ hmacSHA1 keyData msgData =
sha1 = hmac' key msgData sha1 = hmac' key msgData
in encode sha1 in encode sha1
hmacSHA3 :: B.ByteString -> B.ByteString -> B.ByteString hmacKeccak :: B.ByteString -> B.ByteString -> B.ByteString
hmacSHA3 key msg = BC.pack $ show $ hmacGetDigest (New.hmac key msg :: HMAC SHA3_512) hmacKeccak key msg = BC.pack $ show $ hmacGetDigest (New.hmac key msg :: HMAC Keccak_512)

View file

@ -1,37 +1,24 @@
module Activate where module Activate where
import Prelude import Prelude (Unit, bind, not, pure, show, unit, ($), (&&), (<>), (=<<), (==))
import Control.Monad.Aff import Control.Monad.Aff (runAff)
import Control.Monad.Eff (Eff) import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log) import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.JQuery import Control.Monad.Eff.JQuery (JQuery, JQueryEvent, getValue, on, preventDefault, ready, select)
import Control.Monad.Except
import DOM (DOM) import DOM (DOM)
import Data.Function.Uncurried (Fn2, runFn2) import Data.Function.Uncurried (runFn2)
import Data.Maybe import Data.Maybe (Maybe(..), fromJust, isNothing)
import Data.Either
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Unit
import Data.Argonaut as A import Network.HTTP.Affjax (AJAX, post)
import Data.Argonaut.Decode
import React as R
import React.DOM as R
import React.DOM.Props as RP
import ReactDOM as RDOM
import DOM.Node.Element
import Network.HTTP.Affjax
import Data.FormURLEncoded as UE import Data.FormURLEncoded as UE
import Partial.Unsafe import Partial.Unsafe (unsafePartial)
import Common import Common (Elem(..), fail, fromForeign, fromHex, fromUtf8, getAttr, hmacSha3, progress, welcome)
-- main :: forall e. Eff (console :: CONSOLE | e) Unit -- main :: forall e. Eff (console :: CONSOLE | e) Unit
-- main = do -- main = do
@ -44,6 +31,7 @@ main :: forall eff. Eff ( ajax :: AJAX
) Unit ) Unit
main = main =
ready $ do ready $ do
log "activating"
activate <- select "#activate" activate <- select "#activate"
on "click" (onActivateClick activate) activate on "click" (onActivateClick activate) activate
@ -59,7 +47,9 @@ onActivateClick
onActivateClick activate ev _ = unsafePartial $ do onActivateClick activate ev _ = unsafePartial $ do
preventDefault ev preventDefault ev
token <- getAttr "data-token" activate token <- getAttr "data-token" activate
log $ "token: " <> token
salt <- getAttr "data-salt" activate salt <- getAttr "data-salt" activate
log $ "salt: " <> salt
fpassword1 <- getValue =<< select "#password1" fpassword1 <- getValue =<< select "#password1"
fpassword2 <- getValue =<< select "#password2" fpassword2 <- getValue =<< select "#password2"
let password1 = fromForeign fpassword1 let password1 = fromForeign fpassword1
@ -69,9 +59,11 @@ onActivateClick activate ev _ = unsafePartial $ do
if password1 == password2 if password1 == password2
then do then do
progress "Salting password" progress "Salting password"
let salted = runFn2 hmacSha3 (fromJust password1) salt log $ fromJust password1 <> " " <> salt
let salted = runFn2 hmacSha3 (fromUtf8 $ fromJust password1) (fromHex salt)
log salted
progress "Requesting account activation..." progress "Requesting account activation..."
let dat = UE.encode (UE.fromArray [ Tuple "salted" (Just salted) ]) :: String let dat = UE.fromArray [ Tuple "salted" (Just salted) ]
_ <- runAff _ <- runAff
(\e -> fail Activate $ show e) (\e -> fail Activate $ show e)
(\x -> welcome x.response Activate) (\x -> welcome x.response Activate)

View file

@ -3,21 +3,35 @@
var CryptoJS = require('crypto-js'); var CryptoJS = require('crypto-js');
exports.hmacSha3 = function(msg, key) { exports.hmacSha3 = function(msg, key) {
var wamsg = CryptoJS.enc.Utf8.parse(msg); var hmac = CryptoJS.HmacSHA3(msg, key);
var wakey = CryptoJS.enc.Utf8.parse(key); //console.log("bla");
var hmac = CryptoJS.HmacSHA3(wamsg, wakey); //console.log(hmac.toString());
//console.log(CryptoJS.enc.Utf8.stringify(hmac));
return hmac.toString(); return hmac.toString();
} }
exports.setLocation = function(newLoc) { exports.setLocation = function(newLoc) {
window.location = newloc; window.location = newLoc;
return null; return null;
} }
exports.getAttr = function(attr) { exports.getAttr = function(attr) {
return function(ob) { return function(ob) {
return function() { return function() {
ob.attr(attr); return ob.attr(attr);
}; };
}; };
}; };
exports.toHex = function(str) {
var repr = parseInt(str, 16);
return repr.toString(16);
}
exports.fromHex = function(str) {
return CryptoJS.enc.Hex.parse(str);
}
exports.fromUtf8 = function(str) {
return CryptoJS.enc.Utf8.parse(str);
}

View file

@ -1,32 +1,16 @@
module Common where module Common where
import Prelude import Prelude (Unit, bind, pure, ($), (<$>), (=<<))
import Control.Monad.Aff
import Control.Monad.Eff (Eff) import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log) import Control.Monad.Eff.JQuery (JQuery, display, select, setProp, setText)
import Control.Monad.Eff.JQuery import Control.Monad.Except (runExcept)
import Control.Monad.Except
import DOM (DOM) import DOM (DOM)
import Data.Function.Uncurried (Fn2, runFn2) import Data.Function.Uncurried (Fn2)
import Data.Maybe import Data.Maybe (Maybe(..))
import Data.Either import Data.Either (Either(..), either)
import Data.Tuple (Tuple(..))
import Data.Foreign as F import Data.Foreign as F
import Data.Unit import Data.Argonaut (class DecodeJson, decodeJson, (.?), Json) as A
import Data.Argonaut as A
import Data.Argonaut.Decode import Data.Argonaut.Decode
import React as R
import React.DOM as R
import React.DOM.Props as RP
import ReactDOM as RDOM
import DOM.Node.Element
import Network.HTTP.Affjax
import Data.FormURLEncoded as UE
import Partial.Unsafe
data Elem data Elem
= Login = Login
@ -36,8 +20,9 @@ welcome :: forall eff. A.Json -> Elem -> Eff (dom :: DOM | eff) Unit
welcome j elem = do welcome j elem = do
let eitherWelcome = decodeJson j let eitherWelcome = decodeJson j
case eitherWelcome of case eitherWelcome of
Left e -> Left _ -> do
fail elem e let eitherErr = decodeJson j
either (fail elem) (\(Err e) -> fail elem e.err) eitherErr
Right (Welcome welc) -> do Right (Welcome welc) -> do
progress "welcome to Eidolon" progress "welcome to Eidolon"
setLocation welc.link setLocation welc.link
@ -78,17 +63,35 @@ instance decodeJsonWelcome :: DecodeJson Welcome where
link <- obj .? "welcome" link <- obj .? "welcome"
pure $ Welcome { link } pure $ Welcome { link }
data Err = Err
{ err :: String
}
instance decodeJsonErr :: DecodeJson Err where
decodeJson j = do
obj <- decodeJson j
error <- obj .? "error"
pure $ Err { err: error }
fromForeign :: F.Foreign -> Maybe String fromForeign :: F.Foreign -> Maybe String
fromForeign f = case runExcept (F.readString f) of fromForeign f = case runExcept (F.readString f) of
Left e -> Nothing Left e -> Nothing
Right s -> Just s Right s -> Just s
foreign import hmacSha3 :: Fn2 String String String foreign import hmacSha3 :: Fn2 WordArray WordArray String
foreign import setLocation :: forall eff. String -> Eff (dom :: DOM | eff) Unit foreign import setLocation :: forall eff. String -> Eff (dom :: DOM | eff) Unit
foreign import getAttr foreign import getAttr
:: forall eff a :: forall eff
. String . String
-> JQuery -> JQuery
-> Eff (dom :: DOM | eff) String -> Eff (dom :: DOM | eff) String
foreign import toHex :: String -> String
foreign import fromHex :: String -> WordArray
foreign import fromUtf8 :: String -> WordArray
foreign import data WordArray :: *

View file

@ -1,37 +1,28 @@
module Login where module Login where
import Prelude import Prelude (Unit, bind, not, pure, show, unit, ($), (&&), (<$>), (<>), (=<<))
import Control.Monad.Aff import Control.Monad.Aff (runAff)
import Control.Monad.Eff (Eff) import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log) import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.JQuery import Control.Monad.Eff.JQuery (JQuery, JQueryEvent, getValue, hide, on, preventDefault, ready, select, setProp)
import Control.Monad.Except
import DOM (DOM) import DOM (DOM)
import Data.Function.Uncurried (Fn2, runFn2) import Data.Function.Uncurried (runFn2)
import Data.Maybe import Data.Maybe (Maybe(..), fromJust, isNothing)
import Data.Either import Data.Either (Either(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Data.Unit
import Data.Argonaut as A import Data.Argonaut as A
import Data.Argonaut.Decode import Data.Argonaut.Decode (decodeJson)
import React as R import Network.HTTP.Affjax (AJAX, post)
import React.DOM as R
import React.DOM.Props as RP
import ReactDOM as RDOM
import DOM.Node.Element
import Network.HTTP.Affjax
import Data.FormURLEncoded as UE import Data.FormURLEncoded as UE
import Partial.Unsafe import Partial.Unsafe (unsafePartial)
import Common import Common (Challenge(..), Elem(..), fail, fromForeign, fromHex, fromUtf8, hmacSha3, progress, welcome)
-- main :: forall e. Eff (console :: CONSOLE | e) Unit -- main :: forall e. Eff (console :: CONSOLE | e) Unit
-- main = do -- main = do
@ -69,10 +60,10 @@ onLoginClick login ev x = unsafePartial $ do
if not (isNothing username && isNothing password) if not (isNothing username && isNothing password)
then do then do
progress "Obtaining Challenge..." progress "Obtaining Challenge..."
let data1 = UE.encode (UE.fromArray $ [ Tuple "username" username ]) :: String let data1 = UE.fromArray $ [ Tuple "username" username ]
_ <- runAff _ <- runAff
(\e -> fail Login $ show e) (\e -> fail Login $ show e)
(\x -> resp1Success (fromJust password) x.response) (\y -> resp1Success (fromJust password) y.response)
$ post "/login" data1 $ post "/login" data1
log "success so far" log "success so far"
else else
@ -93,11 +84,13 @@ resp1Success pass j = do
fail Login e fail Login e
Right (Challenge challenge) -> do Right (Challenge challenge) -> do
progress "HMAC 1" progress "HMAC 1"
let salted = runFn2 hmacSha3 pass challenge.salt let salted = runFn2 hmacSha3 (fromUtf8 pass) (fromHex challenge.salt)
log $ "salted: " <> salted
progress "HMAC 2" progress "HMAC 2"
let response = runFn2 hmacSha3 salted challenge.token let response = runFn2 hmacSha3 (fromUtf8 salted) (fromUtf8 challenge.token)
log $ "resp: " <> response
progress "sending response" progress "sending response"
let data2 = UE.encode (UE.fromArray $ [ Tuple "token" (Just challenge.token), Tuple "response" (Just response) ]) :: String let data2 = UE.fromArray $ [ Tuple "token" (Just challenge.token), Tuple "response" (Just response) ]
_ <- runAff _ <- runAff
(\e -> fail Login $ show e) (\e -> fail Login $ show e)
(\x -> welcome x.response Login) (\x -> welcome x.response Login)

View file

@ -10,8 +10,8 @@ $newline always
<label for="password2">Confirm your password: <label for="password2">Confirm your password:
<input #password2 type="password" required> <input #password2 type="password" required>
<p #progress> <p #progress>
<div .form-group .optional> <div .form-group .optional>
<button #activate data-token="#{token}" data-salt="#{hexSalt}">Activate <button #activate type="submit" data-token="#{token}" data-salt="#{hexSalt}">Activate
<script src="/static/js/jquery.min.js" type="text/javascript"> <script src="/static/js/jquery.min.js" type="text/javascript">
<script src="/static/js/jsSHA.js" type="text/javascript"> <script src="/static/js/jsSHA.js" type="text/javascript">

View file

@ -9,9 +9,9 @@ $newline always
<div .form-group .required> <div .form-group .required>
<label for="password">Password: <label for="password">Password:
<input .form-control #password type="password" required> <input .form-control #password type="password" required>
<div .form-group .optional> <div .form-group .optional>
<button .btn .btn-default #login>Login <button .btn .btn-default type="submit" #login>Login
<div #progress> <div #progress>
<a href=@{ReactivateR}>Forgot your Password? <a href=@{ReactivateR}>Forgot your Password?

View file

@ -1,5 +1,5 @@
$newline always $newline always
<div .item> <div .medium>
<form method="post" enctype=#{enctype}> <form method="post" enctype=#{enctype}>
<h3>Profile settings <h3>Profile settings
^{profileSettingsWidget} ^{profileSettingsWidget}