From 3486644b442a0800f645ec9ae7f3ce8fe2b3c9cd Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sat, 18 Jul 2015 18:29:46 +0200
Subject: Showing either the payment table or a forbidden message in the UI

---
 src/client/Main.elm       | 12 ++++++---
 src/client/Model.elm      |  6 +++--
 src/client/Update.elm     |  5 +++-
 src/client/View/Page.elm  | 62 ++++++++++++++++++++++++++++++++++-------------
 src/server/Application.hs | 13 +++++-----
 src/server/View/Page.hs   |  1 -
 6 files changed, 68 insertions(+), 31 deletions(-)

(limited to 'src')

diff --git a/src/client/Main.elm b/src/client/Main.elm
index e112144..bff5f23 100644
--- a/src/client/Main.elm
+++ b/src/client/Main.elm
@@ -27,10 +27,16 @@ model : Signal Model
 model = Signal.foldp updateModel initialModel actions.signal
 
 port fetchPayments : Task Http.Error ()
-port fetchPayments = getPayments `Task.andThen` report
+port fetchPayments =
+  getPayments
+    |> flip Task.andThen reportSuccess
+    |> flip Task.onError reportError
 
-report : Payments -> Task x ()
-report payments = Signal.send actions.address (UpdatePayments payments)
+reportSuccess : Payments -> Task x ()
+reportSuccess payments = Signal.send actions.address (UpdatePayments payments)
+
+reportError : Http.Error -> Task x ()
+reportError error = Signal.send actions.address Forbidden
 
 getPayments : Task Http.Error Payments
 getPayments = Http.get paymentsDecoder "/payments"
diff --git a/src/client/Model.elm b/src/client/Model.elm
index 50d0c06..6888676 100644
--- a/src/client/Model.elm
+++ b/src/client/Model.elm
@@ -8,10 +8,12 @@ import List
 import Model.Payment exposing (Payments)
 
 type alias Model =
-  { payments : Payments
+  { payments : Maybe Payments
+  , forbiddenAccess : Bool
   }
 
 initialModel : Model
 initialModel =
-  { payments = []
+  { payments = Nothing
+  , forbiddenAccess = False
   }
diff --git a/src/client/Update.elm b/src/client/Update.elm
index 6eedb7f..b96d899 100644
--- a/src/client/Update.elm
+++ b/src/client/Update.elm
@@ -9,6 +9,7 @@ import Model.Payment exposing (Payments)
 
 type Action =
   NoOp
+  | Forbidden
   | UpdatePayments Payments
 
 actions : Signal.Mailbox Action
@@ -19,5 +20,7 @@ updateModel action model =
   case action of
     NoOp ->
       model
+    Forbidden ->
+      { model | forbiddenAccess <- True }
     UpdatePayments payments ->
-      { model | payments <- payments }
+      { model | payments <- Just payments }
diff --git a/src/client/View/Page.elm b/src/client/View/Page.elm
index 73afed9..777655c 100644
--- a/src/client/View/Page.elm
+++ b/src/client/View/Page.elm
@@ -18,31 +18,59 @@ import Model.Payment exposing (Payments, Payment)
 
 renderPage : Model -> Html
 renderPage model =
+  div
+    []
+    [ renderHeader
+    , renderMain model
+    ]
+
+renderHeader : Html
+renderHeader =
   header
     []
     [ h1
         []
         [ text "Payments" ]
-    , table
-        []
-        ([ tr
-            []
-            [ th [] [ text "Utilisateur" ]
-            , th [] [ text "Nom" ]
-            , th [] [ text "Prix" ]
-            , th [] [ text "Date" ]
-            ]
-        ] ++ (List.map renderPayment model.payments))
     ]
 
-renderPayments : Payments -> List Html
-renderPayments =
-  List.map renderPayment
-    << List.reverse
-    << List.sortBy (Date.toTime << .creation)
+renderMain : Model -> Html
+renderMain model =
+  if model.forbiddenAccess
+   then
+     forbiddenAccess
+   else
+     model.payments
+       |> Maybe.map paymentTable
+       |> Maybe.withDefault loadingTable
+
+forbiddenAccess : Html
+forbiddenAccess = text "Forbidden access"
+
+loadingTable : Html
+loadingTable = text ""
+
+paymentTable : Payments -> Html
+paymentTable payments =
+  table
+    []
+    ([ tr
+        []
+        [ th [] [ text "Utilisateur" ]
+        , th [] [ text "Nom" ]
+        , th [] [ text "Prix" ]
+        , th [] [ text "Date" ]
+        ]
+    ] ++ (paymentLines payments))
+
+paymentLines : Payments -> List Html
+paymentLines payments =
+  payments
+    |> List.sortBy (Date.toTime << .creation)
+    |> List.reverse
+    |> List.map paymentLine
 
-renderPayment : Payment -> Html
-renderPayment payment =
+paymentLine : Payment -> Html
+paymentLine payment =
   tr
     []
     [ td [] [ text payment.name ]
diff --git a/src/server/Application.hs b/src/server/Application.hs
index b83273f..e480533 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -37,10 +37,7 @@ import Model.Payment
 import View.Page (page)
 
 getIndexAction :: ActionM ()
-getIndexAction =
-  Secure.loggedAction (\_ ->
-    html $ page
-  )
+getIndexAction = html page
 
 getUsersAction :: ActionM ()
 getUsersAction = do
@@ -48,9 +45,11 @@ getUsersAction = do
   html . fromString . show $ users
 
 getPaymentsAction :: ActionM ()
-getPaymentsAction = do
-  payments <- liftIO $ runDb getPayments
-  json payments
+getPaymentsAction =
+  Secure.loggedAction (\_ -> do
+    payments <- liftIO $ runDb getPayments
+    json payments
+  )
 
 addUserAction :: Text -> Text -> ActionM ()
 addUserAction email name = do
diff --git a/src/server/View/Page.hs b/src/server/View/Page.hs
index aa4df72..3f4dbf5 100644
--- a/src/server/View/Page.hs
+++ b/src/server/View/Page.hs
@@ -23,7 +23,6 @@ page =
       script ! src "/javascripts/client.js" $ ""
       link ! rel "stylesheet" ! type_ "text/css" ! href "/css/reset.css"
       link ! rel "stylesheet" ! href "/css/font-awesome/css/font-awesome.min.css"
-      link ! rel "stylesheet" ! type_ "text/css" ! href "/css/global.css"
       link ! rel "icon" ! type_ "image/png" ! href "/images/icon.png"
       H.style $ toHtml globalDesign
     body $
-- 
cgit v1.2.3