From 136767ab4fd936b3a1147b45c12ece9f4579bc17 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 3 Dec 2016 03:14:13 +0100 Subject: [PATCH] got it in working state --- Handler/Login.hs | 13 ++++---- src/Activate.purs | 38 +++++++++------------ src/Common.js | 24 +++++++++++--- src/Common.purs | 57 +++++++++++++++++--------------- src/Login.purs | 41 ++++++++++------------- templates/activate.hamlet | 4 +-- templates/login.hamlet | 6 ++-- templates/profileSettings.hamlet | 2 +- 8 files changed, 93 insertions(+), 92 deletions(-) diff --git a/Handler/Login.hs b/Handler/Login.hs index a626650..3ebdafe 100755 --- a/Handler/Login.hs +++ b/Handler/Login.hs @@ -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) diff --git a/src/Activate.purs b/src/Activate.purs index b011267..e55f700 100644 --- a/src/Activate.purs +++ b/src/Activate.purs @@ -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) diff --git a/src/Common.js b/src/Common.js index a89866f..faedf0b 100644 --- a/src/Common.js +++ b/src/Common.js @@ -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); +} diff --git a/src/Common.purs b/src/Common.purs index de3e12f..bac1aed 100644 --- a/src/Common.purs +++ b/src/Common.purs @@ -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 :: * diff --git a/src/Login.purs b/src/Login.purs index 31bf6d6..f035088 100644 --- a/src/Login.purs +++ b/src/Login.purs @@ -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) diff --git a/templates/activate.hamlet b/templates/activate.hamlet index 48acdfd..8696497 100755 --- a/templates/activate.hamlet +++ b/templates/activate.hamlet @@ -10,8 +10,8 @@ $newline always