Client login now handles response correctly.

[?]

Jan 18, 2016, 10:27 PM

HO2PFRABW6BBTE4MUKUTEGXCMJS46WGVBCNWOHO4OL52DVAB4YDAC

Dependencies

[2] EW2XN7KU Update docker build, clean up migration for payments tables.
[3] ARX7SHY5 Begin work on login UI.
[4] Z3M53KTL Adrift.
[5] RPAJLHMT Change to use UUIDs instead of ints for primary keys.
[6] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[7] MGOF7IUF Update TASKS list to reflect completed projects.
[8] BROSTG5K Beginning of modularization of server.
[9] NEDDHXUK Reformat via stylish-haskell
[10] O722AOKE Add route to allow crediting of events to users/projects.
[11] O5FVTOM6 Undo JSON silliness, enable a couple more routes.
[12] RB2ETNIF Add skeletal PureScript client project.
[13] IZEVQF62 Work in progress replacing sqlite with postgres.
[14] GCVQD44V Create amends endpoint, switch to UUID primary keys
[*] 4ZLEDBK7 Initial attempts at dockerizing, cabal isn't cooperating.
[*] DXIGERDT Change order of Docker build to avoid rebuilding the universe.
[*] V2VDN77H Enable postgres configuration via environment variable for Heroku.
[*] LCBJULKE Fix swapped default and key in QConfig.
[*] ADMKQQGC Initial empty Snap project.

Change contents

edit in Dockerfile at line 18

[2.249]

[17.1]

# apt-get install -y --no-install-recommends wget && \
# echo 'deb http://apt.postgresql.org/pub/repos/apt/ trusty-pgdg main' > /etc/apt/sources.list.d/pgdg.list && \
# wget --quiet -O - https://www.postgresql.org/media/keys/ACCC4CF8.asc | apt-key add - && \

# Install npm, then use it to get purescript, pulp and bower
RUN apt-get install -y --no-install-recommends nodejs
RUN apt-get install -y --no-install-recommends npm
RUN npm install -g npm
# Fix executable name used by the purescript npm installer
RUN ln -s /usr/bin/nodejs /usr/local/bin/node
edit in Dockerfile at line 61

[16.1082]

[16.1413]

# Build the client application and install it where snap can serve it
ADD ./client /opt/aftok/client
WORKDIR /opt/aftok/client
RUN npm install
RUN bower install
RUN pulp build
RUN pulp browserify --optimise --to dist/aftok.js
ADD ./dist /opt/aftok/server/static
replacement in client/src/Main.purs at line 5

[3.493]→[3.493:520](∅→∅)

import Control.Alt ((<|>))

[3.493]

[3.520]

--import Control.Alt ((<|>))
edit in client/src/Main.purs at line 9

[3.646]

[3.646]

import Control.Monad.Eff.Console (CONSOLE(), log)
replacement in client/src/Main.purs at line 11

[3.647]→[3.647:679](∅→∅)

import Data.Either (Either(..))

[3.647]

[3.679]

import Data.Maybe (Maybe(..))
--import Data.Either (Either(..))
replacement in client/src/Main.purs at line 14

[3.712]→[3.712:749](∅→∅)

import Data.Foreign.Class (readProp)

[3.712]

[3.749]

--import Data.Foreign.Class (readProp)
edit in client/src/Main.purs at line 16

[3.776]

[3.776]

import Data.Functor.Eff (liftEff)
replacement in client/src/Main.purs at line 26

[3.1052]→[3.1052:1094](∅→∅)

import Network.HTTP.Affjax (AJAX(), post)

[3.1052]

[3.1094]

import Network.HTTP.Affjax (AJAX(), affjax)
import Network.HTTP.Method
import Network.HTTP.StatusCode
replacement in client/src/Main.purs at line 43

[3.1428]→[3.1428:1486](∅→∅)

type AppEffects eff = HalogenEffects (ajax :: AJAX | eff)

[3.1428]

[3.1486]

type AppEffects eff = HalogenEffects (console :: CONSOLE, ajax :: AJAX | eff)
replacement in client/src/Main.purs at line 92

[3.3061]→[3.3061:3099](∅→∅)

_ <- liftAff' (fetchJS user pass)

[3.3061]

[3.3099]

result <- liftAff' (login user pass)
_ <- liftEff case result of
OK -> log "Login succeeded"
Forbidden -> log "Password incorrect"
Error m -> log m.message
edit in client/src/Main.purs at line 98

[3.3113]

[3.3113]

data LoginResponse
= OK
| Forbidden
| Error { status :: StatusCode, message :: String }
replacement in client/src/Main.purs at line 105

[3.3195]→[3.3195:3496](∅→∅)

fetchJS :: forall eff. String -> String -> Aff (ajax :: AJAX | eff) String
fetchJS user pass = do
result <- post "https://aftok.com/login" user
let response = result.response
return case readProp "js" response <|> readProp "error" response of
Right js -> js
Left _ -> "Invalid response"

[3.3195]

[4.463]

login :: forall eff. String -> String -> Aff (ajax :: AJAX | eff) LoginResponse
login user pass = do
result <- affjax $ { method: POST
, url: "/login"
, headers: []
, content: Nothing :: Maybe String
, username: Just user
, password: Just pass
}
pure $ case result.status of
StatusCode 403 -> Forbidden
StatusCode 200 -> OK
other -> Error { status: other , message: result.response }
edit in server/Aftok/QConfig.hs at line 32

[4.7230]

[4.7230]

, staticAssetPath :: System.IO.FilePath
edit in server/Aftok/QConfig.hs at line 66

[19.83]

[4.7968]

<*> C.lookupDefault "/opt/aftok/server/static/" cfg "staticAssetPath"
edit in server/Main.hs at line 24

[4.11663]→[4.11663:11724](∅→∅)

import Snap.Snaplet.Auth.Backends.PostgresqlSimple
edit in server/Main.hs at line 25

[4.11771]

[4.11771]

import Snap.Snaplet.Auth.Backends.PostgresqlSimple
edit in server/Main.hs at line 27

[4.11832]

[4.314]

import Snap.Util.FileServe (serveDirectory)
replacement in server/Main.hs at line 43

[4.2275]→[4.1689:1884](∅→∅)

let loginRoute = requireLogin >> redirect "/home"
registerRoute = void $ method POST registerHandler
acceptInviteRoute = void $ method POST acceptInvitationHandler

[4.2275]

[4.212]

let loginRoute = method GET requireLogin >> redirect "/home"
xhrLoginRoute = void $ method POST requireLogin
registerRoute = void $ method POST registerHandler
acceptInviteRoute = void $ method POST acceptInvitationHandler
edit in server/Main.hs at line 68

[4.2979]

[4.2569]

addRoutes [ ("static", serveDirectory $ staticAssetPath cfg)
replacement in server/Main.hs at line 71

[4.2570]→[4.11875:11923](∅→∅)

addRoutes [ ("login", loginRoute)

[4.2570]

[4.265]

, ("login", loginRoute)
, ("login", xhrLoginRoute)