aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2016-07-15 22:58:16 +0300
committerIgor Pashev <pashev.igor@gmail.com>2016-07-15 22:58:16 +0300
commite82b9525f10a908a83dff2b89178c71b0ccee87d (patch)
treebf4efd73da2d8865dd994d57648d1d608ace3506 /src
parent77412e9bc495addc7d5bb4bd75a52e906ba33e5a (diff)
downloadjuandelacosa-e82b9525f10a908a83dff2b89178c71b0ccee87d.tar.gz
Convert logins to lower case
Diffstat (limited to 'src')
-rw-r--r--src/Application.hs10
1 files changed, 8 insertions, 2 deletions
diff --git a/src/Application.hs b/src/Application.hs
index efcdbd2..8ed2f7e 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -10,6 +10,7 @@ import Control.Monad.Trans (liftIO)
import Data.ByteString.Base64 (encode)
import Data.Default.Class (def)
import Data.Pool (Pool, withResource)
+import Data.Text.Lazy (Text, toLower)
import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8)
import Database.MySQL.Simple (Connection, Only(..), query, execute)
import Network.HTTP.Types (notFound404, badRequest400)
@@ -49,7 +50,8 @@ apiWhoAmI :: Pool Connection -> ActionM ()
apiWhoAmI p =
header "From" >>= \case
Nothing -> status badRequest400 >> text "Missing header `From'"
- Just login -> do
+ Just email -> do
+ let login = emailToLogin email
[ Only n ] <- withDB p $ \c ->
query c "SELECT COUNT(*) FROM mysql.user WHERE User=? AND Host='%'"
[ LBS.toStrict . encodeUtf8 $ login ]
@@ -61,7 +63,8 @@ apiResetMyPassword :: Pool Connection -> ActionM ()
apiResetMyPassword p =
header "From" >>= \case
Nothing -> status badRequest400 >> text "Missing header `From'"
- Just login -> do
+ Just email -> do
+ let login = emailToLogin email
password <- liftIO $ BS.takeWhile (/= '=') . encode <$> getEntropy 13
_ <- withDB p $ \c -> execute c "SET PASSWORD FOR ?@'%' = PASSWORD(?)"
[ LBS.toStrict . encodeUtf8 $ login, password ]
@@ -71,3 +74,6 @@ apiResetMyPassword p =
withDB :: Pool Connection -> (Connection -> IO a) -> ActionM a
withDB p a = liftIO $ withResource p (liftIO . a)
+emailToLogin :: Text -> Text
+emailToLogin = toLower
+