aboutsummaryrefslogtreecommitdiff
path: root/server/src/Model
diff options
context:
space:
mode:
Diffstat (limited to 'server/src/Model')
-rw-r--r--server/src/Model/CreateCategory.hs10
-rw-r--r--server/src/Model/CreateIncome.hs10
-rw-r--r--server/src/Model/CreatePayment.hs16
-rw-r--r--server/src/Model/EditCategory.hs13
-rw-r--r--server/src/Model/EditIncome.hs13
-rw-r--r--server/src/Model/EditPayment.hs17
-rw-r--r--server/src/Model/HashedPassword.hs27
-rw-r--r--server/src/Model/IncomeResource.hs15
-rw-r--r--server/src/Model/Mail.hs12
-rw-r--r--server/src/Model/PaymentResource.hs15
-rw-r--r--server/src/Model/Query.hs32
-rw-r--r--server/src/Model/SignIn.hs10
-rw-r--r--server/src/Model/UUID.hs10
13 files changed, 200 insertions, 0 deletions
diff --git a/server/src/Model/CreateCategory.hs b/server/src/Model/CreateCategory.hs
new file mode 100644
index 0000000..dae061b
--- /dev/null
+++ b/server/src/Model/CreateCategory.hs
@@ -0,0 +1,10 @@
+module Model.CreateCategory
+ ( CreateCategory(..)
+ ) where
+
+import Data.Text (Text)
+
+data CreateCategory = CreateCategory
+ { _createCategory_name :: Text
+ , _createCategory_color :: Text
+ } deriving (Show)
diff --git a/server/src/Model/CreateIncome.hs b/server/src/Model/CreateIncome.hs
new file mode 100644
index 0000000..82451d2
--- /dev/null
+++ b/server/src/Model/CreateIncome.hs
@@ -0,0 +1,10 @@
+module Model.CreateIncome
+ ( CreateIncome(..)
+ ) where
+
+import Data.Time.Calendar (Day)
+
+data CreateIncome = CreateIncome
+ { _createIncome_amount :: Int
+ , _createIncome_date :: Day
+ } deriving (Show)
diff --git a/server/src/Model/CreatePayment.hs b/server/src/Model/CreatePayment.hs
new file mode 100644
index 0000000..b25d2a4
--- /dev/null
+++ b/server/src/Model/CreatePayment.hs
@@ -0,0 +1,16 @@
+module Model.CreatePayment
+ ( CreatePayment(..)
+ ) where
+
+import Data.Text (Text)
+import Data.Time.Calendar (Day)
+
+import Common.Model (CategoryId, Frequency)
+
+data CreatePayment = CreatePayment
+ { _createPayment_name :: Text
+ , _createPayment_cost :: Int
+ , _createPayment_date :: Day
+ , _createPayment_category :: CategoryId
+ , _createPayment_frequency :: Frequency
+ } deriving (Show)
diff --git a/server/src/Model/EditCategory.hs b/server/src/Model/EditCategory.hs
new file mode 100644
index 0000000..8ee26ac
--- /dev/null
+++ b/server/src/Model/EditCategory.hs
@@ -0,0 +1,13 @@
+module Model.EditCategory
+ ( EditCategory(..)
+ ) where
+
+import Data.Text (Text)
+
+import Common.Model (CategoryId)
+
+data EditCategory = EditCategory
+ { _editCategory_id :: CategoryId
+ , _editCategory_name :: Text
+ , _editCategory_color :: Text
+ } deriving (Show)
diff --git a/server/src/Model/EditIncome.hs b/server/src/Model/EditIncome.hs
new file mode 100644
index 0000000..ac3d311
--- /dev/null
+++ b/server/src/Model/EditIncome.hs
@@ -0,0 +1,13 @@
+module Model.EditIncome
+ ( EditIncome(..)
+ ) where
+
+import Data.Time.Calendar (Day)
+
+import Common.Model (IncomeId)
+
+data EditIncome = EditIncome
+ { _editIncome_id :: IncomeId
+ , _editIncome_amount :: Int
+ , _editIncome_date :: Day
+ } deriving (Show)
diff --git a/server/src/Model/EditPayment.hs b/server/src/Model/EditPayment.hs
new file mode 100644
index 0000000..ac4c906
--- /dev/null
+++ b/server/src/Model/EditPayment.hs
@@ -0,0 +1,17 @@
+module Model.EditPayment
+ ( EditPayment(..)
+ ) where
+
+import Data.Text (Text)
+import Data.Time.Calendar (Day)
+
+import Common.Model (CategoryId, Frequency, PaymentId)
+
+data EditPayment = EditPayment
+ { _editPayment_id :: PaymentId
+ , _editPayment_name :: Text
+ , _editPayment_cost :: Int
+ , _editPayment_date :: Day
+ , _editPayment_category :: CategoryId
+ , _editPayment_frequency :: Frequency
+ } deriving (Show)
diff --git a/server/src/Model/HashedPassword.hs b/server/src/Model/HashedPassword.hs
new file mode 100644
index 0000000..c71e372
--- /dev/null
+++ b/server/src/Model/HashedPassword.hs
@@ -0,0 +1,27 @@
+module Model.HashedPassword
+ ( hash
+ , check
+ , HashedPassword(..)
+ ) where
+
+import qualified Crypto.BCrypt as BCrypt
+import Data.Text (Text)
+import qualified Data.Text.Encoding as TE
+
+import Common.Model.Password (Password (..))
+
+newtype HashedPassword = HashedPassword Text deriving (Show)
+
+hash :: Password -> IO (Maybe HashedPassword)
+hash (Password p) = do
+ hashed <- BCrypt.hashPasswordUsingPolicy BCrypt.slowerBcryptHashingPolicy (TE.encodeUtf8 p)
+ case hashed of
+ Nothing ->
+ return Nothing
+
+ Just h ->
+ return . Just . HashedPassword . TE.decodeUtf8 $ h
+
+check :: Password -> HashedPassword -> Bool
+check (Password p) (HashedPassword h) =
+ BCrypt.validatePassword (TE.encodeUtf8 h) (TE.encodeUtf8 p)
diff --git a/server/src/Model/IncomeResource.hs b/server/src/Model/IncomeResource.hs
new file mode 100644
index 0000000..6ab5f18
--- /dev/null
+++ b/server/src/Model/IncomeResource.hs
@@ -0,0 +1,15 @@
+module Model.IncomeResource
+ ( IncomeResource(..)
+ ) where
+
+import Common.Model (Income (..))
+
+import Resource (Resource, resourceCreatedAt, resourceDeletedAt,
+ resourceEditedAt)
+
+newtype IncomeResource = IncomeResource Income
+
+instance Resource IncomeResource where
+ resourceCreatedAt (IncomeResource i) = _income_createdAt i
+ resourceEditedAt (IncomeResource i) = _income_editedAt i
+ resourceDeletedAt (IncomeResource i) = _income_deletedAt i
diff --git a/server/src/Model/Mail.hs b/server/src/Model/Mail.hs
new file mode 100644
index 0000000..780efcc
--- /dev/null
+++ b/server/src/Model/Mail.hs
@@ -0,0 +1,12 @@
+module Model.Mail
+ ( Mail(..)
+ ) where
+
+import Data.Text (Text)
+
+data Mail = Mail
+ { from :: Text
+ , to :: [Text]
+ , subject :: Text
+ , body :: Text
+ } deriving (Eq, Show)
diff --git a/server/src/Model/PaymentResource.hs b/server/src/Model/PaymentResource.hs
new file mode 100644
index 0000000..1ea978c
--- /dev/null
+++ b/server/src/Model/PaymentResource.hs
@@ -0,0 +1,15 @@
+module Model.PaymentResource
+ ( PaymentResource(..)
+ ) where
+
+import Common.Model (Payment (..))
+
+import Resource (Resource, resourceCreatedAt, resourceDeletedAt,
+ resourceEditedAt)
+
+newtype PaymentResource = PaymentResource Payment
+
+instance Resource PaymentResource where
+ resourceCreatedAt (PaymentResource p) = _payment_createdAt p
+ resourceEditedAt (PaymentResource p) = _payment_editedAt p
+ resourceDeletedAt (PaymentResource p) = _payment_deletedAt p
diff --git a/server/src/Model/Query.hs b/server/src/Model/Query.hs
new file mode 100644
index 0000000..22ae95b
--- /dev/null
+++ b/server/src/Model/Query.hs
@@ -0,0 +1,32 @@
+module Model.Query
+ ( Query(..)
+ , run
+ ) where
+
+import Data.Functor (Functor)
+import Database.SQLite.Simple (Connection)
+import qualified Database.SQLite.Simple as SQLite
+
+data Query a = Query (Connection -> IO a)
+
+instance Functor Query where
+ fmap f (Query call) = Query (fmap f . call)
+
+instance Applicative Query where
+ pure x = Query (const $ return x)
+ (Query callF) <*> (Query callX) = Query (\conn -> do
+ x <- callX conn
+ f <- callF conn
+ return (f x))
+
+instance Monad Query where
+ (Query callX) >>= f = Query (\conn -> do
+ x <- callX conn
+ case f x of Query callY -> callY conn)
+
+run :: Query a -> IO a
+run (Query call) = do
+ conn <- SQLite.open "database"
+ result <- call conn
+ _ <- SQLite.close conn
+ return result
diff --git a/server/src/Model/SignIn.hs b/server/src/Model/SignIn.hs
new file mode 100644
index 0000000..a217bae
--- /dev/null
+++ b/server/src/Model/SignIn.hs
@@ -0,0 +1,10 @@
+module Model.SignIn
+ ( SignIn(..)
+ ) where
+
+import Common.Model (Email, Password)
+
+data SignIn = SignIn
+ { _signIn_email :: Email
+ , _signIn_password :: Password
+ } deriving Show
diff --git a/server/src/Model/UUID.hs b/server/src/Model/UUID.hs
new file mode 100644
index 0000000..0959a8e
--- /dev/null
+++ b/server/src/Model/UUID.hs
@@ -0,0 +1,10 @@
+module Model.UUID
+ ( generateUUID
+ ) where
+
+import Data.Text (Text, pack)
+import Data.UUID (toString)
+import Data.UUID.V4 (nextRandom)
+
+generateUUID :: IO Text
+generateUUID = pack . toString <$> nextRandom