Mc3XNrUj

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           Data.Text.Encoding        (decodeUtf8)
10import qualified Database.SQLite.Simple    as S
11import           Servant
12import           System.POSIX.Crypt.SHA512
13
14initDB :: FilePath -> IO ()
15initDB 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
22checkPassword :: String -> String -> Bool
23checkPassword pass hashed =
24    let pass' = (maybe "messed up" (T.unpack . decodeUtf8) $ cryptSHA512 (BS.pack pass) (BS.pack hashed))
25    in
26        pass' == hashed
27
28checkBasicAuth :: FilePath -> BasicAuthCheck User
29checkBasicAuth 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