2019-12-13 22:46:50 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE PackageImports #-}
|
|
|
|
module Control.Product where
|
|
|
|
|
2019-12-14 07:34:01 +00:00
|
|
|
import Servant
|
|
|
|
import Servant.Client
|
2019-12-15 09:34:38 +00:00
|
|
|
import Servant.Client.Core.Auth (mkAuthenticatedRequest)
|
2019-12-14 07:34:01 +00:00
|
|
|
|
|
|
|
import Data.String (fromString)
|
|
|
|
|
2019-12-13 22:46:50 +00:00
|
|
|
import qualified Data.Text as T
|
|
|
|
|
2019-12-15 09:34:38 +00:00
|
|
|
import Data.Text.I18n
|
|
|
|
|
2019-12-14 07:34:01 +00:00
|
|
|
import Control.Monad.IO.Class (liftIO)
|
|
|
|
|
2019-12-13 22:46:50 +00:00
|
|
|
-- imports from "mateamt"
|
|
|
|
|
|
|
|
import qualified "mateamt" Types as MT
|
|
|
|
|
|
|
|
-- internal imports
|
|
|
|
|
|
|
|
import Types
|
|
|
|
import View
|
|
|
|
import Util
|
|
|
|
import Client
|
|
|
|
import ClientAuth
|
|
|
|
import API
|
|
|
|
import Hash
|
|
|
|
|
|
|
|
productGetPriceList
|
|
|
|
:: Maybe T.Text
|
2019-12-20 07:49:06 +00:00
|
|
|
-> Maybe MT.ProductRefine
|
2019-12-14 07:34:01 +00:00
|
|
|
-> UserHandler ProductPriceListPage
|
2019-12-20 07:49:06 +00:00
|
|
|
productGetPriceList mcookie mrefine = do
|
|
|
|
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
|
2019-12-13 22:46:50 +00:00
|
|
|
elist <- liftIO $ runClientM
|
|
|
|
(productShortList
|
2019-12-20 07:49:06 +00:00
|
|
|
mrefine
|
2019-12-13 22:46:50 +00:00
|
|
|
)
|
|
|
|
backend
|
|
|
|
case elist of
|
|
|
|
Right list ->
|
2019-12-20 07:49:06 +00:00
|
|
|
return (productPriceListPage l10n loc version mcookie list symbol)
|
2019-12-13 22:46:50 +00:00
|
|
|
Left err ->
|
|
|
|
throwError $
|
|
|
|
addMessage (fromString $ show err) $
|
2019-12-26 08:41:31 +00:00
|
|
|
redirect303 (userSelectLink Nothing)
|
2019-12-14 23:05:12 +00:00
|
|
|
|
|
|
|
productGetRefill
|
|
|
|
:: Maybe T.Text
|
|
|
|
-> UserHandler ProductRefillPage
|
|
|
|
productGetRefill mcookie = do
|
2019-12-20 07:49:06 +00:00
|
|
|
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
|
2019-12-14 23:05:12 +00:00
|
|
|
case muser of
|
|
|
|
Just _ -> do
|
|
|
|
elist <- liftIO $ runClientM
|
|
|
|
(productShortList (Just MT.AllProducts))
|
|
|
|
backend
|
|
|
|
case elist of
|
|
|
|
Right list -> do
|
2019-12-20 07:49:06 +00:00
|
|
|
return $ productRefillPage l10n loc version mcookie list
|
2019-12-14 23:05:12 +00:00
|
|
|
Left err ->
|
|
|
|
throwError $
|
|
|
|
addMessage (fromString $ show err) $
|
2019-12-26 08:41:31 +00:00
|
|
|
redirect303 (userSelectLink Nothing)
|
2019-12-14 23:05:12 +00:00
|
|
|
Nothing ->
|
|
|
|
redirectOverAuth Nothing (Just productGetRefillLink) Nothing
|
2019-12-15 09:34:38 +00:00
|
|
|
|
|
|
|
productPostRefill
|
|
|
|
:: Maybe T.Text
|
|
|
|
-> [MT.AmountRefill]
|
|
|
|
-> UserHandler ProductRefillPage
|
|
|
|
productPostRefill mcookie refills = do
|
2019-12-20 07:49:06 +00:00
|
|
|
(token, muser, loc, l10n, backend, _, _) <- controlInit mcookie
|
2019-12-15 09:34:38 +00:00
|
|
|
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
|
2019-12-17 00:56:22 +00:00
|
|
|
|
|
|
|
productGetNew
|
|
|
|
:: Maybe T.Text
|
|
|
|
-> UserHandler ProductNewPage
|
2019-12-19 01:43:10 +00:00
|
|
|
productGetNew mcookie = do
|
2019-12-20 07:49:06 +00:00
|
|
|
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
|
2019-12-19 01:43:10 +00:00
|
|
|
case muser of
|
|
|
|
Just user ->
|
|
|
|
-- TODO: Fetch avatars and suppliers
|
2019-12-20 07:49:06 +00:00
|
|
|
return $ productNewPage l10n loc version mcookie symbol
|
2019-12-19 01:43:10 +00:00
|
|
|
Nothing ->
|
|
|
|
redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
|
|
|
|
|
|
|
|
productPostNew
|
|
|
|
:: Maybe T.Text
|
|
|
|
-> ProductSubmit
|
|
|
|
-> UserHandler ProductNewPage
|
|
|
|
productPostNew mcookie (ProductSubmit ident flPrice ml max apc ppc artnr) = do
|
2019-12-20 07:49:06 +00:00
|
|
|
(token, muser, loc, l10n, backend, _, _) <- controlInit mcookie
|
2019-12-19 01:43:10 +00:00
|
|
|
case muser of
|
|
|
|
Just user -> do
|
|
|
|
eresult <- liftIO $ runClientM
|
|
|
|
(productNew
|
|
|
|
(mkAuthenticatedRequest token authenticateReq)
|
|
|
|
(MT.ProductSubmit
|
|
|
|
ident
|
|
|
|
(floor $ flPrice * 100)
|
|
|
|
ml
|
|
|
|
-- TODO: repleace following two values with real avatar and supplier
|
|
|
|
Nothing
|
|
|
|
Nothing
|
|
|
|
max
|
|
|
|
apc
|
|
|
|
(floor <$> fmap (* 100) ppc)
|
|
|
|
artnr
|
|
|
|
)
|
|
|
|
)
|
|
|
|
backend
|
|
|
|
case eresult of
|
|
|
|
Right _ ->
|
|
|
|
throwError $
|
|
|
|
addMessage (translate l10n loc "Product created successfully") $
|
|
|
|
redirect303 (userOverviewLink (read user) Nothing)
|
|
|
|
Nothing ->
|
|
|
|
redirectOverAuth (read <$> muser) (Just productGetRefillLink) Nothing
|
|
|
|
where
|
|
|
|
translate l10n loc = localize l10n loc . gettext
|