matebeamter/src/Control/Product.hs

142 lines
3.9 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
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"
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
-> Maybe MT.ProductRefine
-> UserHandler ProductPriceListPage
productGetPriceList mcookie mrefine = do
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
elist <- liftIO $ runClientM
(productShortList
mrefine
)
backend
case elist of
Right list ->
return (productPriceListPage l10n loc version mcookie list symbol)
Left err ->
throwError $
addMessage (fromString $ show err) $
redirect303 (userSelectLink Nothing)
productGetRefill
:: Maybe T.Text
-> UserHandler ProductRefillPage
productGetRefill mcookie = do
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
case muser of
Just _ -> do
elist <- liftIO $ runClientM
(productShortList (Just MT.AllProducts))
backend
case elist of
Right list -> do
return $ productRefillPage l10n loc version mcookie list
Left err ->
throwError $
addMessage (fromString $ show err) $
redirect303 (userSelectLink Nothing)
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 muser (Just productGetRefillLink)
Nothing ->
redirectOverAuth muser (Just productGetRefillLink) Nothing
where
translate l10n loc = localize l10n loc . gettext
productGetNew
:: Maybe T.Text
-> UserHandler ProductNewPage
productGetNew mcookie = do
(token, muser, loc, l10n, backend, symbol, version) <- controlInit mcookie
case muser of
Just user ->
-- TODO: Fetch avatars and suppliers
return $ productNewPage l10n loc version mcookie symbol
Nothing ->
redirectOverAuth muser (Just productGetRefillLink) Nothing
productPostNew
:: Maybe T.Text
-> ProductSubmit
-> UserHandler ProductNewPage
productPostNew mcookie (ProductSubmit ident flPrice ml max apc ppc artnr) = do
(token, muser, loc, l10n, backend, _, _) <- controlInit mcookie
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 user Nothing)
Nothing ->
redirectOverAuth muser (Just productGetRefillLink) Nothing
where
translate l10n loc = localize l10n loc . gettext