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 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 type Communication = NoCommunication | SignIn String | AddPayment UserId String Int | AddMonthlyPayment String Int | SetIncome Time Int | DeletePayment Payment Int | DeleteMonthlyPayment PaymentId | 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 name cost -> Just (addPaymentRequest name cost Punctual) AddMonthlyPayment name cost -> Just (addPaymentRequest name cost Monthly) SetIncome _ amount -> Just (simple "post" ("/income?amount=" ++ (toString amount))) DeletePayment payment _ -> Just (deletePaymentRequest payment.id) DeleteMonthlyPayment paymentId -> Just (deletePaymentRequest paymentId) UpdatePage page -> Just (updatePageRequest page) SignOut -> Just (simple "post" "/signOut") addPaymentRequest : String -> Int -> Frequency -> Http.Request addPaymentRequest name cost frequency = simple "post" ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)) deletePaymentRequest : PaymentId -> Http.Request deletePaymentRequest id = simple "post" ("payment/delete?id=" ++ (toString id)) 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 = case response.status of 200 -> case communication of NoCommunication -> Task.succeed U.NoOp SignIn login -> Task.succeed << U.UpdateSignIn <| ValidLogin login AddPayment userId name cost -> Http.send Http.defaultSettings (updatePageRequest 1) |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments -> Task.succeed <| U.UpdateLoggedIn (UL.AddPayment userId name cost payments) )) AddMonthlyPayment name cost -> decodeResponse ("id" := paymentIdDecoder) (\id -> Task.succeed <| U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost)) response SetIncome currentTime amount -> Task.succeed <| U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount)) DeletePayment payment currentPage -> Http.send Http.defaultSettings (updatePageRequest currentPage) |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments -> Task.succeed <| U.UpdateLoggedIn (UL.DeletePayment payment payments) )) DeleteMonthlyPayment id -> Task.succeed <| U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id)) UpdatePage page -> decodeResponse paymentsDecoder (\payments -> Task.succeed <| U.UpdateLoggedIn (UL.UpdatePage page payments)) response SignOut -> Task.succeed (U.GoSignInView) errorStatus -> case communication of SignIn _ -> decodeResponse ("error" := string) (\error -> Task.succeed <| U.UpdateSignIn (ErrorLogin error) ) response _ -> Task.succeed <| U.NoOp decodeOkResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action decodeOkResponse decoder responseToAction response = if response.status == 200 then decodeResponse decoder responseToAction response else Task.succeed U.NoOp decodeResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action decodeResponse decoder responseToAction response = case response.value of Http.Text text -> case decodeString decoder text of Ok x -> responseToAction x Err _ -> Task.succeed U.NoOp Http.Blob _ -> Task.succeed U.NoOp