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

View file

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

View file

@ -3,21 +3,35 @@
var CryptoJS = require('crypto-js');
exports.hmacSha3 = function(msg, key) {
var wamsg = CryptoJS.enc.Utf8.parse(msg);
var wakey = CryptoJS.enc.Utf8.parse(key);
var hmac = CryptoJS.HmacSHA3(wamsg, wakey);
var hmac = CryptoJS.HmacSHA3(msg, key);
//console.log("bla");
//console.log(hmac.toString());
//console.log(CryptoJS.enc.Utf8.stringify(hmac));
return hmac.toString();
}
exports.setLocation = function(newLoc) {
window.location = newloc;
window.location = newLoc;
return null;
}
exports.getAttr = function(attr) {
return function(ob) {
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
import Prelude
import Control.Monad.Aff
import Prelude (Unit, bind, pure, ($), (<$>), (=<<))
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.JQuery
import Control.Monad.Except
import Control.Monad.Eff.JQuery (JQuery, display, select, setProp, setText)
import Control.Monad.Except (runExcept)
import DOM (DOM)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Maybe
import Data.Either
import Data.Tuple (Tuple(..))
import Data.Function.Uncurried (Fn2)
import Data.Maybe (Maybe(..))
import Data.Either (Either(..), either)
import Data.Foreign as F
import Data.Unit
import Data.Argonaut as A
import Data.Argonaut (class DecodeJson, decodeJson, (.?), Json) as A
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
= Login
@ -36,8 +20,9 @@ welcome :: forall eff. A.Json -> Elem -> Eff (dom :: DOM | eff) Unit
welcome j elem = do
let eitherWelcome = decodeJson j
case eitherWelcome of
Left e ->
fail elem e
Left _ -> do
let eitherErr = decodeJson j
either (fail elem) (\(Err e) -> fail elem e.err) eitherErr
Right (Welcome welc) -> do
progress "welcome to Eidolon"
setLocation welc.link
@ -78,17 +63,35 @@ instance decodeJsonWelcome :: DecodeJson Welcome where
link <- obj .? "welcome"
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 = case runExcept (F.readString f) of
Left e -> Nothing
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 getAttr
:: forall eff a
:: forall eff
. String
-> JQuery
-> 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
import Prelude
import Control.Monad.Aff
import Prelude (Unit, bind, not, pure, show, unit, ($), (&&), (<$>), (<>), (=<<))
import Control.Monad.Aff (runAff)
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log)
import Control.Monad.Eff.JQuery
import Control.Monad.Except
import Control.Monad.Eff.JQuery (JQuery, JQueryEvent, getValue, hide, on, preventDefault, ready, select, setProp)
import DOM (DOM)
import Data.Function.Uncurried (Fn2, runFn2)
import Data.Maybe
import Data.Either
import Data.Function.Uncurried (runFn2)
import Data.Maybe (Maybe(..), fromJust, isNothing)
import Data.Either (Either(..))
import Data.Tuple (Tuple(..))
import Data.Unit
import Data.Argonaut as A
import Data.Argonaut.Decode
import Data.Argonaut.Decode (decodeJson)
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 Network.HTTP.Affjax (AJAX, post)
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 = do
@ -69,10 +60,10 @@ onLoginClick login ev x = unsafePartial $ do
if not (isNothing username && isNothing password)
then do
progress "Obtaining Challenge..."
let data1 = UE.encode (UE.fromArray $ [ Tuple "username" username ]) :: String
let data1 = UE.fromArray $ [ Tuple "username" username ]
_ <- runAff
(\e -> fail Login $ show e)
(\x -> resp1Success (fromJust password) x.response)
(\y -> resp1Success (fromJust password) y.response)
$ post "/login" data1
log "success so far"
else
@ -93,11 +84,13 @@ resp1Success pass j = do
fail Login e
Right (Challenge challenge) -> do
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"
let response = runFn2 hmacSha3 salted challenge.token
let response = runFn2 hmacSha3 (fromUtf8 salted) (fromUtf8 challenge.token)
log $ "resp: " <> 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
(\e -> fail Login $ show e)
(\x -> welcome x.response Login)

View file

@ -11,7 +11,7 @@ $newline always
<input #password2 type="password" required>
<p #progress>
<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/jsSHA.js" type="text/javascript">

View file

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

View file

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