cvX99Mw3

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