Guest User

Untitled

a guest
Dec 8th, 2018
112
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.72 KB | None | 0 0
  1. {-# LANGUAGE OverloadedStrings #-}
  2.  
  3. module Auth where
  4.  
  5. import API
  6. import Control.Monad.IO.Class
  7. import qualified Data.ByteString.Char8 as BS
  8. import qualified Data.Text as T
  9. import Data.Text.Encoding (decodeUtf8)
  10. import qualified Database.SQLite.Simple as S
  11. import Servant
  12. import System.POSIX.Crypt.SHA512
  13.  
  14. initDB :: FilePath -> IO ()
  15. initDB dbfile = S.withConnection dbfile $ \conn ->
  16. S.execute_ conn
  17. "CREATE TABLE IF NOT EXISTS users ( `id` INTEGER PRIMARY KEY AUTOINCREMENT\
  18. \, `email` TEXT NOT NULL\
  19. \, `password` TEXT NOT NULL\
  20. \)"
  21.  
  22. checkPassword :: String -> String -> Bool
  23. checkPassword pass hashed =
  24. let pass' = (maybe "messed up" (T.unpack . decodeUtf8) $ cryptSHA512 (BS.pack pass) (BS.pack hashed))
  25. in
  26. pass' == hashed
  27.  
  28. checkBasicAuth :: FilePath -> BasicAuthCheck User
  29. checkBasicAuth dbfile = BasicAuthCheck $ \basicAuthData ->
  30. let username = T.unpack $ decodeUtf8 (basicAuthUsername basicAuthData)
  31. password = T.unpack $ decodeUtf8 (basicAuthPassword basicAuthData)
  32. queryData = (S.Only username) :: (S.Only String)
  33. in
  34. liftIO . S.withConnection dbfile $ \conn -> do
  35. r <- S.query conn "SELECT id,email,password FROM users WHERE email = ?" queryData :: IO [(Int, String, String)]
  36. return $ case length r of
  37. 0 -> BadPassword
  38. _ -> let (uID, uName, uHash) = head r in
  39. if checkPassword password (drop 14 uHash)
  40. then Authorized (User uID uName)
  41. else BadPassword
Add Comment
Please, Sign In to add comment