haskweb/DatabaseTest.hs

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS -Wall #-}

import System.Random
import Control.Monad.Trans.Maybe
import Control.Monad (guard)
import Control.Monad.Trans
import Data.Maybe

import qualified Crypto.Hash as C (SHA3_512, Digest, hash)
import Data.ByteString.Char8 (ByteString, pack)

import Database.HDBC
import Database.HDBC.PostgreSQL

type Username = String
type Password = String

connect :: IO Connection
connect = connectPostgreSQL "user=christian dbname=haskweb"

addUser :: Connection -> Username -> Password -> IO ()
addUser conn username password = do
    gen <- newStdGen
    let salt = take 32 $ randomRs ('a', 'z') gen
        hashed = hash (password ++ salt)
    _ <- run conn
        "INSERT INTO webuser (name, password, salt) VALUES (?, ?, ?)"
        [toSql username, toSql hashed, toSql salt]
    commit conn

validate :: Connection -> Username -> Password -> IO Bool
validate conn username password = fromMaybe False <$> runMaybeT (do
    res <- liftIO $ quickQuery' conn
        "SELECT password, salt FROM webuser WHERE name=?"
        [toSql username]
    guard $ length res == 1
    guard $ length (head res) == 2
    let [pwd, salt] = head res
    guard $ fromSql pwd == hash (password ++ fromSql salt)
    return True)

hash :: String -> String
hash = show . (C.hash :: ByteString -> C.Digest C.SHA3_512) . pack