s473601
/
ticket-booking-main
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

main version

This commit is contained in:
Pavel 2024-05-27 14:47:43 +02:00
commit 74c745a8d4
11 changed files with 621 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
.gitignore vendored Normal file
View 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
View File

@ -0,0 +1,5 @@
# Revision history for projekt
## 0.1.0.0 -- YYYY-mm-dd
* First version. Released on an unsuspecting world.

0
LICENSE Normal file
View File

135
app/Main.hs Normal file
View 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
View 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
View 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
View 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
View 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
View 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
View 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
View 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