Split Login component into its own module.

[?]

Jan 22, 2016, 4:37 AM

EA5BFM5GMM7KNMDLTVOSUKVKMSIDD72TAFVHDVGEOUY5VELECU3QC

Dependencies

[2] HO2PFRAB Client login now handles response correctly.
[3] ARX7SHY5 Begin work on login UI.
[4] RB2ETNIF Add skeletal PureScript client project.

Change contents

file addition: Aftok (d--r------)

[3.393]
file addition: Login.purs (----------)

[0.1]

module Aftok.Login where

import Prelude

import Control.Monad.Aff (Aff())

import Data.Maybe (Maybe(..))
import Data.Functor (($>))

import Halogen
import Halogen.HTML.Core (className)
import qualified Halogen.HTML.Indexed as H
import qualified Halogen.HTML.Events.Indexed as E
import qualified Halogen.HTML.Properties.Indexed as P

import Network.HTTP.Affjax (AJAX(), affjax)
import Network.HTTP.Method
import Network.HTTP.StatusCode

type LoginState = { username :: String, password :: String }

initialState :: LoginState
initialState = { username: "", password: "" }

-- | The component query algebra.
data LoginAction a
= SetUsername String a
| SetPassword String a
| Login String String a

-- | The effects used in the login component.
type LoginEffects eff = HalogenEffects (ajax :: AJAX | eff)

-- | The definition for the app's main UI component.
ui :: forall eff. Component LoginState LoginAction (Aff (LoginEffects eff))
ui = component render eval
where

render :: LoginState -> ComponentHTML LoginAction
render st =
H.div
[ P.classes (className <$> ["panel", "panel-primary"]) ]
[ H.div
[ P.classes [ className "panel-heading" ] ]
[ H.h3 [ P.classes [ className "panel-title" ]] [ H.text "Aftok Login" ] ]
, H.div
[ P.classes [ className "panel-body" ] ]
[
H.h2_
[ H.text "username:" ]
, H.p_
[ H.input
[ P.value st.username
, P.inputType P.InputText
, E.onValueInput (E.input SetUsername)
]
]
, H.h2_
[ H.text "password:" ]
, H.p_
[ H.input
[ P.value st.password
, P.inputType P.InputPassword
, E.onValueInput (E.input SetPassword)
]
]
, H.p_
[ H.button
[ P.classes (className <$> ["btn", "btn-primary"])
, E.onClick (E.input_ (Login st.username st.password))
]
[ H.text "Login" ]
]
]
]

eval :: Natural LoginAction (ComponentDSL LoginState LoginAction (Aff (LoginEffects eff)))
eval (SetUsername user next) = modify (_ { username = user }) $> next
eval (SetPassword pass next) = modify (_ { password = pass }) $> next
eval (Login user pass next) = do
result <- liftAff' (login user pass)
pure next

data LoginResponse
= OK
| Forbidden
| Error { status :: StatusCode, message :: String }

-- | Post credentials to the login service and interpret the response
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 client/src/Main.purs at line 5

[3.493]→[2.833:862](∅→∅),[2.862]→[3.520:561](∅→∅),[3.520]→[3.520:561](∅→∅)

--import Control.Alt ((<|>))
import Control.Monad.Aff (Aff(), runAff)
replacement in client/src/Main.purs at line 7

[3.646]→[2.863:913](∅→∅)

import Control.Monad.Eff.Console (CONSOLE(), log)

[3.646]

[3.646]

import Control.Monad.Eff.Console (CONSOLE())
import Control.Monad.Aff (runAff)
edit in client/src/Main.purs at line 10

[3.647]→[2.914:978](∅→∅),[2.978]→[3.679:712](∅→∅),[3.679]→[3.679:712](∅→∅),[3.712]→[2.979:1018](∅→∅),[2.1018]→[3.749:776](∅→∅),[3.749]→[3.749:776](∅→∅),[3.776]→[2.1019:1053](∅→∅),[2.1053]→[3.776:809](∅→∅),[3.776]→[3.776:809](∅→∅)

