1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2025-01-06 07:16:45 +09:00
vervis/src/Vervis/Model.hs

95 lines
3.4 KiB
Haskell

{- This file is part of Vervis.
-
- Written in 2016, 2018, 2019 by fr33domlover <fr33domlover@riseup.net>.
-
- ♡ Copying is an act of love. Please copy, reuse and share.
-
- The author(s) have dedicated all copyright and related and neighboring
- rights to this software to the public domain worldwide. This software is
- distributed without any warranty.
-
- You should have received a copy of the CC0 Public Domain Dedication along
- with this software. If not, see
- <http://creativecommons.org/publicdomain/zero/1.0/>.
-}
{-# LANGUAGE FlexibleInstances #-}
module Vervis.Model where
import Yesod hiding (Header, parseTime)
import Data.ByteString (ByteString)
import Data.Hashable
import Data.Text (Text)
import Data.Time.Clock
import Database.Persist.Quasi
import Database.Persist.Sql (fromSqlKey)
import Text.Email.Validate (EmailAddress)
import Yesod.Auth.Account (PersistUserCredentials (..))
import Crypto.PublicVerifKey
import Database.Persist.EmailAddress
import Database.Persist.Graph.Class
import Database.Persist.JSON
import Network.FedURI (FedURI, LocalURI)
import Web.ActivityPub (Doc, Activity)
import Vervis.Model.Group
import Vervis.Model.Ident
import Vervis.Model.Repo
import Vervis.Model.Role
import Vervis.Model.Ticket
import Vervis.Model.TH
import Vervis.Model.Workflow
type PersistActivity = PersistJSON (Doc Activity)
makeEntities $(modelFile "config/models")
instance PersistUserCredentials Person where
userUsernameF = PersonLogin
userPasswordHashF = PersonPassphraseHash
userEmailF = PersonEmail
userEmailVerifiedF = PersonVerified
userEmailVerifyKeyF = PersonVerifiedKey
userEmailVerifyKeyCreatedF = Just PersonVerifiedKeyCreated
userResetPwdKeyF = PersonResetPassKey
userResetPwdKeyCreatedF = Just PersonResetPassKeyCreated
uniqueUsername = UniquePersonLogin
uniqueEmail = Just UniquePersonEmail
-- 'Person' contains a sharer ID, so we can't let yesod-auth-account use
-- 'userCreate' to create a new user. Instead, override the default
-- implementation, where we can make sure to create a 'Sharer' and then a
-- 'Person' that refers to its 'SharerId'.
-- userCreate name email key pwd = Person {-?-} name pwd email False key ""
userCreate =
error
"userCreate: addNewUser is supposed to be overridden so that this \
\function is never used!"
-- "Vervis.Discussion" uses a 'HashMap' where the key type is 'MessageId'
instance Hashable MessageId where
hashWithSalt salt = hashWithSalt salt . fromSqlKey
hash = hash . fromSqlKey
-- "Vervis.Role" uses a 'HashMap' where the key type is 'ProjectRoleId'
instance Hashable RoleId where
hashWithSalt salt = hashWithSalt salt . fromSqlKey
hash = hash . fromSqlKey
instance PersistEntityGraph Ticket TicketDependency where
sourceParam = ticketDependencyParent
sourceField = TicketDependencyParent
destParam = ticketDependencyChild
destField = TicketDependencyChild
instance PersistEntityGraphSelect Ticket TicketDependency where
type PersistEntityGraphSelector Ticket TicketDependency = ProjectId
selectorParam _ = ticketProject
selectorField _ = TicketProject
instance PersistEntityGraphNumbered Ticket TicketDependency where
numberParam _ = ticketNumber
numberField _ = TicketNumber
uniqueNode _ = UniqueTicket