blob: 0ac37cf73d7ed490b1b55270aefb46c8486cfe27 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
|
{-# LANGUAGE OverloadedStrings #-}
module Application
(
app
) where
import Data.ByteString.Base64 (encode)
import Data.Pool (Pool, withResource)
import Database.MySQL.Simple (Connection, execute)
import Network.HTTP.Types (status200, badRequest400, Header)
import Network.HTTP.Types.Header (hContentType)
import Network.Wai (Application, requestHeaders, responseLBS, Response)
import System.Entropy (getEntropy)
import System.IO (stderr)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.CaseInsensitive as CI
app :: Pool Connection -> Application
app p request respond = do
let
headers = requestHeaders request
from = readHeader "From" headers
case from of
Just login -> apiResetPassword p login >>= respond
Nothing -> respond $ responseLBS
badRequest400
[(hContentType, "text/plain")]
"Missing the From header"
apiResetPassword :: Pool Connection -> BS.ByteString -> IO Response
apiResetPassword p login = withResource p $
\c -> do
blab ["SET PASSWORD FOR '", login, "'@'%'"]
password <- BS.takeWhile (/= '=') . encode <$> getEntropy 12
_ <- execute c "SET PASSWORD FOR ?@'%' = PASSWORD(?)" [ login, password ]
return $ responseLBS
status200
[(hContentType, "text/plain")]
(LBS.fromStrict password)
readHeader :: BS.ByteString -> [Header] -> Maybe BS.ByteString
readHeader h = lookup (CI.mk h)
blab :: [BS.ByteString] -> IO ()
blab = BS.hPutStrLn stderr . BS.concat
|
