aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/ServerCommunication.elm
blob: 74b45e8a7d7e3f0268d38434573f15e3f2b44a67 (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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
module ServerCommunication
  ( Communication(..)
  , sendRequest
  , serverCommunications
  ) where

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

import SimpleHTTP exposing (..)

import Persona exposing (operations)

import Model.User exposing (UserId)
import Model.Payment exposing (..)
import Model.View.LoggedIn.Add exposing (Frequency(..))

import Update as U
import Update.SignIn exposing (..)
import Update.LoggedIn as UL
import Update.LoggedIn.Monthly as UM
import Update.LoggedIn.Account as UA

import InitViewAction exposing (initViewAction)

type Communication =
  NoCommunication
  | SignIn String
  | AddPayment String Int
  | AddMonthlyPayment String Int
  | SetIncome Time Int
  | DeletePayment Payment Int
  | DeleteMonthlyPayment PaymentId
  | SignOut

serverCommunications : Signal.Mailbox Communication
serverCommunications = Signal.mailbox NoCommunication

sendRequest : Communication -> Task Http.Error U.Action
sendRequest communication =
  case communication of

    NoCommunication ->
      Task.succeed U.NoOp

    SignIn assertion ->
      post ("/signIn?assertion=" ++ assertion)
        |> flip Task.andThen (always initViewAction)
        |> flip Task.onError (\err ->
             Signal.send operations.address Persona.SignOut
               |> flip Task.andThen (always <| Task.fail err)
           )

    AddPayment name cost ->
      post (addPaymentURL name cost Punctual)
        |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
        |> Task.map (\paymentId -> (U.UpdateLoggedIn (UL.AddPayment paymentId name cost)))

    AddMonthlyPayment name cost ->
      post (addPaymentURL name cost Monthly)
        |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
        |> Task.map (\id -> U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost))

    DeletePayment payment currentPage ->
      post (deletePaymentURL payment.id)
        |> Task.map (always (U.UpdateLoggedIn (UL.DeletePayment payment)))

    DeleteMonthlyPayment id ->
      post (deletePaymentURL id)
        |> Task.map (always (U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id))))

    SetIncome currentTime amount ->
      post ("/income?amount=" ++ (toString amount))
        |> Task.map (always (U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount))))

    SignOut ->
      post "/signOut"
        |> Task.map (always U.GoSignInView)

addPaymentURL : String -> Int -> Frequency -> String
addPaymentURL name cost frequency =
  "/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)

deletePaymentURL : PaymentId -> String
deletePaymentURL id =
  "payment/delete?id=" ++ (toString id)