main version

.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/

CHANGELOG.md

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

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)

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

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)

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

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)

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

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

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