first drafts
This commit is contained in:
parent
fc6af46a11
commit
5521e1a01d
5 changed files with 157 additions and 0 deletions
6
.gitignore
vendored
6
.gitignore
vendored
|
@ -14,3 +14,9 @@ cabal.sandbox.config
|
||||||
*.swp
|
*.swp
|
||||||
static/data*
|
static/data*
|
||||||
.stack-work*
|
.stack-work*
|
||||||
|
/bower_components/
|
||||||
|
/node_modules/
|
||||||
|
/.pulp-cache/
|
||||||
|
/output/
|
||||||
|
/.psc*
|
||||||
|
/.psa*
|
||||||
|
|
24
Makefile
Normal file
24
Makefile
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
clean:
|
||||||
|
cabal clean
|
||||||
|
rm -r bower_components
|
||||||
|
rm -r node_modules
|
||||||
|
rm ./static/js/purs.js
|
||||||
|
|
||||||
|
hsdeps:
|
||||||
|
cabal install --only-dependencies
|
||||||
|
|
||||||
|
hsbuild: hsdeps
|
||||||
|
cabal build
|
||||||
|
|
||||||
|
pursdeps: cryptojs
|
||||||
|
bower install
|
||||||
|
|
||||||
|
cryptojs:
|
||||||
|
npm install crypto-js
|
||||||
|
npm install react
|
||||||
|
npm install react-dom
|
||||||
|
|
||||||
|
pursbuild: purdeps
|
||||||
|
pulp browserify -O > ./static/js/purs.js
|
||||||
|
|
||||||
|
all: hsbuild pursbuild
|
24
bower.json
Normal file
24
bower.json
Normal file
|
@ -0,0 +1,24 @@
|
||||||
|
{
|
||||||
|
"name": "eidolon",
|
||||||
|
"ignore": [
|
||||||
|
"**/.*",
|
||||||
|
"node_modules",
|
||||||
|
"bower_components",
|
||||||
|
"output"
|
||||||
|
],
|
||||||
|
"dependencies": {
|
||||||
|
"purescript-prelude": "^2.1.0",
|
||||||
|
"purescript-console": "^2.0.0",
|
||||||
|
"purescript-functions": "^2.0.0",
|
||||||
|
"purescript-jquery": "^3.0.0",
|
||||||
|
"purescript-affjax": "^3.0.1",
|
||||||
|
"purescript-form-urlencoded": "^2.0.0",
|
||||||
|
"purescript-argonaut": "^2.0.0",
|
||||||
|
"purescript-react": "^2.0.0",
|
||||||
|
"purescript-react-dom": "^2.0.0",
|
||||||
|
"purescript-dom": "^3.2.0"
|
||||||
|
},
|
||||||
|
"devDependencies": {
|
||||||
|
"purescript-psci-support": "^2.0.0"
|
||||||
|
}
|
||||||
|
}
|
10
src/Main.js
Normal file
10
src/Main.js
Normal file
|
@ -0,0 +1,10 @@
|
||||||
|
"use strict";
|
||||||
|
|
||||||
|
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);
|
||||||
|
return hmac.toString();
|
||||||
|
}
|
93
src/Main.purs
Normal file
93
src/Main.purs
Normal file
|
@ -0,0 +1,93 @@
|
||||||
|
module Main where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
import Control.Monad.Eff (Eff)
|
||||||
|
import Control.Monad.Eff.Console (CONSOLE, log)
|
||||||
|
import Control.Monad.Eff.JQuery
|
||||||
|
import Control.Monad.Except
|
||||||
|
|
||||||
|
import DOM (DOM)
|
||||||
|
|
||||||
|
import Data.Function.Uncurried (Fn2, runFn2)
|
||||||
|
import Data.Maybe
|
||||||
|
import Data.Either
|
||||||
|
import Data.Tuple (Tuple(..))
|
||||||
|
import Data.Foreign
|
||||||
|
|
||||||
|
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 Network.HTTP.Affjax (get, post)
|
||||||
|
|
||||||
|
import Data.FormURLEncoded as UE
|
||||||
|
|
||||||
|
-- main :: forall e. Eff (console :: CONSOLE | e) Unit
|
||||||
|
-- main = do
|
||||||
|
-- log "Hello sailor!"
|
||||||
|
|
||||||
|
main :: forall eff. Eff ( dom :: DOM
|
||||||
|
, console :: CONSOLE
|
||||||
|
| eff
|
||||||
|
) Unit
|
||||||
|
main =
|
||||||
|
ready $ do
|
||||||
|
hide <$> select "#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..."
|
||||||
|
|
||||||
|
let data1 = UE.encode (UE.fromArray $ [ Tuple "username" username ]) :: String
|
||||||
|
|
||||||
|
-- resp1 <- post "/login" data1
|
||||||
|
-- (Challenge challenge) <- decodeJson resp1.response
|
||||||
|
|
||||||
|
progress "HMAC 1"
|
||||||
|
|
||||||
|
-- let salted = runFn2 hmacSha3 (fromJust password) challenge.salt
|
||||||
|
|
||||||
|
log "bla"
|
||||||
|
else
|
||||||
|
log "error"
|
||||||
|
|
||||||
|
progress :: forall eff. String -> Eff (dom :: DOM | eff) Unit
|
||||||
|
progress s = do
|
||||||
|
setText s =<< select "#progress"
|
||||||
|
|
||||||
|
fail :: forall eff. String -> Eff (dom :: DOM | eff) Unit
|
||||||
|
fail s = do
|
||||||
|
progress s
|
||||||
|
setProp "disabled" false <$> select ".login input"
|
||||||
|
display =<< select "#login"
|
||||||
|
|
||||||
|
data Challenge = Challenge
|
||||||
|
{ salt :: String
|
||||||
|
, token :: String
|
||||||
|
}
|
||||||
|
|
||||||
|
instance decodeJsonChallenge :: DecodeJson Challenge where
|
||||||
|
decodeJson j = do
|
||||||
|
obj <- decodeJson j
|
||||||
|
salt <- obj .? "salt"
|
||||||
|
token <- obj .? "token"
|
||||||
|
pure $ Challenge { salt, token }
|
||||||
|
|
||||||
|
fromForeign :: Foreign -> Maybe String
|
||||||
|
fromForeign f = case runExcept (readString f) of
|
||||||
|
Left e -> Nothing
|
||||||
|
Right s -> Just s
|
||||||
|
|
||||||
|
foreign import hmacSha3 :: Fn2 String String String
|
Loading…
Reference in a new issue