Authentication in Elm

Auth.elm

module Auth exposing (User(..), UserInfo, LoginInfo, loginTask)

import HttpBuilder exposing (..)
import Json.Encode as Encode
import Json.Decode as Decode exposing ((:=))
import Task exposing (Task)


type User
  = Authenticated UserInfo
  | Anonymous


type alias UserInfo =
  { username : String
  , token : String
  }


type alias LoginInfo =
  { username : String
  , password : String
  }


loginTask : String -> LoginInfo -> Task String User
loginTask loginUrl loginInfo =
  let
    errorString error =
      case error of
        BadResponse response ->
          response.data

        _ ->
          toString error
  in
    loginTask' loginUrl loginInfo
      |> Task.map (\response -> Authenticated response.data)
      |> Task.mapError errorString


loginTask' : String -> LoginInfo -> Task (HttpBuilder.Error String) (HttpBuilder.Response UserInfo)
loginTask' loginUrl loginInfo =
  HttpBuilder.post loginUrl
    |> withJsonBody (encodeLoginInfo loginInfo)
    |> withHeader "Content-Type" "application/json"
    |> send (jsonReader decodeUserInfo) (jsonReader decodeError)


encodeLoginInfo : LoginInfo -> Encode.Value
encodeLoginInfo { username, password } =
  Encode.object
    [ ("username", Encode.string username)
    , ("password", Encode.string password)
    ]


decodeUserInfo : Decode.Decoder UserInfo
decodeUserInfo =
  Decode.object2 UserInfo
    ("username" := Decode.string)
    ("token" := Decode.string)


decodeError : Decode.Decoder String
decodeError =
  Decode.object1 identity
    ("error" := Decode.string)

LoginForm.elm

module LoginForm exposing (..)

import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Task
import Auth
import Navigation


type alias Model =
  { username : String
  , password : String
  , error : Maybe String
  }


initialModel : Model
initialModel =
  { username = ""
  , password = ""
  , error = Nothing
  }


type Msg
  = Username String
  | Password String
  | Submit
  | LoginSuccess Auth.User
  | LoginFail String
  | Navigate String


view : Auth.User -> Model -> Html Msg
view user model =
  div []
    [ h1 [] [ text <| username user ]
    , p [] [ text <| Maybe.withDefault "" model.error ]
    , Html.form [ onSubmit Submit ]
      [ input [ type' "text", onInput Username, placeholder "username" ] []
      , input [ type' "password", onInput Password, placeholder "password" ] []
      , input [ type' "submit", value "Login" ] []
      ]
    , button [ onClick (Navigate "/#") ] [ text "Home" ]
    ]


username : Auth.User -> String
username user =
  case user of
    Auth.Anonymous ->
      "anonymous"

    Auth.Authenticated { username } ->
      username


update : String -> Msg -> Model -> ( Model, Maybe Auth.User, Cmd Msg )
update backend msg model =
  case msg of
    Username newUsername ->
      ( { model | username = newUsername }, Nothing, Cmd.none )

    Password newPassword ->
      ( { model | password = newPassword }, Nothing, Cmd.none )

    Submit ->
      let
        task =
          Auth.loginTask (backend ++ "/login") (Auth.LoginInfo model.username model.password)
            |> Task.perform LoginFail LoginSuccess
      in
        ( { model | error = Nothing }, Nothing, task )

    LoginSuccess user ->
      ( model, Just user, Cmd.none )

    LoginFail error ->
      ( { model | error = Just error }, Nothing, Cmd.none )

    Navigate url ->
      ( model, Nothing, Navigation.newUrl url )