60 lines
1.4 KiB
Haskell
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)
|