From 74c745a8d4a5e2690705c7e6a81b6e9d8a6a3741 Mon Sep 17 00:00:00 2001 From: Pavel Date: Mon, 27 May 2024 14:47:43 +0200 Subject: [PATCH] main version --- .gitignore | 103 +++++++++++++++++++++++++++++++++ CHANGELOG.md | 5 ++ LICENSE | 0 app/Main.hs | 135 +++++++++++++++++++++++++++++++++++++++++++ src/Database.hs | 62 ++++++++++++++++++++ src/Reservation.hs | 17 ++++++ src/Session.hs | 13 +++++ src/Types.hs | 41 +++++++++++++ src/User.hs | 62 ++++++++++++++++++++ test/Spec.hs | 124 +++++++++++++++++++++++++++++++++++++++ ticket-booking.cabal | 59 +++++++++++++++++++ 11 files changed, 621 insertions(+) create mode 100644 .gitignore create mode 100644 CHANGELOG.md create mode 100644 LICENSE create mode 100644 app/Main.hs create mode 100644 src/Database.hs create mode 100644 src/Reservation.hs create mode 100644 src/Session.hs create mode 100644 src/Types.hs create mode 100644 src/User.hs create mode 100644 test/Spec.hs create mode 100644 ticket-booking.cabal diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..742e31b --- /dev/null +++ b/.gitignore @@ -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/ \ No newline at end of file diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..7fa33d0 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for projekt + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..e69de29 diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 index 0000000..ecfe978 --- /dev/null +++ b/app/Main.hs @@ -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) \ No newline at end of file diff --git a/src/Database.hs b/src/Database.hs new file mode 100644 index 0000000..ec6429e --- /dev/null +++ b/src/Database.hs @@ -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 \ No newline at end of file diff --git a/src/Reservation.hs b/src/Reservation.hs new file mode 100644 index 0000000..abe6003 --- /dev/null +++ b/src/Reservation.hs @@ -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) \ No newline at end of file diff --git a/src/Session.hs b/src/Session.hs new file mode 100644 index 0000000..5339256 --- /dev/null +++ b/src/Session.hs @@ -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 \ No newline at end of file diff --git a/src/Types.hs b/src/Types.hs new file mode 100644 index 0000000..da1da89 --- /dev/null +++ b/src/Types.hs @@ -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) diff --git a/src/User.hs b/src/User.hs new file mode 100644 index 0000000..7ca753a --- /dev/null +++ b/src/User.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..4b7b23a --- /dev/null +++ b/test/Spec.hs @@ -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 diff --git a/ticket-booking.cabal b/ticket-booking.cabal new file mode 100644 index 0000000..d19231a --- /dev/null +++ b/ticket-booking.cabal @@ -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 \ No newline at end of file