preapre buy page(s)

matebeamter.cabal

@@ -36,6 +36,7 @@ executable matebeamter
                      , View.Scaffold
                      , View.Auth
                      , View.User
+                     , View.Buy
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
                      , mateamt

src/Control/User.hs

@@ -96,13 +96,18 @@ userOverviewControl mcookie uid mRefine = do
       (token, mAuthUser) = parseTokenAndUser mcookie
       mMethod = T.unpack <$>
         (lookup "x-method" =<< mParsedCookie)
+      getProducts = liftIO $ runClientM
+        (productShortList mRefine)
+        backend
   euser <- liftIO $
     runClientM
       (userGet (mkAuthenticatedRequest token authenticateReq))
       backend
-  eproducts <- liftIO $ runClientM
-    (productShortList mRefine)
-    backend
+  eproducts <- case fmap toEnum (fmap read mMethod) of
+    Just MT.PrimaryPass -> return (Right [])
+    Just MT.SecondaryPass -> getProducts
+    Just MT.ChallengeResponse -> getProducts
+    _ -> return (Right [])
   case (euser, eproducts) of
     (Right ud, Right prods) ->
       case mMethod of
@@ -210,7 +215,7 @@ userManageAuthDeleteControl
   -> AuthDetailId
   -> UserHandler UserOverviewPage
 userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do
-  (ReadState _ backend _) <- ask
+  backend <- asks rsBackend
   let (token, mAuthUser) = parseTokenAndUser mcookie
   eReturn <- liftIO $ runClientM
     (authManageDeleteAuth (mkAuthenticatedRequest token authenticateReq) adid)
@@ -221,7 +226,7 @@ userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do
       FailureResponse _ resp ->
         if statusCode (responseStatusCode resp) == 406
         then
-          throwError $ redirect303 $ userManageLink uid
+          throwError (redirect303 $ userManageLink uid)
         else
           handleErrors (fmap read mAuthUser) Nothing [Just err]
       _ -> handleErrors (fmap read mAuthUser) (Just userSelectLink) [Just err]

src/Util.hs

@@ -10,6 +10,8 @@ import Servant hiding (addHeader)
 import Servant.Client
 import Servant.Client.Core.Request
 
+import qualified Text.Blaze.Html5.Attributes as HA
+
 import qualified Data.Text as T
 import Data.Text.Lazy.Encoding
 
@@ -131,3 +133,13 @@ redirectOverAuth muid mLink mRefine = do
         ]
       }
       )
+
+productBgStyle aid = HA.style $ mconcat
+  [ "background-image: url(#" <> aid <> ");" -- FILLME
+  , "backgronud-color: blue;"
+  , "text-shadow:"
+  , "  -1px 0 1px black,"
+  , "  0 1px 1px black,"
+  , "  1px 0 1px black,"
+  , "  0 -1px 1px black;"
+  ]

src/View/User.hs

@@ -24,6 +24,7 @@ import qualified "mateamt" Types as MT
 import Util
 import Types
 import View.Scaffold
+import View.Buy
 import API
 
 userSelectPage
@@ -79,10 +80,10 @@ userOverviewPage l10n locale method ud pos = scaffold l10n locale (initPage $
       MT.PrimaryPass ->
         userSettingsPointer l10n locale (MT.userDetailsId ud)
       MT.SecondaryPass ->
-        productList pos
+        buyProductsForm l10n locale pos
       MT.ChallengeResponse -> do
         userSettingsPointer l10n locale (MT.userDetailsId ud)
-        productList pos
+        buyProductsForm l10n locale pos
   where
     translate = localize l10n locale . gettext
 
@@ -113,16 +114,6 @@ productList pos =
                 H.toHtml ident
         )
         pos
-  where
-    productBgStyle aid = HA.style $ mconcat
-      [ "background-image: url(#" <> aid <> ");" -- FILLME
-      , "backgronud-color: blue;"
-      , "text-shadow:"
-      , "  -1px 0 1px black,"
-      , "  0 1px 1px black,"
-      , "  1px 0 1px black,"
-      , "  0 -1px 1px black;"
-      ]
 
 userNewPage
   :: L10n
@@ -182,7 +173,8 @@ userManagePage l10n locale userDetails authOverviews =
     translate "Matebeamter" <>
     " - " <>
     translate "Manage user data"
-    ) $ H.p $ H.form
+    ) $ H.p $ do
+      H.form
         H.! HA.method "post"
         H.! HA.action ("/" <>
           fromString (show $ linkURI $
@@ -216,6 +208,7 @@ userManagePage l10n locale userDetails authOverviews =
               H.! HA.type_ "submit"
               $ H.toHtml $ translate "Submit"
       H.p $ do
+        H.toHtml $ translate "Authentication details"
         mapM_
           (\(MT.AuthOverview aoid comment method) -> H.form
             H.! HA.method "post"
@@ -251,7 +244,7 @@ userManagePage l10n locale userDetails authOverviews =
             fromString (show $ linkURI $
               userManageAuthCreateLink (MT.userDetailsId userDetails)))
           H.! HA.enctype "application/x-www-form-urlencoded" $ H.fieldset $ do
-              H.legend $ H.toHtml $ translate "Authentication details"
+            H.legend $ H.toHtml $ translate "New authentication"
             H.div H.! HA.class_ "form-group required" $ do
               H.label H.! HA.for "comment" $ H.toHtml $
                 translate "Comment"