matebeamter/src/Control/Buy.hs
2019-10-22 20:43:50 +02:00

60 lines
1.4 KiB
Haskell

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Control.Buy where
import Servant
import Servant.Client
import Servant.Client.Core.Auth (mkAuthenticatedRequest)
import qualified Data.Text as T
import Data.Text.I18n
import Data.String (fromString)
import Data.Maybe (fromMaybe)
import Data.List (sortOn)
import Control.Monad.Reader (ask)
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
buyControl
:: Maybe T.Text
-> Int
-> [MT.PurchaseDetail]
-> UserHandler BuyConfirmPage
buyControl mcookie uid pds = do
(ReadState l10n backend _) <- ask
let (token, _) = parseTokenAndUser mcookie
loc = Locale
(fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie)
pids = map MT.purchaseDetailProduct pds
epsovs <- liftIO $ runClientM
(productShortList (Just MT.AllProducts))
backend
case epsovs of
Right psovs -> do
let currentPsovs = filter ((`elem` pids) . MT.productShortOverviewId) psovs
ziptup = sortOn (MT.productShortOverviewIdent . snd) (zip
(sortOn MT.purchaseDetailProduct pds)
(sortOn MT.productShortOverviewId currentPsovs)
)
return (buyConfirmPage l10n loc ziptup)