summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorFélix Sipma <felix.sipma@no-log.org>2018-12-15 19:51:41 +0100
committerFélix Sipma <felix.sipma@no-log.org>2018-12-15 22:58:02 +0100
commit718f40fee593f61320a0b7acea309f2e0169c943 (patch)
tree5a9cd8b64676f13fcffbe6385d5156f968495859
parent4cda47a6a5d088595bfd5805d4c092f334a68965 (diff)
Handler: add debug messages
-rw-r--r--src/Shop/Handler.hs17
1 files changed, 6 insertions, 11 deletions
diff --git a/src/Shop/Handler.hs b/src/Shop/Handler.hs
index 3559131..0e2225f 100644
--- a/src/Shop/Handler.hs
+++ b/src/Shop/Handler.hs
@@ -34,8 +34,6 @@ import Network.Mail.SMTP (simpleMail, plainTextPart, htmlPart)
import Network.Socket (HostName, PortNumber)
import Protolude hiding ((%))
import Servant (throwError)
--- import Servant.Server (ServantErr(..), err400, err500,
--- (:~>)(..))
import Servant.Server (ServantErr(..), err400, err500)
import Servant.Server.Internal.Handler
import Text.PrettyPrint.Boxes hiding ((<>))
@@ -69,13 +67,7 @@ charge chargeform = do
$(logInfo) $ toS "Client email sent: <"
<> email chargeform <> "> (" <> a <> ")"
return "Success"
- -- ^ TODO
- -- ChargeResponse
- -- { chargeid = cid
- -- , chargeamount = show total
- -- , chargeemail = email chargeform
- -- , chargedate = date chargeform
- -- }
+ -- ^ TODO: add real client message
where
emailempty = errorempty "email is empty" "Vous devez renseigner une adresse email."
nameempty = errorempty "name is empty" "Vous devez renseigner votre nom."
@@ -163,8 +155,11 @@ sendCustomMail :: HostName -> PortNumber -> Text -> Text -> Mail -> App ()
sendCustomMail server port username password msg = do
$(logDebug) $ "Connecting to SMTP server " <> toS server <> ":" <> show port
rendered <- liftIO $ renderMail' msg
+ $(logDebug) "Email rendered"
connection <- liftIO $ connectSMTPSTARTTLSWithSettings server (defaultSettingsSMTPSTARTTLS { sslPort = port })
+ $(logDebug) $ "Connected to SMTP server" <> toS server <> ":" <> show port
authSucceed <- liftIO $ authenticate LOGIN (toS username) (toS password) connection
+ $(logDebug) $ "Authenticated to SMTP server" <> toS server <> ":" <> show port
if authSucceed
then do
liftIO $ sendMail (toS $ addressEmail (mailFrom msg)) (map (toS . addressEmail) (mailTo msg)) (toS rendered) connection
@@ -192,6 +187,6 @@ sendSMS sms = do
r <- req POST
(https "smsapi.free-mobile.fr" /: "sendmsg")
(ReqBodyJson sms)
- jsonResponse
+ bsResponse
mempty
- $(logInfo) (responseBody r :: Text)
+ $(logInfo) $ "SMS API response: " <> toS (responseBody r)