aboutsummaryrefslogtreecommitdiff
path: root/src/client/ServerCommunication.elm
blob: c38805b8281b3e36f693037a1ad9a7d50157c11a (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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
module ServerCommunication
  ( Communication(..)
  , sendRequest
  , serverCommunications
  ) where

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

import Model.Message exposing (messageDecoder)
import Model.User exposing (UserId)
import Model.Payment exposing (PaymentId, perPage, paymentsDecoder)

import Update as U
import Update.SignIn exposing (..)
import Update.Payment as UP

type Communication =
  NoCommunication
  | SignIn String
  | AddPayment UserId String Int
  | DeletePayment PaymentId UserId Int Int
  | UpdatePage Int
  | SignOut

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

sendRequest : Communication -> Task Http.RawError U.Action
sendRequest communication =
  case getRequest communication of
    Nothing ->
      Task.succeed U.NoOp
    Just request ->
      Http.send Http.defaultSettings request
        |> flip Task.andThen (serverResult communication)

getRequest : Communication -> Maybe Http.Request
getRequest communication =
  case communication of
    NoCommunication ->
      Nothing
    SignIn login ->
      Just (simple "post" ("/signIn?login=" ++ login))
    AddPayment userId paymentName cost ->
      Just (simple "post" ("/payment/add?name=" ++ paymentName ++ "&cost=" ++ (toString cost)))
    DeletePayment paymentId _ _ _ ->
      Just (simple "post" ("payment/delete?id=" ++ (toString paymentId)))
    UpdatePage page ->
      Just (updatePageRequest page)
    SignOut ->
      Just (simple "post"  "/signOut")

updatePageRequest : Int -> Http.Request
updatePageRequest page =
  simple "get" ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage)

simple : String -> String -> Http.Request
simple method url =
  { verb = method
  , headers = []
  , url = url
  , body = Http.empty
  }

serverResult : Communication -> Http.Response -> Task Http.RawError U.Action
serverResult communication response =
  if response.status == 200
    then
      case communication of
        NoCommunication ->
          Task.succeed U.NoOp
        SignIn login ->
          Task.succeed (U.UpdateSignIn (ValidLogin login))
        AddPayment userId paymentName cost ->
          Http.send Http.defaultSettings (updatePageRequest 1)
            |> Task.map (\response ->
                 if response.status == 200
                   then
                     decodeResponse
                       response
                       paymentsDecoder
                       (\payments -> U.UpdatePayment (UP.AddPayment userId cost payments))
                   else
                     U.NoOp
               )
        DeletePayment id userId cost currentPage ->
          Http.send Http.defaultSettings (updatePageRequest currentPage)
            |> Task.map (\response ->
                 if response.status == 200
                   then
                     decodeResponse
                       response
                       paymentsDecoder
                       (\payments -> U.UpdatePayment (UP.Remove userId cost payments))
                   else
                     U.NoOp
               )
        UpdatePage page ->
          decodeResponse
            response
            paymentsDecoder
            (\payments -> U.UpdatePayment (UP.UpdatePage page payments))
          |> Task.succeed
        SignOut ->
          Task.succeed (U.GoSignInView)
    else
      decodeResponse
        response
        messageDecoder
        (\error ->
          case communication of
            SignIn _ ->
              U.UpdateSignIn (ErrorLogin error)
            _ ->
              U.NoOp
        )
      |> Task.succeed

decodeResponse : Http.Response -> Decoder a -> (a -> U.Action) -> U.Action
decodeResponse response decoder responseToAction =
  case response.value of
    Http.Text text ->
      case decodeString decoder text of
        Ok x ->
          responseToAction x
        Err _ ->
          U.NoOp
    Http.Blob _ ->
      U.NoOp