got it in working state

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)
+            let expected = hmacKeccak (encodeUtf8 $ toHex $ tokenToken token) (encodeUtf8 hexSalted)
-            if
+            if encodeUtf8 hexResponse == expected
-              fromHex' (T.unpack 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
+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)

src/Activate.purs

@@ -1,37 +1,24 @@
 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.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 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.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 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)

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 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();
 }
 
 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);
+}

src/Common.purs

@@ -1,32 +1,16 @@
 module Common where
 
-import Prelude
+import Prelude (Unit, bind, pure, ($), (<$>), (=<<))
-import Control.Monad.Aff
 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 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.Unit
+import Data.Argonaut (class DecodeJson, decodeJson, (.?), Json) as A
-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 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 ->
+    Left _ -> do
-      fail elem e
+      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 :: *

src/Login.purs

@@ -1,37 +1,28 @@
 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.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 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.Unit
 
 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 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)

templates/activate.hamlet

@@ -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">

templates/login.hamlet

@@ -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?

templates/profileSettings.hamlet

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