summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFélix Sipma <felix.sipma@no-log.org>2018-03-13 10:23:08 +0100
committerFélix Sipma <felix.sipma@no-log.org>2018-03-13 10:23:08 +0100
commit11db142d27ee7ff2ac73d1899724ba39a4d6475a (patch)
treec5f70fc006038320299a3d7c77a0c0000cb3cc1c
parentae2cd91c3616a1dcd6147904116b4a502f4d544b (diff)
handle invalid ChargeForm
-rw-r--r--src/Shop/Handler.hs16
1 files changed, 15 insertions, 1 deletions
diff --git a/src/Shop/Handler.hs b/src/Shop/Handler.hs
index 923a58c..e11af72 100644
--- a/src/Shop/Handler.hs
+++ b/src/Shop/Handler.hs
@@ -24,7 +24,8 @@ import Network.Mail.SMTP (simpleMail, plainTextPart, htmlPart)
import Network.Socket (HostName, PortNumber)
import Protolude hiding (MetaData, product, (%))
import Servant (throwError)
-import Servant.Server (ServantErr(..), err500, (:~>)(..))
+import Servant.Server (ServantErr(..), err400, err500,
+ (:~>)(..))
import qualified Servant.Server.Internal.Handler as SH
import Text.PrettyPrint.Boxes hiding ((<>))
import Web.Stripe
@@ -58,6 +59,11 @@ handlerToApp = lift
charge :: ChargeForm -> App ChargeResponse
charge chargeform = do
cfg <- ask
+ when (tokenid chargeform == TokenId "") tokenempty
+ when (email chargeform == "") emailempty
+ when (name chargeform == "") nameempty
+ when (date chargeform == "") dateempty
+ when (total == 0) amountnull
result <- liftIO $ stripe (getConfigStripe cfg) $ createCharge (Amount total) EUR
-&- tokenid chargeform
-&- Description (name chargeform <> " <" <> email chargeform <> ">")
@@ -83,6 +89,14 @@ charge chargeform = do
$(logWarn) $ "Creating charge failed: \"" <> errorMsg stripeerror <> "\""
throwError err500 { errBody = toS $ errorMsg stripeerror }
where
+ tokenempty = errorempty "empty Stripe tokenid" "La vérification de la commande a échoué. Merci de recharger la page et de recommencer la commande. Si le problème persiste, merci de contacter l'administrateur du site."
+ emailempty = errorempty "email is empty" "Vous devez renseigner une adresse email."
+ nameempty = errorempty "name is empty" "Vous devez renseigner votre nom."
+ dateempty = errorempty "date is empty" "Vous devez renseigner une date."
+ amountnull = errorempty "amount is null" "Le montant total de la commande est nul."
+ errorempty log err = do
+ $(logWarn) $ "Creating charge failed: " <> log
+ throwError err400 { errBody = toS err }
total = foldl (\n a -> n + quantity a * prix (product a)) 0 (articles chargeform)
comail cfg = confirmationMail
(Address (getConfigSMTPFromName cfg) (getConfigSMTPFromEmail cfg))