{-# 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