EA5BFM5GMM7KNMDLTVOSUKVKMSIDD72TAFVHDVGEOUY5VELECU3QC module Aftok.Login whereimport Preludeimport Control.Monad.Aff (Aff())import Data.Maybe (Maybe(..))import Data.Functor (($>))import Halogenimport Halogen.HTML.Core (className)import qualified Halogen.HTML.Indexed as Himport qualified Halogen.HTML.Events.Indexed as Eimport qualified Halogen.HTML.Properties.Indexed as Pimport Network.HTTP.Affjax (AJAX(), affjax)import Network.HTTP.Methodimport Network.HTTP.StatusCodetype LoginState = { username :: String, password :: String }initialState :: LoginStateinitialState = { 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 evalwhererender :: LoginState -> ComponentHTML LoginActionrender 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 }) $> nexteval (SetPassword pass next) = modify (_ { password = pass }) $> nexteval (Login user pass next) = doresult <- liftAff' (login user pass)pure nextdata LoginResponse= OK| Forbidden| Error { status :: StatusCode, message :: String }-- | Post credentials to the login service and interpret the responselogin :: forall eff. String -> String -> Aff (ajax :: AJAX | eff) LoginResponselogin user pass = doresult <- affjax $ { method: POST, url: "/login", headers: [], content: Nothing :: Maybe String, username: Just user, password: Just pass}pure $ case result.status ofStatusCode 403 -> ForbiddenStatusCode 200 -> OKother -> Error { status: other , message: result.response }
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(..))
import Halogen.HTML.Core (className)import qualified Halogen.HTML.Indexed as Himport qualified Halogen.HTML.Events.Indexed as Eimport qualified Halogen.HTML.Properties.Indexed as Pimport Network.HTTP.Affjax (AJAX(), affjax)import Network.HTTP.Methodimport Network.HTTP.StatusCode
import Halogen.Util (appendToBody, onLoad)import qualified Aftok.Login as L
-- | The definition for the app's main UI component.ui :: forall eff. Component LoginState LoginAction (Aff (AppEffects eff))ui = component render evalwhererender :: LoginState -> ComponentHTML LoginActionrender 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 }) $> nexteval (SetPassword pass next) = modify (_ { password = pass }) $> nexteval (Login user pass next) = doresult <- liftAff' (login user pass)_ <- liftEff case result ofOK -> log "Login succeeded"Forbidden -> log "Password incorrect"Error m -> log m.messagepure nextdata 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) LoginResponselogin user pass = doresult <- affjax $ { method: POST, url: "/login", headers: [], content: Nothing :: Maybe String, username: Just user, password: Just pass}pure $ case result.status ofStatusCode 403 -> ForbiddenStatusCode 200 -> OKother -> Error { status: other , message: result.response }-- | Run the app.