aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/Server.elm
blob: 3a6c86af3fbf8cdd2a4ee051a1e8be44817f6e58 (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
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 SimpleHTTP exposing (..)

import Model.Action as U exposing (Action)
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 Update.SignIn exposing (updateSignIn)

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

addPayment : String -> Int -> PaymentFrequency -> Task Http.Error LoggedInAction
addPayment name cost frequency =
  post ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency))
    |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
    |> Task.map (\paymentId -> (UL.ValidateAddPayment paymentId name cost 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")