import Data.Maybe (Maybe(..))
--import Data.Either (Either(..))
--import Data.Foldable (foldMap)
--import Data.Foreign.Class (readProp)
import Data.Functor (($>))
import Data.Functor.Eff (liftEff)
--import Data.Maybe (Maybe(..))
replacement in client/src/Main.purs at line 12

[3.867]→[3.867:1052](∅→∅),[3.1052]→[2.1054:1158](∅→∅)

import Halogen.HTML.Core (className)
import qualified Halogen.HTML.Indexed as H
import qualified Halogen.HTML.Events.Indexed as E
import qualified Halogen.HTML.Properties.Indexed as P

import Network.HTTP.Affjax (AJAX(), affjax)
import Network.HTTP.Method
import Network.HTTP.StatusCode

[3.867]

[3.1094]

import Halogen.Util (appendToBody, onLoad)
import qualified Aftok.Login as L
replacement in client/src/Main.purs at line 15

[3.1095]→[3.1095:1189](∅→∅)

-- | The state of the component.
type LoginState = { username :: String, password :: String }

[3.1095]

[3.1189]

import Network.HTTP.Affjax (AJAX())
edit in client/src/Main.purs at line 17

[3.1190]→[3.1190:1428](∅→∅)

initialState :: LoginState
initialState = { username: "", password: "" }

-- | The component query algebra.
data LoginAction a
= SetUsername String a
| SetPassword String a
| Login String String a

-- | The effects used in the app.
edit in client/src/Main.purs at line 19

[3.1487]→[3.1487:1649](∅→∅),[3.1649]→[3.429:430](∅→∅),[3.429]→[3.429:430](∅→∅),[3.430]→[3.1650:3061](∅→∅),[3.3061]→[2.1238:1423](∅→∅),[2.1423]→[3.3099:3113](∅→∅),[3.3099]→[3.3099:3113](∅→∅),[3.3113]→[2.1424:1522](∅→∅),[2.1522]→[3.3113:3195](∅→∅),[3.3113]→[3.3113:3195](∅→∅),[3.3195]→[2.1523:2050](∅→∅),[2.2050]→[3.463:464](∅→∅),[3.3496]→[3.463:464](∅→∅),[3.463]→[3.463:464](∅→∅),[3.464]→[3.3497:3515](∅→∅)

-- | The definition for the app's main UI component.
ui :: forall eff. Component LoginState LoginAction (Aff (AppEffects eff))
ui = component render eval
where

render :: LoginState -> ComponentHTML LoginAction
render st =
H.div
[ P.classes (className <$> ["panel", "panel-primary"]) ]
[ H.div
[ P.classes [ className "panel-heading" ] ]
[ H.h3 [ P.classes [ className "panel-title" ]] [ H.text "Aftok Login" ] ]
, H.div
[ P.classes [ className "panel-body" ] ]
[
H.h2_
[ H.text "username:" ]
, H.p_
[ H.input
[ P.value st.username
, P.inputType P.InputText
, E.onValueInput (E.input SetUsername)
]
]
, H.h2_
[ H.text "password:" ]
, H.p_
[ H.input
[ P.value st.password
, P.inputType P.InputPassword
, E.onValueInput (E.input SetPassword)
]
]
, H.p_
[ H.button
[ P.classes (className <$> ["btn", "btn-primary"])
, E.onClick (E.input_ (Login st.username st.password))
]
[ H.text "Login" ]
]
]
]

eval :: Natural LoginAction (ComponentDSL LoginState LoginAction (Aff (AppEffects eff)))
eval (SetUsername user next) = modify (_ { username = user }) $> next
eval (SetPassword pass next) = modify (_ { password = pass }) $> next
eval (Login user pass next) = do
result <- liftAff' (login user pass)
_ <- liftEff case result of
OK -> log "Login succeeded"
Forbidden -> log "Password incorrect"
Error m -> log m.message
pure next

data LoginResponse
= OK
| Forbidden
| Error { status :: StatusCode, message :: String }

-- | Post some PureScript code to the trypurescript API and fetch the JS result.
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 }

-- | Run the app.
replacement in client/src/Main.purs at line 21

[3.3602]→[3.3602:3633](∅→∅)

app <- runUI ui initialState

[3.3602]

[3.3633]

app <- runUI L.ui L.initialState