handle refills

src/Control/Buy.hs

@@ -261,7 +261,7 @@ cashBuyPurchaseControl mcookie {-forceBuy-} pds = do
                 { errBody = fromString (show err)
                 }
       Left err ->
-        handleClientErr err (Just userSelectLink)
+        handleClientErr err Nothing (Just userSelectLink)
   else
     throwError
       $ addMessage (translate l10n loc "Please choose your product(s)")

src/Control/Journal.hs

@@ -93,20 +93,7 @@ journalPostCheckControl mcookie (CashCheck floatAmount) = do
           addMessage (translate l10n loc "Cash check received and processed") $
           redirect303 (journalLink Nothing)
         Left err ->
-          handleClientErr err (Just journalGetCheckLink)
-          -- case err of
-          --   FailureResponse _ resp ->
-          --     if statusCode (responseStatusCode resp) == 401
-          --     then
-          --       redirectOverAuth Nothing (Just journalGetCheckLink) Nothing
-          --     else
-          --       throwError $
-          --         addMessage (fromString $ show err) $
-          --         redirect303 userSelectLink
-          --   otherErr ->
-          --     throwError $
-          --       addMessage (fromString $ show otherErr) $
-          --       redirect303 userSelectLink
+          handleClientErr err (read <$> muser) (Just journalGetCheckLink)
     Nothing ->
       redirectOverAuth Nothing (Just $ journalLink Nothing) Nothing
   where

src/Control/Product.hs

@@ -4,11 +4,14 @@ module Control.Product where
 
 import Servant
 import Servant.Client
+import Servant.Client.Core.Auth (mkAuthenticatedRequest)
 
 import Data.String (fromString)
 
 import qualified Data.Text as T
 
+import Data.Text.I18n
+
 import Control.Monad.IO.Class (liftIO)
 
 -- imports from "mateamt"
@@ -62,3 +65,29 @@ productGetRefill mcookie = do
             redirect303 userSelectLink
     Nothing ->
       redirectOverAuth Nothing (Just productGetRefillLink) Nothing
+
+productPostRefill
+  :: Maybe T.Text
+  -> [MT.AmountRefill]
+  -> UserHandler ProductRefillPage
+productPostRefill mcookie refills = do
+  (token, muser, loc, l10n, backend) <- controlInit mcookie
+  case muser of
+    Just _ -> do
+      eresult <- liftIO $ runClientM
+        (productStockRefill
+          (mkAuthenticatedRequest token authenticateReq)
+          refills
+          )
+        backend
+      case eresult of
+        Right _ ->
+          throwError $
+            addMessage (translate l10n loc "Refill successfull") $
+            redirect303 productGetRefillLink
+        Left err ->
+          handleClientErr err (read <$> muser) (Just productGetRefillLink)
+    Nothing ->
+      redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
+  where
+    translate l10n loc = localize l10n loc . gettext

src/Util.hs

@@ -197,12 +197,12 @@ controlInit mcookie = do
   backend <- asks rsBackend
   return (token, muser, loc, l10n, backend)
 
-handleClientErr err authTargetLink =
+handleClientErr err muid authTargetLink =
   case err of
     FailureResponse _ resp ->
       if statusCode (responseStatusCode resp) == 401
       then
-        redirectOverAuth Nothing authTargetLink Nothing
+        redirectOverAuth muid authTargetLink Nothing
       else
         throwError $
           addMessage (fromString $ show err) $

src/View/Scaffold.hs

@@ -49,12 +49,22 @@ scaffold l10n locale mcookie page content = template page $ do
   H.div H.! HA.id "main" H.! HA.role "main" $
     content
   H.hr
-  H.footer $ H.form $
+  H.footer $ H.form $ do
     H.button
       H.! HA.formmethod "get"
       H.! HA.formaction ("/" <>
         (fromString $ show $ linkURI productGetPriceListLink))
       $ H.toHtml $ translate "Price List"
+    maybe
+      (return ())
+      (\_ ->
+        H.button
+          H.! HA.formmethod "get"
+          H.! HA.formaction ("/" <>
+            (fromString $ show $ linkURI $ productGetRefillLink))
+          $ H.toHtml $ translate "Refill stock"
+        )
+      (getLogin mcookie)
   where
     message = lookup "message" =<< fmap parseCookieText mcookie
     translate = localize l10n locale . gettext