main version
This commit is contained in:
commit
74c745a8d4
103
.gitignore
vendored
Normal file
103
.gitignore
vendored
Normal file
@ -0,0 +1,103 @@
|
|||||||
|
.cabal-sandbox/
|
||||||
|
cabal.sandbox.config
|
||||||
|
cabal.project.local
|
||||||
|
.ghc.environment.*
|
||||||
|
cabal-dev/
|
||||||
|
.hpc/
|
||||||
|
*.hi
|
||||||
|
*.o
|
||||||
|
*.p_hi
|
||||||
|
*.prof
|
||||||
|
*.tix
|
||||||
|
dist
|
||||||
|
dist-*
|
||||||
|
register.sh
|
||||||
|
./cabal.config
|
||||||
|
cabal-tests.log
|
||||||
|
bootstrap/*.plan.json
|
||||||
|
|
||||||
|
/Cabal/dist/
|
||||||
|
/Cabal/tests/Setup
|
||||||
|
/Cabal/Setup
|
||||||
|
/Cabal/source-file-list
|
||||||
|
|
||||||
|
/cabal-install/dist/
|
||||||
|
/cabal-install/Setup
|
||||||
|
/cabal-install/source-file-list
|
||||||
|
|
||||||
|
.stylish-haskell.yaml
|
||||||
|
.stylish-haskell.yml
|
||||||
|
.ghci
|
||||||
|
.ghcid
|
||||||
|
|
||||||
|
# Output of release and bootstrap
|
||||||
|
_build
|
||||||
|
|
||||||
|
# editor temp files
|
||||||
|
|
||||||
|
*#
|
||||||
|
.#*
|
||||||
|
*~
|
||||||
|
.*.swp
|
||||||
|
*.bak
|
||||||
|
|
||||||
|
# GHC build
|
||||||
|
|
||||||
|
Cabal/GNUmakefile
|
||||||
|
Cabal/dist-boot/
|
||||||
|
Cabal/dist-install/
|
||||||
|
Cabal/ghc.mk
|
||||||
|
|
||||||
|
|
||||||
|
# TAGS files
|
||||||
|
TAGS
|
||||||
|
tags
|
||||||
|
ctags
|
||||||
|
|
||||||
|
# stack artifacts
|
||||||
|
/.stack-work/
|
||||||
|
stack.yaml.lock
|
||||||
|
|
||||||
|
# Shake artifacts
|
||||||
|
.shake*
|
||||||
|
progress.txt
|
||||||
|
|
||||||
|
# test files
|
||||||
|
register.sh
|
||||||
|
|
||||||
|
# listed explicitly to show which files are generated but ignored
|
||||||
|
testdb/intree/cabal.project-test
|
||||||
|
testdb/intree/store/**/bin/alex
|
||||||
|
testdb/intree/store/**/cabal-hash.txt
|
||||||
|
testdb/intree/store/**/share/AlexTemplate.hs
|
||||||
|
testdb/intree/store/**/share/AlexWrappers.hs
|
||||||
|
testdb/intree/store/**/share/doc/LICENSE
|
||||||
|
testdb/intree/store/*/incoming/alex-*.lock
|
||||||
|
testdb/intree/store/*/package.db/package.cache
|
||||||
|
testdb/intree/store/*/package.db/package.cache.lock
|
||||||
|
|
||||||
|
# windows test artifacts
|
||||||
|
cabal-testsuite/**/*.exe
|
||||||
|
cabal-testsuite/**/*.bat
|
||||||
|
cabal-testsuite/**/haddocks
|
||||||
|
|
||||||
|
# python artifacts from documentation builds
|
||||||
|
*.pyc
|
||||||
|
.python-sphinx-virtualenv/
|
||||||
|
venv
|
||||||
|
.venv
|
||||||
|
/doc/.skjold_cache/
|
||||||
|
|
||||||
|
# macOS folder metadata
|
||||||
|
.DS_Store
|
||||||
|
|
||||||
|
# benchmarks
|
||||||
|
bench.html
|
||||||
|
|
||||||
|
# Emacs
|
||||||
|
.projectile
|
||||||
|
|
||||||
|
## Release Scripts
|
||||||
|
|
||||||
|
# ignore the downloaded binary files
|
||||||
|
scripts/release/binary-downloads/
|
5
CHANGELOG.md
Normal file
5
CHANGELOG.md
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
# Revision history for projekt
|
||||||
|
|
||||||
|
## 0.1.0.0 -- YYYY-mm-dd
|
||||||
|
|
||||||
|
* First version. Released on an unsuspecting world.
|
135
app/Main.hs
Normal file
135
app/Main.hs
Normal file
@ -0,0 +1,135 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import Database.PostgreSQL.Simple
|
||||||
|
import Control.Monad (forever, forM_)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Control.Monad.Trans.Class (lift)
|
||||||
|
import Control.Monad.Trans.Reader (runReaderT, ask)
|
||||||
|
import Control.Exception (catch, SomeException)
|
||||||
|
import Data.Maybe (isJust, fromJust)
|
||||||
|
import Data.Time (Day)
|
||||||
|
import Data.Time.Format (parseTimeM, defaultTimeLocale)
|
||||||
|
import Data.Time.Calendar (Day)
|
||||||
|
|
||||||
|
import User
|
||||||
|
import Reservation
|
||||||
|
import Session
|
||||||
|
import Types
|
||||||
|
import Database
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
conn <- catch connectDB handleSqlError
|
||||||
|
initializeDB conn
|
||||||
|
addAdminUser conn
|
||||||
|
|
||||||
|
putStrLn "Welcome to the Ticket Booking System!"
|
||||||
|
user <- loginOrRegister conn
|
||||||
|
runSession user $ appLoop conn user
|
||||||
|
|
||||||
|
loginOrRegister :: Connection -> IO User
|
||||||
|
loginOrRegister conn = do
|
||||||
|
putStrLn "1) Register 2) Login"
|
||||||
|
choice <- getLine
|
||||||
|
case choice of
|
||||||
|
"1" -> do
|
||||||
|
putStrLn "Enter your name:"
|
||||||
|
name <- getLine
|
||||||
|
putStrLn "Enter your password:"
|
||||||
|
password <- getLine
|
||||||
|
registerUser conn name password
|
||||||
|
loginOrRegister conn
|
||||||
|
"2" -> do
|
||||||
|
putStrLn "Enter your name:"
|
||||||
|
name <- getLine
|
||||||
|
putStrLn "Enter your password:"
|
||||||
|
password <- getLine
|
||||||
|
mUser <- loginUser conn name password
|
||||||
|
if isJust mUser
|
||||||
|
then return (fromJust mUser)
|
||||||
|
else do
|
||||||
|
putStrLn "Invalid credentials, please try again."
|
||||||
|
loginOrRegister conn
|
||||||
|
_ -> do
|
||||||
|
putStrLn "Invalid option, please try again."
|
||||||
|
loginOrRegister conn
|
||||||
|
|
||||||
|
appLoop :: Connection -> User -> Session ()
|
||||||
|
appLoop conn user = forever $ do
|
||||||
|
lift $ putStrLn $ "Logged in as " ++ userName user ++ ". "
|
||||||
|
isAdminResult <- liftIO $ User.isAdmin conn (userName user)
|
||||||
|
|
||||||
|
if isAdminResult == Just True
|
||||||
|
then adminMenu
|
||||||
|
else userMenu
|
||||||
|
|
||||||
|
where
|
||||||
|
adminMenu = do
|
||||||
|
lift $ putStrLn "Admin Menu:"
|
||||||
|
lift $ putStrLn "1) Add event 2) View events 3) Exit"
|
||||||
|
choice <- lift getLine
|
||||||
|
case choice of
|
||||||
|
"1" -> do
|
||||||
|
lift $ putStrLn "Enter event name:"
|
||||||
|
eventName <- lift getLine
|
||||||
|
lift $ putStrLn "Enter event date (YYYY-MM-DD):"
|
||||||
|
eventDateStr <- lift getLine
|
||||||
|
case parseEventDate eventDateStr of
|
||||||
|
Just eventDate ->
|
||||||
|
if isValidEventDate eventDate
|
||||||
|
then do
|
||||||
|
lift $ addEvent conn user eventName eventDate
|
||||||
|
else lift $ putStrLn "Invalid event date. Please enter a date between 2024-05-27 and 2026-01-01, with a valid month (01-12) and day (01-31)."
|
||||||
|
Nothing -> lift $ putStrLn "Invalid date format. Please enter the date in the format YYYY-MM-DD."
|
||||||
|
"2" -> do
|
||||||
|
events <- lift $ getEvents conn
|
||||||
|
lift $ printEvents events
|
||||||
|
"3" -> liftIO $ putStrLn "Exiting..." >> error "Program terminated by user"
|
||||||
|
_ -> lift $ putStrLn "Invalid option. Please try again."
|
||||||
|
|
||||||
|
userMenu = do
|
||||||
|
lift $ putStrLn "User Menu:"
|
||||||
|
lift $ putStrLn "1) Add reservation 2) View reservations 3) View events 4) Check event attendees 5) Exit"
|
||||||
|
choice <- lift getLine
|
||||||
|
case choice of
|
||||||
|
"1" -> do
|
||||||
|
events <- lift $ getEvents conn
|
||||||
|
lift $ printEvents events
|
||||||
|
lift $ putStrLn "Enter event ID:"
|
||||||
|
eventIdStr <- lift getLine
|
||||||
|
let eventId = read eventIdStr :: Int
|
||||||
|
lift $ addReservation conn (userId user) eventId
|
||||||
|
"2" -> do
|
||||||
|
reservations <- lift $ getReservations conn (userId user)
|
||||||
|
lift $ putStrLn "Your reservations:"
|
||||||
|
lift $ forM_ reservations (printReservation conn)
|
||||||
|
"3" -> do
|
||||||
|
events <- lift $ getEvents conn
|
||||||
|
lift $ printEvents events
|
||||||
|
"4" -> do
|
||||||
|
events <- lift $ getEvents conn
|
||||||
|
lift $ printEvents events
|
||||||
|
lift $ putStrLn "Enter event ID to check attendees:"
|
||||||
|
eventIdStr <- lift getLine
|
||||||
|
let eventId = read eventIdStr :: Int
|
||||||
|
attendees <- lift $ getUsersForEvent conn eventId
|
||||||
|
lift $ putStrLn $ "Attendees for event " ++ show eventId ++ ":"
|
||||||
|
lift $ forM_ attendees $ \(userId, userName) -> putStrLn $ show userName
|
||||||
|
"5" -> liftIO $ putStrLn "Exiting..." >> error "Program terminated by user"
|
||||||
|
_ -> lift $ putStrLn "Invalid option. Please try again."
|
||||||
|
|
||||||
|
handleSqlError :: SomeException -> IO Connection
|
||||||
|
handleSqlError e = do
|
||||||
|
putStrLn $ "Database connection error: " ++ show e
|
||||||
|
error "Failed to connect to the database"
|
||||||
|
|
||||||
|
printEvents :: [Event] -> IO ()
|
||||||
|
printEvents events = do
|
||||||
|
putStrLn "Available events:"
|
||||||
|
forM_ events $ \event ->
|
||||||
|
putStrLn $ "Event ID: " ++ show (eventId event) ++ ", Name: " ++ eventName event ++ ", Date: " ++ show (eventDate event)
|
||||||
|
|
||||||
|
printReservation :: Connection -> Reservation -> IO ()
|
||||||
|
printReservation conn reservation = do
|
||||||
|
event <- getEvent conn (reservationEventId reservation)
|
||||||
|
putStrLn $ "Event Name: " ++ eventName event ++ ", Event Date: " ++ show (eventDate event)
|
62
src/Database.hs
Normal file
62
src/Database.hs
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
module Database where
|
||||||
|
|
||||||
|
import Database.PostgreSQL.Simple
|
||||||
|
import Crypto.BCrypt (hashPasswordUsingPolicy, slowerBcryptHashingPolicy, validatePassword)
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import Data.ByteString.Char8 (pack)
|
||||||
|
import Data.String (fromString)
|
||||||
|
import Data.Time (Day, utctDay)
|
||||||
|
import Data.Time.Calendar (Day, fromGregorian, toGregorian)
|
||||||
|
import Data.Time.Format (parseTimeM, defaultTimeLocale)
|
||||||
|
import Data.Time.Clock (getCurrentTime)
|
||||||
|
import Types
|
||||||
|
|
||||||
|
|
||||||
|
-- Connect to the database
|
||||||
|
connectDB :: IO Connection
|
||||||
|
connectDB = connect defaultConnectInfo
|
||||||
|
{ connectHost = "localhost"
|
||||||
|
, connectDatabase = "postgres"
|
||||||
|
, connectUser = "postgres"
|
||||||
|
, connectPassword = "admin"
|
||||||
|
, connectPort = 5432
|
||||||
|
}
|
||||||
|
|
||||||
|
initializeDB :: Connection -> IO ()
|
||||||
|
initializeDB conn = do
|
||||||
|
execute_ conn (fromString "CREATE TABLE IF NOT EXISTS users (id SERIAL PRIMARY KEY, name TEXT UNIQUE, password TEXT, is_admin BOOLEAN DEFAULT FALSE)")
|
||||||
|
execute_ conn (fromString "CREATE TABLE IF NOT EXISTS events (id SERIAL PRIMARY KEY, name TEXT, date DATE)")
|
||||||
|
execute_ conn (fromString "CREATE TABLE IF NOT EXISTS reservations (id SERIAL PRIMARY KEY, user_id INT, event_id INT)")
|
||||||
|
return ()
|
||||||
|
|
||||||
|
hashPassword :: String -> IO (Maybe ByteString)
|
||||||
|
hashPassword password = hashPasswordUsingPolicy slowerBcryptHashingPolicy (pack password)
|
||||||
|
|
||||||
|
checkPassword :: ByteString -> String -> Bool
|
||||||
|
checkPassword hashedPassword password = validatePassword hashedPassword (pack password)
|
||||||
|
|
||||||
|
-- addEvent fucntion
|
||||||
|
addEvent :: Connection -> User -> String -> Day -> IO ()
|
||||||
|
addEvent conn user eventName eventDate = do
|
||||||
|
execute conn (fromString "INSERT INTO events (name, date) VALUES (?, ?)") (eventName, eventDate)
|
||||||
|
putStrLn "Event added."
|
||||||
|
|
||||||
|
-- Retrieve all events from the database
|
||||||
|
getEvents :: Connection -> IO [Event]
|
||||||
|
getEvents conn = query_ conn (fromString "SELECT id, name, date FROM events")
|
||||||
|
|
||||||
|
getEvent :: Connection -> Int -> IO Event
|
||||||
|
getEvent conn eventId = do
|
||||||
|
[event] <- query conn (fromString $ "SELECT id, name, date FROM events WHERE id = " ++ show eventId) ()
|
||||||
|
return event
|
||||||
|
|
||||||
|
parseEventDate :: String -> Maybe Day
|
||||||
|
parseEventDate str = parseTimeM True defaultTimeLocale "%Y-%m-%d" str
|
||||||
|
|
||||||
|
isValidEventDate :: Day -> Bool
|
||||||
|
isValidEventDate eventDate =
|
||||||
|
let (year, month, day) = toGregorian eventDate
|
||||||
|
in year >= 2024 && year <= 2026 && month >= 1 && month <= 12 && day >= 1 && day <= 31
|
||||||
|
|
||||||
|
getCurrentDay :: IO Day
|
||||||
|
getCurrentDay = utctDay <$> getCurrentTime
|
17
src/Reservation.hs
Normal file
17
src/Reservation.hs
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
module Reservation where
|
||||||
|
|
||||||
|
import Database.PostgreSQL.Simple
|
||||||
|
import Control.Monad (forM_)
|
||||||
|
import Data.String (fromString)
|
||||||
|
import Types
|
||||||
|
|
||||||
|
getReservations :: Connection -> Int -> IO [Reservation]
|
||||||
|
getReservations conn userId = query conn (fromString "SELECT id, user_id, event_id FROM reservations WHERE user_id = ?") (Only userId)
|
||||||
|
|
||||||
|
addReservation :: Connection -> Int -> Int -> IO ()
|
||||||
|
addReservation conn userId eventId = do
|
||||||
|
execute conn (fromString "INSERT INTO reservations (user_id, event_id) VALUES (?,?)") (userId, eventId)
|
||||||
|
putStrLn "Reservation added."
|
||||||
|
|
||||||
|
getUsersForEvent :: Connection -> Int -> IO [(Int, String)]
|
||||||
|
getUsersForEvent conn eventId = query conn (fromString "SELECT users.id, users.name FROM users JOIN reservations ON users.id = reservations.user_id WHERE reservations.event_id = ?") (Only eventId)
|
13
src/Session.hs
Normal file
13
src/Session.hs
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
module Session where
|
||||||
|
|
||||||
|
import Control.Monad.Trans.Class
|
||||||
|
import Control.Monad.Trans.Reader
|
||||||
|
import Types
|
||||||
|
|
||||||
|
type Session a = ReaderT User IO a
|
||||||
|
|
||||||
|
runSession :: User -> Session a -> IO a
|
||||||
|
runSession user session = runReaderT session user
|
||||||
|
|
||||||
|
getCurrentUser :: Session User
|
||||||
|
getCurrentUser = ask
|
41
src/Types.hs
Normal file
41
src/Types.hs
Normal file
@ -0,0 +1,41 @@
|
|||||||
|
module Types where
|
||||||
|
|
||||||
|
import Data.Time (Day)
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import Database.PostgreSQL.Simple.FromRow
|
||||||
|
import Database.PostgreSQL.Simple.ToRow
|
||||||
|
import Database.PostgreSQL.Simple.FromField
|
||||||
|
|
||||||
|
data Event = Event { eventId :: Int, eventName :: String, eventDate :: Day }
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
data Reservation = Reservation { reservationId :: Int, reservationUserId :: Int, reservationEventId :: Int }
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
|
|
||||||
|
-- User data type
|
||||||
|
data User = User
|
||||||
|
{ userId :: Int
|
||||||
|
, userName :: String
|
||||||
|
, userPassword :: ByteString
|
||||||
|
, isAdmin :: Bool
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
-- FromRow and ToRow instances for User
|
||||||
|
instance FromRow User where
|
||||||
|
fromRow = User <$> field <*> field <*> field <*> field
|
||||||
|
|
||||||
|
instance ToRow User where
|
||||||
|
toRow (User id name password isAdmin) = toRow (id, name, password, isAdmin)
|
||||||
|
|
||||||
|
instance FromRow Event where
|
||||||
|
fromRow = Event <$> field <*> field <*> field
|
||||||
|
|
||||||
|
instance ToRow Event where
|
||||||
|
toRow (Event id name date) = toRow (id, name, date)
|
||||||
|
|
||||||
|
instance FromRow Reservation where
|
||||||
|
fromRow = Reservation <$> field <*> field <*> field
|
||||||
|
|
||||||
|
instance ToRow Reservation where
|
||||||
|
toRow (Reservation id userId eventId) = toRow (id, userId, eventId)
|
62
src/User.hs
Normal file
62
src/User.hs
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
module User where
|
||||||
|
|
||||||
|
import Database.PostgreSQL.Simple.Types (Only(..))
|
||||||
|
import Database.PostgreSQL.Simple
|
||||||
|
import Data.Maybe (listToMaybe)
|
||||||
|
import Control.Exception (catch, SomeException)
|
||||||
|
import Crypto.BCrypt (hashPasswordUsingPolicy, validatePassword, slowerBcryptHashingPolicy)
|
||||||
|
import Data.ByteString.Char8 (pack)
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import Data.String (fromString)
|
||||||
|
import Types
|
||||||
|
|
||||||
|
registerUser :: Connection -> String -> String -> IO ()
|
||||||
|
registerUser conn name password = do
|
||||||
|
userExists <- doesUserExist conn name
|
||||||
|
if userExists
|
||||||
|
then putStrLn "User already exists. Please choose a different name."
|
||||||
|
else do
|
||||||
|
hashedPassword <- hashPasswordUsingPolicy slowerBcryptHashingPolicy (pack password)
|
||||||
|
case hashedPassword of
|
||||||
|
Just hp -> do
|
||||||
|
_ <- execute conn (fromString "INSERT INTO users (name, password) VALUES (?,?)") (name, hp)
|
||||||
|
putStrLn "User registered successfully."
|
||||||
|
Nothing -> putStrLn "Error hashing password"
|
||||||
|
|
||||||
|
doesUserExist :: Connection -> String -> IO Bool
|
||||||
|
doesUserExist conn name = do
|
||||||
|
results <- query conn (fromString "SELECT id FROM users WHERE name = ?") (Only name) :: IO [Only Int]
|
||||||
|
return $ not (null results)
|
||||||
|
|
||||||
|
-- Function to login a user
|
||||||
|
loginUser :: Connection -> String -> String -> IO (Maybe User)
|
||||||
|
loginUser conn name password = do
|
||||||
|
results <- query conn (fromString "SELECT id, name, password FROM users WHERE name = ?") (Only name)
|
||||||
|
return $ case results of
|
||||||
|
[(id, name, hashedPassword)] ->
|
||||||
|
if validatePassword hashedPassword (pack password)
|
||||||
|
then Just (User id name hashedPassword False)
|
||||||
|
else Nothing
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
-- Function to add an admin user
|
||||||
|
addAdminUser :: Connection -> IO ()
|
||||||
|
addAdminUser conn = do
|
||||||
|
userExists <- doesUserExist conn "admin"
|
||||||
|
if userExists
|
||||||
|
then putStrLn "Admin user already exists."
|
||||||
|
else do
|
||||||
|
hashedPassword <- hashPasswordUsingPolicy slowerBcryptHashingPolicy (pack "admin")
|
||||||
|
case hashedPassword of
|
||||||
|
Just hp -> do
|
||||||
|
-- Insert the hashed password and set is_admin to TRUE
|
||||||
|
_ <- execute conn (fromString "INSERT INTO users (name, password, is_admin) VALUES (?,?,TRUE)") ("admin", hp)
|
||||||
|
putStrLn "Admin user added successfully."
|
||||||
|
Nothing -> putStrLn "Error hashing password"
|
||||||
|
|
||||||
|
isAdmin :: Connection -> String -> IO (Maybe Bool)
|
||||||
|
isAdmin conn name = do
|
||||||
|
let queryStr = "SELECT is_admin FROM users WHERE name = ?"
|
||||||
|
result <- query conn (fromString queryStr) (Only name)
|
||||||
|
let isAdminStatus = listToMaybe (map fromOnly result)
|
||||||
|
return isAdminStatus
|
124
test/Spec.hs
Normal file
124
test/Spec.hs
Normal file
@ -0,0 +1,124 @@
|
|||||||
|
import Test.Hspec
|
||||||
|
import Database.PostgreSQL.Simple
|
||||||
|
import Database.PostgreSQL.Simple.FromRow
|
||||||
|
import Database.PostgreSQL.Simple.ToField
|
||||||
|
import Database.PostgreSQL.Simple.ToRow
|
||||||
|
import Database.PostgreSQL.Simple.FromField
|
||||||
|
import Database.PostgreSQL.Simple.Types
|
||||||
|
import User
|
||||||
|
import Database
|
||||||
|
import Types
|
||||||
|
import Session
|
||||||
|
import Reservation
|
||||||
|
import Control.Monad.Trans.Reader (runReaderT)
|
||||||
|
import Data.String (fromString)
|
||||||
|
import Data.Time.Calendar (fromGregorian)
|
||||||
|
import Data.ByteString.Char8 (pack)
|
||||||
|
|
||||||
|
-- Define a test suite
|
||||||
|
spec :: Spec
|
||||||
|
spec = do
|
||||||
|
describe "User registration" $ do
|
||||||
|
it "should register a new user successfully" $ do
|
||||||
|
-- Connect to the test database
|
||||||
|
conn <- connectTestDB
|
||||||
|
-- Perform any necessary initialization
|
||||||
|
initializeDB conn
|
||||||
|
|
||||||
|
-- Perform user registration
|
||||||
|
let name = "testUser"
|
||||||
|
password = "testPassword"
|
||||||
|
registerUser conn name password
|
||||||
|
|
||||||
|
-- Check if the user was successfully registered
|
||||||
|
userExists <- doesUserExist conn name
|
||||||
|
userExists `shouldBe` True
|
||||||
|
|
||||||
|
describe "User login" $ do
|
||||||
|
it "should login an existing user successfully" $ do
|
||||||
|
-- Connect to the test database
|
||||||
|
conn <- connectTestDB
|
||||||
|
-- Perform any necessary initialization
|
||||||
|
initializeDB conn
|
||||||
|
|
||||||
|
-- Register a user
|
||||||
|
let name = "testLoginUser"
|
||||||
|
password = "testLoginPassword"
|
||||||
|
registerUser conn name password
|
||||||
|
|
||||||
|
-- Attempt to login
|
||||||
|
loginResult <- loginUser conn name password
|
||||||
|
case loginResult of
|
||||||
|
Just _ -> return ()
|
||||||
|
Nothing -> error "Login failed"
|
||||||
|
|
||||||
|
it "should fail to login with incorrect password" $ do
|
||||||
|
-- Connect to the test database
|
||||||
|
conn <- connectTestDB
|
||||||
|
-- Perform any necessary initialization
|
||||||
|
initializeDB conn
|
||||||
|
|
||||||
|
-- Register a user
|
||||||
|
let name = "testFailLoginUser"
|
||||||
|
password = "testFailLoginPassword"
|
||||||
|
registerUser conn name password
|
||||||
|
|
||||||
|
-- Attempt to login with incorrect password
|
||||||
|
loginResult <- loginUser conn name "wrongPassword"
|
||||||
|
loginResult `shouldBe` Nothing
|
||||||
|
|
||||||
|
describe "Event management" $ do
|
||||||
|
it "should add an event successfully" $ do
|
||||||
|
-- Connect to the test database
|
||||||
|
conn <- connectTestDB
|
||||||
|
-- Perform any necessary initialization
|
||||||
|
initializeDB conn
|
||||||
|
|
||||||
|
-- Add an event
|
||||||
|
let eventName = "Test Event"
|
||||||
|
eventDate = fromGregorian 2024 12 31
|
||||||
|
addEvent conn (User 1 "admin" (pack "password") True) eventName eventDate
|
||||||
|
|
||||||
|
-- Check if the event was successfully added
|
||||||
|
eventExists <- doesEventExist conn 1
|
||||||
|
eventExists `shouldBe` True
|
||||||
|
|
||||||
|
describe "Reservation management" $ do
|
||||||
|
it "should add a reservation successfully" $ do
|
||||||
|
-- Connect to the test database
|
||||||
|
conn <- connectTestDB
|
||||||
|
-- Perform any necessary initialization
|
||||||
|
initializeDB conn
|
||||||
|
|
||||||
|
-- Add a user
|
||||||
|
registerUser conn "testUser" "testPassword"
|
||||||
|
|
||||||
|
-- Add an event
|
||||||
|
addEvent conn (User 1 "admin" (pack "password") True) "Test Event" (fromGregorian 2024 12 31)
|
||||||
|
|
||||||
|
-- Add a reservation
|
||||||
|
addReservation conn 1 1
|
||||||
|
|
||||||
|
-- Check if the reservation was successfully added
|
||||||
|
reservations <- getReservations conn 1
|
||||||
|
length reservations `shouldBe` 1
|
||||||
|
|
||||||
|
-- Helper function to connect to the test database
|
||||||
|
connectTestDB :: IO Connection
|
||||||
|
connectTestDB = connect defaultConnectInfo
|
||||||
|
{ connectHost = "localhost"
|
||||||
|
, connectDatabase = "postgres"
|
||||||
|
, connectUser = "postgres"
|
||||||
|
, connectPassword = "admin"
|
||||||
|
, connectPort = 5432
|
||||||
|
}
|
||||||
|
|
||||||
|
-- Helper function to check if an event exists in the database
|
||||||
|
doesEventExist :: Connection -> Int -> IO Bool
|
||||||
|
doesEventExist conn eventId = do
|
||||||
|
[Only count] <- query conn (fromString "SELECT COUNT(*) FROM events WHERE id = ?") (Only eventId) :: IO [Only Int]
|
||||||
|
return (count > 0)
|
||||||
|
|
||||||
|
-- Run the test
|
||||||
|
main :: IO ()
|
||||||
|
main = hspec spec
|
59
ticket-booking.cabal
Normal file
59
ticket-booking.cabal
Normal file
@ -0,0 +1,59 @@
|
|||||||
|
cabal-version: >=1.10
|
||||||
|
-- Initial package description 'projekt.cabal' generated by 'cabal init'.
|
||||||
|
-- For further documentation, see http://haskell.org/cabal/users-guide/
|
||||||
|
|
||||||
|
name: ticket-booking
|
||||||
|
version: 0.1.0.0
|
||||||
|
-- synopsis:
|
||||||
|
-- description:
|
||||||
|
-- bug-reports:
|
||||||
|
-- license:
|
||||||
|
license-file: LICENSE
|
||||||
|
author: shetrynajme
|
||||||
|
maintainer: shetrynajerkme@gmail.com
|
||||||
|
-- copyright:
|
||||||
|
-- category:
|
||||||
|
build-type: Simple
|
||||||
|
extra-source-files: CHANGELOG.md
|
||||||
|
|
||||||
|
library
|
||||||
|
exposed-modules:
|
||||||
|
Types,
|
||||||
|
Database,
|
||||||
|
Reservation,
|
||||||
|
User
|
||||||
|
hs-source-dirs: src
|
||||||
|
build-depends: base >=4.14 && <4.15,
|
||||||
|
time,
|
||||||
|
bytestring,
|
||||||
|
postgresql-simple,
|
||||||
|
bcrypt,
|
||||||
|
text,
|
||||||
|
transformers
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
executable ticket-booking
|
||||||
|
main-is: Main.hs
|
||||||
|
hs-source-dirs: app, src
|
||||||
|
build-depends: base >=4.14 && <4.15,
|
||||||
|
postgresql-simple,
|
||||||
|
bcrypt,
|
||||||
|
bytestring,
|
||||||
|
text,
|
||||||
|
time,
|
||||||
|
transformers
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite ticket-booking-test
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
main-is: Spec.hs
|
||||||
|
hs-source-dirs: test, src
|
||||||
|
build-depends: base >=4.14 && <4.15,
|
||||||
|
ticket-booking,
|
||||||
|
hspec,
|
||||||
|
transformers,
|
||||||
|
time,
|
||||||
|
bytestring,
|
||||||
|
postgresql-simple,
|
||||||
|
bcrypt
|
||||||
|
default-language: Haskell2010
|
Loading…
Reference in New Issue
Block a user