aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/Server.elm
blob: e50de7e215827620b4fc2585131a075c69c747c6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
module Server
  ( signIn
  , addPayment
  , deletePayment
  , setIncome
  , signOut
  , initViewAction
  ) where

import Signal
import Task as Task exposing (Task)
import Http
import Json.Decode as Json exposing ((:=))
import Date
import Time exposing (Time)
import Debug
import String

import SimpleHTTP exposing (..)

import Model.Action as U exposing (Action)
import Model.Action.AddPaymentAction as AddPayment
import Model.Action.LoggedInAction as UL exposing (LoggedInAction)
import Model.Action.MonthlyAction as UM exposing (MonthlyAction)
import Model.Action.AccountAction as UA exposing (AccountAction)
import Model.Payment exposing (..)
import Model.Payer exposing (Payers, payersDecoder)
import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder)
import Model.Translations exposing (Translations, getMessage)

import Update.SignIn exposing (updateSignIn)

signIn : String -> Task Http.Error Action
signIn assertion =
  post ("/signIn?assertion=" ++ assertion)
    |> flip Task.andThen (always initViewAction)

addPayment : Translations -> String -> String -> PaymentFrequency -> Task Http.Error LoggedInAction
addPayment translations name cost frequency =
  post ("/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency))
    |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
    |> Task.map (\paymentId ->
         case String.toInt cost of
           Err _ ->
             UL.UpdateAdd (AddPayment.AddError Nothing (Just (getMessage "CostRequired" translations)))
           Ok costNumber ->
             UL.ValidateAddPayment paymentId name costNumber frequency
       )

deletePayment : Payment -> PaymentFrequency -> Task Http.Error LoggedInAction
deletePayment payment frequency =
  post ("payment/delete?id=" ++ (toString payment.id))
    |> Task.map (always (UL.ValidateDeletePayment payment frequency))

setIncome : Time -> Int -> Task Http.Error AccountAction
setIncome currentTime amount =
  post ("/income?amount=" ++ (toString amount))
    |> Task.map (always (UA.ValidateUpdateIncome currentTime amount))

signOut : Task Http.Error Action
signOut =
  post "/signOut"
    |> Task.map (always U.GoSignInView)

initViewAction = Task.onError loggedInView (always <| Task.succeed U.GoSignInView)

loggedInView : Task Http.Error Action
loggedInView =
  Task.map U.GoLoggedInView (Http.get usersDecoder "/users")
    `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI")
    `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments")
    `Task.andMap` (Http.get paymentsDecoder "/payments")
    `Task.andMap` (Http.get ("number" := Json.int) "/payments/count")
    `Task.andMap` (Http.get payersDecoder "/payers")