Project routes, handlers and creation UI
This commit is contained in:
parent
3db602e3bd
commit
372fd35f2c
31 changed files with 885 additions and 86 deletions
|
@ -4,3 +4,9 @@ Project
|
||||||
|
|
||||||
UniqueProjectActor actor
|
UniqueProjectActor actor
|
||||||
UniqueProjectCreate create
|
UniqueProjectCreate create
|
||||||
|
|
||||||
|
CollabTopicProject
|
||||||
|
collab CollabId
|
||||||
|
project ProjectId
|
||||||
|
|
||||||
|
UniqueCollabTopicProject collab
|
||||||
|
|
|
@ -173,6 +173,9 @@ verifyResourceAddressed localRecips resource = do
|
||||||
verify (GrantResourceLoom l) = do
|
verify (GrantResourceLoom l) = do
|
||||||
routes <- lookup l $ recipLooms localRecips
|
routes <- lookup l $ recipLooms localRecips
|
||||||
guard $ routeLoom $ familyLoom routes
|
guard $ routeLoom $ familyLoom routes
|
||||||
|
verify (GrantResourceProject r) = do
|
||||||
|
routes <- lookup r $ recipProjects localRecips
|
||||||
|
guard $ routeProject routes
|
||||||
|
|
||||||
verifyRemoteAddressed
|
verifyRemoteAddressed
|
||||||
:: Monad m => [(Host, NonEmpty LocalURI)] -> FedURI -> ExceptT Text m ()
|
:: Monad m => [(Host, NonEmpty LocalURI)] -> FedURI -> ExceptT Text m ()
|
||||||
|
@ -2054,6 +2057,7 @@ actorOutboxItem (LocalActorGroup _) = error "No outbox for Group yet"
|
||||||
actorOutboxItem (LocalActorRepo r) = RepoOutboxItemR r
|
actorOutboxItem (LocalActorRepo r) = RepoOutboxItemR r
|
||||||
actorOutboxItem (LocalActorDeck d) = DeckOutboxItemR d
|
actorOutboxItem (LocalActorDeck d) = DeckOutboxItemR d
|
||||||
actorOutboxItem (LocalActorLoom l) = LoomOutboxItemR l
|
actorOutboxItem (LocalActorLoom l) = LoomOutboxItemR l
|
||||||
|
actorOutboxItem (LocalActorProject l) = ProjectOutboxItemR l
|
||||||
|
|
||||||
offerDepC
|
offerDepC
|
||||||
:: Entity Person
|
:: Entity Person
|
||||||
|
|
|
@ -48,6 +48,7 @@ module Vervis.Actor
|
||||||
, RepoRoutes (..)
|
, RepoRoutes (..)
|
||||||
, DeckRoutes (..)
|
, DeckRoutes (..)
|
||||||
, LoomRoutes (..)
|
, LoomRoutes (..)
|
||||||
|
, ProjectRoutes (..)
|
||||||
, DeckFamilyRoutes (..)
|
, DeckFamilyRoutes (..)
|
||||||
, LoomFamilyRoutes (..)
|
, LoomFamilyRoutes (..)
|
||||||
, RecipientRoutes (..)
|
, RecipientRoutes (..)
|
||||||
|
@ -138,6 +139,7 @@ data LocalActorBy f
|
||||||
| LocalActorRepo (f Repo)
|
| LocalActorRepo (f Repo)
|
||||||
| LocalActorDeck (f Deck)
|
| LocalActorDeck (f Deck)
|
||||||
| LocalActorLoom (f Loom)
|
| LocalActorLoom (f Loom)
|
||||||
|
| LocalActorProject (f Project)
|
||||||
deriving (Generic, FunctorB, ConstraintsB)
|
deriving (Generic, FunctorB, ConstraintsB)
|
||||||
|
|
||||||
deriving instance AllBF Eq f LocalActorBy => Eq (LocalActorBy f)
|
deriving instance AllBF Eq f LocalActorBy => Eq (LocalActorBy f)
|
||||||
|
@ -156,6 +158,7 @@ hashLocalActorPure ctx = f
|
||||||
f (LocalActorRepo r) = LocalActorRepo $ encodeKeyHashidPure ctx r
|
f (LocalActorRepo r) = LocalActorRepo $ encodeKeyHashidPure ctx r
|
||||||
f (LocalActorDeck d) = LocalActorDeck $ encodeKeyHashidPure ctx d
|
f (LocalActorDeck d) = LocalActorDeck $ encodeKeyHashidPure ctx d
|
||||||
f (LocalActorLoom l) = LocalActorLoom $ encodeKeyHashidPure ctx l
|
f (LocalActorLoom l) = LocalActorLoom $ encodeKeyHashidPure ctx l
|
||||||
|
f (LocalActorProject j) = LocalActorProject $ encodeKeyHashidPure ctx j
|
||||||
|
|
||||||
getHashLocalActor
|
getHashLocalActor
|
||||||
:: (MonadActor m, StageHashids (ActorEnv m))
|
:: (MonadActor m, StageHashids (ActorEnv m))
|
||||||
|
@ -180,6 +183,7 @@ unhashLocalActorPure ctx = f
|
||||||
f (LocalActorRepo r) = LocalActorRepo <$> decodeKeyHashidPure ctx r
|
f (LocalActorRepo r) = LocalActorRepo <$> decodeKeyHashidPure ctx r
|
||||||
f (LocalActorDeck d) = LocalActorDeck <$> decodeKeyHashidPure ctx d
|
f (LocalActorDeck d) = LocalActorDeck <$> decodeKeyHashidPure ctx d
|
||||||
f (LocalActorLoom l) = LocalActorLoom <$> decodeKeyHashidPure ctx l
|
f (LocalActorLoom l) = LocalActorLoom <$> decodeKeyHashidPure ctx l
|
||||||
|
f (LocalActorProject j) = LocalActorProject <$> decodeKeyHashidPure ctx j
|
||||||
|
|
||||||
unhashLocalActor
|
unhashLocalActor
|
||||||
:: (MonadActor m, StageHashids (ActorEnv m))
|
:: (MonadActor m, StageHashids (ActorEnv m))
|
||||||
|
@ -258,6 +262,12 @@ data LoomRoutes = LoomRoutes
|
||||||
}
|
}
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
|
data ProjectRoutes = ProjectRoutes
|
||||||
|
{ routeProject :: Bool
|
||||||
|
, routeProjectFollowers :: Bool
|
||||||
|
}
|
||||||
|
deriving Eq
|
||||||
|
|
||||||
data DeckFamilyRoutes = DeckFamilyRoutes
|
data DeckFamilyRoutes = DeckFamilyRoutes
|
||||||
{ familyDeck :: DeckRoutes
|
{ familyDeck :: DeckRoutes
|
||||||
, familyTickets :: [(KeyHashid TicketDeck, TicketRoutes)]
|
, familyTickets :: [(KeyHashid TicketDeck, TicketRoutes)]
|
||||||
|
@ -276,6 +286,7 @@ data RecipientRoutes = RecipientRoutes
|
||||||
, recipRepos :: [(KeyHashid Repo , RepoRoutes)]
|
, recipRepos :: [(KeyHashid Repo , RepoRoutes)]
|
||||||
, recipDecks :: [(KeyHashid Deck , DeckFamilyRoutes)]
|
, recipDecks :: [(KeyHashid Deck , DeckFamilyRoutes)]
|
||||||
, recipLooms :: [(KeyHashid Loom , LoomFamilyRoutes)]
|
, recipLooms :: [(KeyHashid Loom , LoomFamilyRoutes)]
|
||||||
|
, recipProjects :: [(KeyHashid Project, ProjectRoutes)]
|
||||||
}
|
}
|
||||||
deriving Eq
|
deriving Eq
|
||||||
|
|
||||||
|
@ -346,7 +357,6 @@ data Env = forall y. (Typeable y, Yesod y) => Env
|
||||||
, envHashidsContext :: HashidsContext
|
, envHashidsContext :: HashidsContext
|
||||||
, envActorKeys :: Maybe (TVar (ActorKey, ActorKey, Bool))
|
, envActorKeys :: Maybe (TVar (ActorKey, ActorKey, Bool))
|
||||||
, envDeliveryTheater :: DeliveryTheater URIMode
|
, envDeliveryTheater :: DeliveryTheater URIMode
|
||||||
--, envYesodSite :: y
|
|
||||||
, envYesodRender :: YesodRender y
|
, envYesodRender :: YesodRender y
|
||||||
, envHttpManager :: Manager
|
, envHttpManager :: Manager
|
||||||
, envFetch :: ActorFetchShare
|
, envFetch :: ActorFetchShare
|
||||||
|
@ -469,6 +479,7 @@ sendToLocalActors authorAndId body requireOwner mauthor maidAuthor recips = do
|
||||||
looms <- unhashKeys $ recipLooms recips
|
looms <- unhashKeys $ recipLooms recips
|
||||||
for looms $ \ (loomID, (LoomFamilyRoutes loom cloths)) ->
|
for looms $ \ (loomID, (LoomFamilyRoutes loom cloths)) ->
|
||||||
(loomID,) . (loom,) <$> unhashKeys cloths
|
(loomID,) . (loom,) <$> unhashKeys cloths
|
||||||
|
projects <- unhashKeys $ recipProjects recips
|
||||||
|
|
||||||
-- Grab local actor sets whose stages are allowed for delivery
|
-- Grab local actor sets whose stages are allowed for delivery
|
||||||
let allowStages'
|
let allowStages'
|
||||||
|
@ -489,6 +500,8 @@ sendToLocalActors authorAndId body requireOwner mauthor maidAuthor recips = do
|
||||||
filter (allowStages' fst routeDeck LocalActorDeck) decksAndTickets
|
filter (allowStages' fst routeDeck LocalActorDeck) decksAndTickets
|
||||||
loomsAndClothsForStages =
|
loomsAndClothsForStages =
|
||||||
filter (allowStages' fst routeLoom LocalActorLoom) loomsAndCloths
|
filter (allowStages' fst routeLoom LocalActorLoom) loomsAndCloths
|
||||||
|
projectsForStages =
|
||||||
|
filter (allowStages' id routeProject LocalActorProject) projects
|
||||||
|
|
||||||
-- Grab local actors being addressed
|
-- Grab local actors being addressed
|
||||||
let localActorsForSelf = concat
|
let localActorsForSelf = concat
|
||||||
|
@ -497,6 +510,7 @@ sendToLocalActors authorAndId body requireOwner mauthor maidAuthor recips = do
|
||||||
, [ LocalActorRepo key | (key, routes) <- repos, routeRepo routes ]
|
, [ LocalActorRepo key | (key, routes) <- repos, routeRepo routes ]
|
||||||
, [ LocalActorDeck key | (key, (routes, _)) <- decksAndTickets, routeDeck routes ]
|
, [ LocalActorDeck key | (key, (routes, _)) <- decksAndTickets, routeDeck routes ]
|
||||||
, [ LocalActorLoom key | (key, (routes, _)) <- loomsAndCloths, routeLoom routes ]
|
, [ LocalActorLoom key | (key, (routes, _)) <- loomsAndCloths, routeLoom routes ]
|
||||||
|
, [ LocalActorProject key | (key, routes) <- projects, routeProject routes ]
|
||||||
]
|
]
|
||||||
|
|
||||||
-- Grab local actors whose followers are going to be delivered to
|
-- Grab local actors whose followers are going to be delivered to
|
||||||
|
@ -510,6 +524,8 @@ sendToLocalActors authorAndId body requireOwner mauthor maidAuthor recips = do
|
||||||
[ key | (key, (routes, _)) <- decksAndTicketsForStages, routeDeckFollowers routes ]
|
[ key | (key, (routes, _)) <- decksAndTicketsForStages, routeDeckFollowers routes ]
|
||||||
loomIDsForFollowers =
|
loomIDsForFollowers =
|
||||||
[ key | (key, (routes, _)) <- loomsAndClothsForStages, routeLoomFollowers routes ]
|
[ key | (key, (routes, _)) <- loomsAndClothsForStages, routeLoomFollowers routes ]
|
||||||
|
projectIDsForFollowers =
|
||||||
|
[ key | (key, routes) <- projectsForStages, routeProjectFollowers routes ]
|
||||||
|
|
||||||
-- Grab tickets and cloths whose followers are going to be delivered to
|
-- Grab tickets and cloths whose followers are going to be delivered to
|
||||||
let ticketSetsForFollowers =
|
let ticketSetsForFollowers =
|
||||||
|
@ -540,6 +556,7 @@ sendToLocalActors authorAndId body requireOwner mauthor maidAuthor recips = do
|
||||||
, selectActorIDs repoActor repoIDsForFollowers
|
, selectActorIDs repoActor repoIDsForFollowers
|
||||||
, selectActorIDs deckActor deckIDsForFollowers
|
, selectActorIDs deckActor deckIDsForFollowers
|
||||||
, selectActorIDs loomActor loomIDsForFollowers
|
, selectActorIDs loomActor loomIDsForFollowers
|
||||||
|
, selectActorIDs projectActor projectIDsForFollowers
|
||||||
]
|
]
|
||||||
ticketIDs <-
|
ticketIDs <-
|
||||||
concat <$>
|
concat <$>
|
||||||
|
@ -566,6 +583,7 @@ sendToLocalActors authorAndId body requireOwner mauthor maidAuthor recips = do
|
||||||
, selectFollowers LocalActorRepo RepoActor followerSetIDs
|
, selectFollowers LocalActorRepo RepoActor followerSetIDs
|
||||||
, selectFollowers LocalActorDeck DeckActor followerSetIDs
|
, selectFollowers LocalActorDeck DeckActor followerSetIDs
|
||||||
, selectFollowers LocalActorLoom LoomActor followerSetIDs
|
, selectFollowers LocalActorLoom LoomActor followerSetIDs
|
||||||
|
, selectFollowers LocalActorProject ProjectActor followerSetIDs
|
||||||
]
|
]
|
||||||
remotes <- getRemoteFollowers followerSetIDs
|
remotes <- getRemoteFollowers followerSetIDs
|
||||||
return (locals, remotes)
|
return (locals, remotes)
|
||||||
|
|
|
@ -92,6 +92,9 @@ verifyResourceAddressed localRecips resource = do
|
||||||
verify (GrantResourceLoom l) = do
|
verify (GrantResourceLoom l) = do
|
||||||
routes <- lookup l $ recipLooms localRecips
|
routes <- lookup l $ recipLooms localRecips
|
||||||
guard $ routeLoom $ familyLoom routes
|
guard $ routeLoom $ familyLoom routes
|
||||||
|
verify (GrantResourceProject r) = do
|
||||||
|
routes <- lookup r $ recipProjects localRecips
|
||||||
|
guard $ routeProject routes
|
||||||
|
|
||||||
verifyRecipientAddressed localRecips recipient = do
|
verifyRecipientAddressed localRecips recipient = do
|
||||||
recipientHash <- hashGrantRecip recipient
|
recipientHash <- hashGrantRecip recipient
|
||||||
|
@ -384,6 +387,7 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
|
||||||
Left (GrantResourceRepo r) -> Just $ LocalActorRepo r
|
Left (GrantResourceRepo r) -> Just $ LocalActorRepo r
|
||||||
Left (GrantResourceDeck d) -> Just $ LocalActorDeck d
|
Left (GrantResourceDeck d) -> Just $ LocalActorDeck d
|
||||||
Left (GrantResourceLoom l) -> Just $ LocalActorLoom l
|
Left (GrantResourceLoom l) -> Just $ LocalActorLoom l
|
||||||
|
Left (GrantResourceProject l) -> Just $ LocalActorProject l
|
||||||
Right _ -> Nothing
|
Right _ -> Nothing
|
||||||
, case recipientHash of
|
, case recipientHash of
|
||||||
Left (GrantRecipPerson p) -> Just $ LocalActorPerson p
|
Left (GrantRecipPerson p) -> Just $ LocalActorPerson p
|
||||||
|
@ -395,6 +399,7 @@ clientInvite now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
|
||||||
Left (GrantResourceRepo r) -> Just $ LocalStageRepoFollowers r
|
Left (GrantResourceRepo r) -> Just $ LocalStageRepoFollowers r
|
||||||
Left (GrantResourceDeck d) -> Just $ LocalStageDeckFollowers d
|
Left (GrantResourceDeck d) -> Just $ LocalStageDeckFollowers d
|
||||||
Left (GrantResourceLoom l) -> Just $ LocalStageLoomFollowers l
|
Left (GrantResourceLoom l) -> Just $ LocalStageLoomFollowers l
|
||||||
|
Left (GrantResourceProject l) -> Just $ LocalStageProjectFollowers l
|
||||||
Right _ -> Nothing
|
Right _ -> Nothing
|
||||||
, case recipientHash of
|
, case recipientHash of
|
||||||
Left (GrantRecipPerson p) -> Just $ LocalStagePersonFollowers p
|
Left (GrantRecipPerson p) -> Just $ LocalStagePersonFollowers p
|
||||||
|
@ -484,6 +489,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
|
||||||
Left (GrantResourceRepo r) -> Just $ LocalActorRepo r
|
Left (GrantResourceRepo r) -> Just $ LocalActorRepo r
|
||||||
Left (GrantResourceDeck d) -> Just $ LocalActorDeck d
|
Left (GrantResourceDeck d) -> Just $ LocalActorDeck d
|
||||||
Left (GrantResourceLoom l) -> Just $ LocalActorLoom l
|
Left (GrantResourceLoom l) -> Just $ LocalActorLoom l
|
||||||
|
Left (GrantResourceProject l) -> Just $ LocalActorProject l
|
||||||
Right _ -> Nothing
|
Right _ -> Nothing
|
||||||
, case recipientHash of
|
, case recipientHash of
|
||||||
Left (GrantRecipPerson p) -> Just $ LocalActorPerson p
|
Left (GrantRecipPerson p) -> Just $ LocalActorPerson p
|
||||||
|
@ -495,6 +501,7 @@ clientRemove now personMeID (ClientMsg maybeCap localRecips remoteRecips fwdHost
|
||||||
Left (GrantResourceRepo r) -> Just $ LocalStageRepoFollowers r
|
Left (GrantResourceRepo r) -> Just $ LocalStageRepoFollowers r
|
||||||
Left (GrantResourceDeck d) -> Just $ LocalStageDeckFollowers d
|
Left (GrantResourceDeck d) -> Just $ LocalStageDeckFollowers d
|
||||||
Left (GrantResourceLoom l) -> Just $ LocalStageLoomFollowers l
|
Left (GrantResourceLoom l) -> Just $ LocalStageLoomFollowers l
|
||||||
|
Left (GrantResourceProject l) -> Just $ LocalStageProjectFollowers l
|
||||||
Right _ -> Nothing
|
Right _ -> Nothing
|
||||||
, case recipientHash of
|
, case recipientHash of
|
||||||
Left (GrantRecipPerson p) -> Just $ LocalStagePersonFollowers p
|
Left (GrantRecipPerson p) -> Just $ LocalStagePersonFollowers p
|
||||||
|
|
62
src/Vervis/Actor/Project.hs
Normal file
62
src/Vervis/Actor/Project.hs
Normal file
|
@ -0,0 +1,62 @@
|
||||||
|
{- This file is part of Vervis.
|
||||||
|
-
|
||||||
|
- Written in 2023 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/>.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Vervis.Actor.Project
|
||||||
|
(
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
import Control.Monad.Logger.CallStack
|
||||||
|
import Control.Monad.Trans.Class
|
||||||
|
import Control.Monad.Trans.Except
|
||||||
|
import Control.Monad.Trans.Maybe
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import Data.Foldable
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Time.Clock
|
||||||
|
import Database.Persist
|
||||||
|
import Yesod.Persist.Core
|
||||||
|
|
||||||
|
import qualified Data.Text as T
|
||||||
|
|
||||||
|
import Control.Concurrent.Actor
|
||||||
|
import Network.FedURI
|
||||||
|
import Yesod.MonadSite
|
||||||
|
|
||||||
|
import qualified Web.ActivityPub as AP
|
||||||
|
|
||||||
|
import Control.Monad.Trans.Except.Local
|
||||||
|
import Database.Persist.Local
|
||||||
|
|
||||||
|
import Vervis.Actor
|
||||||
|
import Vervis.Cloth
|
||||||
|
import Vervis.Data.Discussion
|
||||||
|
import Vervis.FedURI
|
||||||
|
import Vervis.Federation.Util
|
||||||
|
import Vervis.Foundation
|
||||||
|
import Vervis.Model
|
||||||
|
import Vervis.Persist.Discussion
|
||||||
|
import Vervis.Ticket
|
||||||
|
|
||||||
|
projectBehavior :: UTCTime -> ProjectId -> VerseExt -> ActE (Text, Act (), Next)
|
||||||
|
projectBehavior now projectID (Left _verse@(Verse _authorIdMsig body)) =
|
||||||
|
case AP.activitySpecific $ actbActivity body of
|
||||||
|
_ -> throwE "Unsupported activity type for Project"
|
||||||
|
projectBehavior _ _ (Right _) = throwE "ClientMsgs aren't supported for Project"
|
||||||
|
|
||||||
|
instance VervisActor Project where
|
||||||
|
actorBehavior = projectBehavior
|
|
@ -110,6 +110,7 @@ import Vervis.Actor.Deck
|
||||||
import Vervis.Actor.Group
|
import Vervis.Actor.Group
|
||||||
import Vervis.Actor.Loom
|
import Vervis.Actor.Loom
|
||||||
import Vervis.Actor.Person
|
import Vervis.Actor.Person
|
||||||
|
import Vervis.Actor.Project
|
||||||
import Vervis.Actor.Repo
|
import Vervis.Actor.Repo
|
||||||
import Vervis.Darcs
|
import Vervis.Darcs
|
||||||
import Vervis.Data.Actor
|
import Vervis.Data.Actor
|
||||||
|
@ -130,6 +131,7 @@ import Vervis.Handler.Group
|
||||||
import Vervis.Handler.Key
|
import Vervis.Handler.Key
|
||||||
import Vervis.Handler.Loom
|
import Vervis.Handler.Loom
|
||||||
import Vervis.Handler.Person
|
import Vervis.Handler.Person
|
||||||
|
import Vervis.Handler.Project
|
||||||
import Vervis.Handler.Repo
|
import Vervis.Handler.Repo
|
||||||
--import Vervis.Handler.Role
|
--import Vervis.Handler.Role
|
||||||
--import Vervis.Handler.Sharer
|
--import Vervis.Handler.Sharer
|
||||||
|
@ -349,6 +351,7 @@ makeFoundation appSettings = do
|
||||||
, selectAll LocalActorRepo
|
, selectAll LocalActorRepo
|
||||||
, selectAll LocalActorDeck
|
, selectAll LocalActorDeck
|
||||||
, selectAll LocalActorLoom
|
, selectAll LocalActorLoom
|
||||||
|
, selectAll LocalActorProject
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
selectAll
|
selectAll
|
||||||
|
|
|
@ -37,6 +37,7 @@ module Vervis.Client
|
||||||
, createDeck
|
, createDeck
|
||||||
, createLoom
|
, createLoom
|
||||||
, createRepo
|
, createRepo
|
||||||
|
, createProject
|
||||||
, invite
|
, invite
|
||||||
, remove
|
, remove
|
||||||
)
|
)
|
||||||
|
@ -949,6 +950,27 @@ createRepo senderHash name desc = do
|
||||||
|
|
||||||
return (Nothing, audience, detail)
|
return (Nothing, audience, detail)
|
||||||
|
|
||||||
|
createProject
|
||||||
|
:: (MonadHandler m, HandlerSite m ~ App, MonadSite m, SiteEnv m ~ App)
|
||||||
|
=> KeyHashid Person
|
||||||
|
-> Text
|
||||||
|
-> Text
|
||||||
|
-> m (Maybe HTML, [Aud URIMode], AP.ActorDetail)
|
||||||
|
createProject senderHash name desc = do
|
||||||
|
let audAuthor =
|
||||||
|
AudLocal [] [LocalStagePersonFollowers senderHash]
|
||||||
|
|
||||||
|
audience = [audAuthor]
|
||||||
|
|
||||||
|
detail = AP.ActorDetail
|
||||||
|
{ AP.actorType = AP.ActorTypeProject
|
||||||
|
, AP.actorUsername = Nothing
|
||||||
|
, AP.actorName = Just name
|
||||||
|
, AP.actorSummary = Just desc
|
||||||
|
}
|
||||||
|
|
||||||
|
return (Nothing, audience, detail)
|
||||||
|
|
||||||
invite
|
invite
|
||||||
:: PersonId
|
:: PersonId
|
||||||
-> FedURI
|
-> FedURI
|
||||||
|
@ -1012,6 +1034,8 @@ invite personID uRecipient uResource role = do
|
||||||
AudLocal [LocalActorDeck d] [LocalStageDeckFollowers d]
|
AudLocal [LocalActorDeck d] [LocalStageDeckFollowers d]
|
||||||
Left (GrantResourceLoom l) ->
|
Left (GrantResourceLoom l) ->
|
||||||
AudLocal [LocalActorLoom l] [LocalStageLoomFollowers l]
|
AudLocal [LocalActorLoom l] [LocalStageLoomFollowers l]
|
||||||
|
Left (GrantResourceProject l) ->
|
||||||
|
AudLocal [LocalActorProject l] [LocalStageProjectFollowers l]
|
||||||
Right (remoteActor, ObjURI h lu) ->
|
Right (remoteActor, ObjURI h lu) ->
|
||||||
AudRemote h
|
AudRemote h
|
||||||
[lu]
|
[lu]
|
||||||
|
@ -1093,6 +1117,8 @@ remove personID uRecipient uResource = do
|
||||||
AudLocal [LocalActorDeck d] [LocalStageDeckFollowers d]
|
AudLocal [LocalActorDeck d] [LocalStageDeckFollowers d]
|
||||||
Left (GrantResourceLoom l) ->
|
Left (GrantResourceLoom l) ->
|
||||||
AudLocal [LocalActorLoom l] [LocalStageLoomFollowers l]
|
AudLocal [LocalActorLoom l] [LocalStageLoomFollowers l]
|
||||||
|
Left (GrantResourceProject l) ->
|
||||||
|
AudLocal [LocalActorProject l] [LocalStageProjectFollowers l]
|
||||||
Right (remoteActor, ObjURI h lu) ->
|
Right (remoteActor, ObjURI h lu) ->
|
||||||
AudRemote h
|
AudRemote h
|
||||||
[lu]
|
[lu]
|
||||||
|
|
|
@ -80,6 +80,7 @@ parseLocalActivityURI luAct = do
|
||||||
parseOutboxItemRoute (RepoOutboxItemR r i) = Just (LocalActorRepo r, i)
|
parseOutboxItemRoute (RepoOutboxItemR r i) = Just (LocalActorRepo r, i)
|
||||||
parseOutboxItemRoute (DeckOutboxItemR d i) = Just (LocalActorDeck d, i)
|
parseOutboxItemRoute (DeckOutboxItemR d i) = Just (LocalActorDeck d, i)
|
||||||
parseOutboxItemRoute (LoomOutboxItemR l i) = Just (LocalActorLoom l, i)
|
parseOutboxItemRoute (LoomOutboxItemR l i) = Just (LocalActorLoom l, i)
|
||||||
|
parseOutboxItemRoute (ProjectOutboxItemR r i) = Just (LocalActorProject r, i)
|
||||||
parseOutboxItemRoute _ = Nothing
|
parseOutboxItemRoute _ = Nothing
|
||||||
|
|
||||||
parseLocalActivityURI'
|
parseLocalActivityURI'
|
||||||
|
@ -141,6 +142,7 @@ activityRoute (LocalActorGroup g) = GroupOutboxItemR g
|
||||||
activityRoute (LocalActorRepo r) = RepoOutboxItemR r
|
activityRoute (LocalActorRepo r) = RepoOutboxItemR r
|
||||||
activityRoute (LocalActorDeck d) = DeckOutboxItemR d
|
activityRoute (LocalActorDeck d) = DeckOutboxItemR d
|
||||||
activityRoute (LocalActorLoom l) = LoomOutboxItemR l
|
activityRoute (LocalActorLoom l) = LoomOutboxItemR l
|
||||||
|
activityRoute (LocalActorProject r) = ProjectOutboxItemR r
|
||||||
|
|
||||||
stampRoute :: LocalActorBy KeyHashid -> KeyHashid SigKey -> Route App
|
stampRoute :: LocalActorBy KeyHashid -> KeyHashid SigKey -> Route App
|
||||||
stampRoute (LocalActorPerson p) = PersonStampR p
|
stampRoute (LocalActorPerson p) = PersonStampR p
|
||||||
|
@ -148,6 +150,7 @@ stampRoute (LocalActorGroup g) = GroupStampR g
|
||||||
stampRoute (LocalActorRepo r) = RepoStampR r
|
stampRoute (LocalActorRepo r) = RepoStampR r
|
||||||
stampRoute (LocalActorDeck d) = DeckStampR d
|
stampRoute (LocalActorDeck d) = DeckStampR d
|
||||||
stampRoute (LocalActorLoom l) = LoomStampR l
|
stampRoute (LocalActorLoom l) = LoomStampR l
|
||||||
|
stampRoute (LocalActorProject r) = ProjectStampR r
|
||||||
|
|
||||||
parseStampRoute
|
parseStampRoute
|
||||||
:: Route App -> Maybe (LocalActorBy KeyHashid, KeyHashid SigKey)
|
:: Route App -> Maybe (LocalActorBy KeyHashid, KeyHashid SigKey)
|
||||||
|
@ -156,6 +159,7 @@ parseStampRoute (GroupStampR g i) = Just (LocalActorGroup g, i)
|
||||||
parseStampRoute (RepoStampR r i) = Just (LocalActorRepo r, i)
|
parseStampRoute (RepoStampR r i) = Just (LocalActorRepo r, i)
|
||||||
parseStampRoute (DeckStampR d i) = Just (LocalActorDeck d, i)
|
parseStampRoute (DeckStampR d i) = Just (LocalActorDeck d, i)
|
||||||
parseStampRoute (LoomStampR l i) = Just (LocalActorLoom l, i)
|
parseStampRoute (LoomStampR l i) = Just (LocalActorLoom l, i)
|
||||||
|
parseStampRoute (ProjectStampR r i) = Just (LocalActorProject r, i)
|
||||||
parseStampRoute _ = Nothing
|
parseStampRoute _ = Nothing
|
||||||
|
|
||||||
localActorID :: LocalActorBy Entity -> ActorId
|
localActorID :: LocalActorBy Entity -> ActorId
|
||||||
|
@ -164,6 +168,7 @@ localActorID (LocalActorGroup (Entity _ g)) = groupActor g
|
||||||
localActorID (LocalActorRepo (Entity _ r)) = repoActor r
|
localActorID (LocalActorRepo (Entity _ r)) = repoActor r
|
||||||
localActorID (LocalActorDeck (Entity _ d)) = deckActor d
|
localActorID (LocalActorDeck (Entity _ d)) = deckActor d
|
||||||
localActorID (LocalActorLoom (Entity _ l)) = loomActor l
|
localActorID (LocalActorLoom (Entity _ l)) = loomActor l
|
||||||
|
localActorID (LocalActorProject (Entity _ r)) = projectActor r
|
||||||
|
|
||||||
parseFedURIOld
|
parseFedURIOld
|
||||||
:: ( MonadSite m
|
:: ( MonadSite m
|
||||||
|
|
|
@ -85,6 +85,7 @@ import Vervis.Model
|
||||||
parseGrantResource (RepoR r) = Just $ GrantResourceRepo r
|
parseGrantResource (RepoR r) = Just $ GrantResourceRepo r
|
||||||
parseGrantResource (DeckR d) = Just $ GrantResourceDeck d
|
parseGrantResource (DeckR d) = Just $ GrantResourceDeck d
|
||||||
parseGrantResource (LoomR l) = Just $ GrantResourceLoom l
|
parseGrantResource (LoomR l) = Just $ GrantResourceLoom l
|
||||||
|
parseGrantResource (ProjectR l) = Just $ GrantResourceProject l
|
||||||
parseGrantResource _ = Nothing
|
parseGrantResource _ = Nothing
|
||||||
|
|
||||||
data GrantRecipBy f = GrantRecipPerson (f Person)
|
data GrantRecipBy f = GrantRecipPerson (f Person)
|
||||||
|
@ -230,11 +231,6 @@ parseGrant h (AP.Grant object context target mresult mstart mend allows deleg) =
|
||||||
resourceHash
|
resourceHash
|
||||||
"Grant resource contains invalid hashid"
|
"Grant resource contains invalid hashid"
|
||||||
else pure $ Right lu
|
else pure $ Right lu
|
||||||
where
|
|
||||||
parseGrantResource (RepoR r) = Just $ GrantResourceRepo r
|
|
||||||
parseGrantResource (DeckR d) = Just $ GrantResourceDeck d
|
|
||||||
parseGrantResource (LoomR l) = Just $ GrantResourceLoom l
|
|
||||||
parseGrantResource _ = Nothing
|
|
||||||
parseTarget u@(ObjURI h lu) = do
|
parseTarget u@(ObjURI h lu) = do
|
||||||
hl <- hostIsLocal h
|
hl <- hostIsLocal h
|
||||||
if hl
|
if hl
|
||||||
|
@ -277,11 +273,13 @@ grantResourceActorID :: GrantResourceBy Identity -> ActorId
|
||||||
grantResourceActorID (GrantResourceRepo (Identity r)) = repoActor r
|
grantResourceActorID (GrantResourceRepo (Identity r)) = repoActor r
|
||||||
grantResourceActorID (GrantResourceDeck (Identity d)) = deckActor d
|
grantResourceActorID (GrantResourceDeck (Identity d)) = deckActor d
|
||||||
grantResourceActorID (GrantResourceLoom (Identity l)) = loomActor l
|
grantResourceActorID (GrantResourceLoom (Identity l)) = loomActor l
|
||||||
|
grantResourceActorID (GrantResourceProject (Identity l)) = projectActor l
|
||||||
|
|
||||||
data GrantResourceBy f
|
data GrantResourceBy f
|
||||||
= GrantResourceRepo (f Repo)
|
= GrantResourceRepo (f Repo)
|
||||||
| GrantResourceDeck (f Deck)
|
| GrantResourceDeck (f Deck)
|
||||||
| GrantResourceLoom (f Loom)
|
| GrantResourceLoom (f Loom)
|
||||||
|
| GrantResourceProject (f Project)
|
||||||
deriving (Generic, FunctorB, TraversableB, ConstraintsB)
|
deriving (Generic, FunctorB, TraversableB, ConstraintsB)
|
||||||
|
|
||||||
deriving instance AllBF Eq f GrantResourceBy => Eq (GrantResourceBy f)
|
deriving instance AllBF Eq f GrantResourceBy => Eq (GrantResourceBy f)
|
||||||
|
@ -294,6 +292,8 @@ unhashGrantResourcePure ctx = f
|
||||||
GrantResourceDeck <$> decodeKeyHashidPure ctx d
|
GrantResourceDeck <$> decodeKeyHashidPure ctx d
|
||||||
f (GrantResourceLoom l) =
|
f (GrantResourceLoom l) =
|
||||||
GrantResourceLoom <$> decodeKeyHashidPure ctx l
|
GrantResourceLoom <$> decodeKeyHashidPure ctx l
|
||||||
|
f (GrantResourceProject l) =
|
||||||
|
GrantResourceProject <$> decodeKeyHashidPure ctx l
|
||||||
|
|
||||||
unhashGrantResource resource = do
|
unhashGrantResource resource = do
|
||||||
ctx <- asksSite siteHashidsContext
|
ctx <- asksSite siteHashidsContext
|
||||||
|
@ -317,6 +317,8 @@ hashGrantResource (GrantResourceDeck k) =
|
||||||
GrantResourceDeck <$> encodeKeyHashid k
|
GrantResourceDeck <$> encodeKeyHashid k
|
||||||
hashGrantResource (GrantResourceLoom k) =
|
hashGrantResource (GrantResourceLoom k) =
|
||||||
GrantResourceLoom <$> encodeKeyHashid k
|
GrantResourceLoom <$> encodeKeyHashid k
|
||||||
|
hashGrantResource (GrantResourceProject k) =
|
||||||
|
GrantResourceProject <$> encodeKeyHashid k
|
||||||
|
|
||||||
hashGrantResource' (GrantResourceRepo k) =
|
hashGrantResource' (GrantResourceRepo k) =
|
||||||
GrantResourceRepo <$> WAP.encodeKeyHashid k
|
GrantResourceRepo <$> WAP.encodeKeyHashid k
|
||||||
|
@ -324,6 +326,8 @@ hashGrantResource' (GrantResourceDeck k) =
|
||||||
GrantResourceDeck <$> WAP.encodeKeyHashid k
|
GrantResourceDeck <$> WAP.encodeKeyHashid k
|
||||||
hashGrantResource' (GrantResourceLoom k) =
|
hashGrantResource' (GrantResourceLoom k) =
|
||||||
GrantResourceLoom <$> WAP.encodeKeyHashid k
|
GrantResourceLoom <$> WAP.encodeKeyHashid k
|
||||||
|
hashGrantResource' (GrantResourceProject k) =
|
||||||
|
GrantResourceProject <$> WAP.encodeKeyHashid k
|
||||||
|
|
||||||
getGrantResource (GrantResourceRepo k) e =
|
getGrantResource (GrantResourceRepo k) e =
|
||||||
GrantResourceRepo <$> getEntityE k e
|
GrantResourceRepo <$> getEntityE k e
|
||||||
|
@ -331,6 +335,8 @@ getGrantResource (GrantResourceDeck k) e =
|
||||||
GrantResourceDeck <$> getEntityE k e
|
GrantResourceDeck <$> getEntityE k e
|
||||||
getGrantResource (GrantResourceLoom k) e =
|
getGrantResource (GrantResourceLoom k) e =
|
||||||
GrantResourceLoom <$> getEntityE k e
|
GrantResourceLoom <$> getEntityE k e
|
||||||
|
getGrantResource (GrantResourceProject k) e =
|
||||||
|
GrantResourceProject <$> getEntityE k e
|
||||||
|
|
||||||
getGrantResource404 = maybe notFound return <=< getGrantResourceEntity
|
getGrantResource404 = maybe notFound return <=< getGrantResourceEntity
|
||||||
where
|
where
|
||||||
|
@ -340,8 +346,11 @@ getGrantResource404 = maybe notFound return <=< getGrantResourceEntity
|
||||||
fmap GrantResourceDeck <$> getEntity k
|
fmap GrantResourceDeck <$> getEntity k
|
||||||
getGrantResourceEntity (GrantResourceLoom k) =
|
getGrantResourceEntity (GrantResourceLoom k) =
|
||||||
fmap GrantResourceLoom <$> getEntity k
|
fmap GrantResourceLoom <$> getEntity k
|
||||||
|
getGrantResourceEntity (GrantResourceProject k) =
|
||||||
|
fmap GrantResourceProject <$> getEntity k
|
||||||
|
|
||||||
grantResourceLocalActor :: GrantResourceBy f -> LocalActorBy f
|
grantResourceLocalActor :: GrantResourceBy f -> LocalActorBy f
|
||||||
grantResourceLocalActor (GrantResourceRepo r) = LocalActorRepo r
|
grantResourceLocalActor (GrantResourceRepo r) = LocalActorRepo r
|
||||||
grantResourceLocalActor (GrantResourceDeck d) = LocalActorDeck d
|
grantResourceLocalActor (GrantResourceDeck d) = LocalActorDeck d
|
||||||
grantResourceLocalActor (GrantResourceLoom l) = LocalActorLoom l
|
grantResourceLocalActor (GrantResourceLoom l) = LocalActorLoom l
|
||||||
|
grantResourceLocalActor (GrantResourceProject l) = LocalActorProject l
|
||||||
|
|
|
@ -222,3 +222,4 @@ messageRoute (LocalActorGroup g) = GroupMessageR g
|
||||||
messageRoute (LocalActorRepo r) = RepoMessageR r
|
messageRoute (LocalActorRepo r) = RepoMessageR r
|
||||||
messageRoute (LocalActorDeck d) = DeckMessageR d
|
messageRoute (LocalActorDeck d) = DeckMessageR d
|
||||||
messageRoute (LocalActorLoom l) = LoomMessageR l
|
messageRoute (LocalActorLoom l) = LoomMessageR l
|
||||||
|
messageRoute (LocalActorProject l) = ProjectMessageR l
|
||||||
|
|
|
@ -16,10 +16,14 @@
|
||||||
module Vervis.Form.Tracker
|
module Vervis.Form.Tracker
|
||||||
( NewDeck (..)
|
( NewDeck (..)
|
||||||
, newDeckForm
|
, newDeckForm
|
||||||
|
, NewProject (..)
|
||||||
|
, newProjectForm
|
||||||
, NewLoom (..)
|
, NewLoom (..)
|
||||||
, newLoomForm
|
, newLoomForm
|
||||||
, DeckInvite (..)
|
, DeckInvite (..)
|
||||||
, deckInviteForm
|
, deckInviteForm
|
||||||
|
, ProjectInvite (..)
|
||||||
|
, projectInviteForm
|
||||||
--, NewProjectCollab (..)
|
--, NewProjectCollab (..)
|
||||||
--, newProjectCollabForm
|
--, newProjectCollabForm
|
||||||
--, editProjectForm
|
--, editProjectForm
|
||||||
|
@ -56,6 +60,16 @@ newDeckForm = renderDivs $ NewDeck
|
||||||
<$> areq textField "Name*" Nothing
|
<$> areq textField "Name*" Nothing
|
||||||
<*> areq textField "Description" Nothing
|
<*> areq textField "Description" Nothing
|
||||||
|
|
||||||
|
data NewProject = NewProject
|
||||||
|
{ npName :: Text
|
||||||
|
, npDesc :: Text
|
||||||
|
}
|
||||||
|
|
||||||
|
newProjectForm :: Form NewProject
|
||||||
|
newProjectForm = renderDivs $ NewProject
|
||||||
|
<$> areq textField "Name*" Nothing
|
||||||
|
<*> areq textField "Description" Nothing
|
||||||
|
|
||||||
data NewLoom = NewLoom
|
data NewLoom = NewLoom
|
||||||
{ nlName :: Text
|
{ nlName :: Text
|
||||||
, nlDesc :: Text
|
, nlDesc :: Text
|
||||||
|
@ -115,6 +129,38 @@ deckInviteForm deckID = renderDivs $ DeckInvite
|
||||||
l
|
l
|
||||||
selectRole = selectField optionsEnum
|
selectRole = selectField optionsEnum
|
||||||
|
|
||||||
|
data ProjectInvite = ProjectInvite
|
||||||
|
{ jiPerson :: PersonId
|
||||||
|
, jiRole :: AP.Role
|
||||||
|
}
|
||||||
|
|
||||||
|
projectInviteForm :: ProjectId -> Form ProjectInvite
|
||||||
|
projectInviteForm projectID = renderDivs $ ProjectInvite
|
||||||
|
<$> areq selectPerson "Person*" Nothing
|
||||||
|
<*> areq selectRole "Role*" Nothing
|
||||||
|
where
|
||||||
|
selectPerson = selectField $ do
|
||||||
|
l <- runDB $ E.select $
|
||||||
|
E.from $ \ (person `E.InnerJoin` actor `E.LeftOuterJoin` (recip `E.InnerJoin` topic)) -> do
|
||||||
|
E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicProjectCollab E.&&.
|
||||||
|
topic E.^. CollabTopicProjectProject E.==. E.val projectID
|
||||||
|
E.on $ person E.^. PersonId E.==. recip E.^. CollabRecipLocalPerson
|
||||||
|
E.on $ person E.^. PersonActor E.==. actor E.^. ActorId
|
||||||
|
E.where_ $ E.isNothing $ E.just $ recip E.^. CollabRecipLocalId
|
||||||
|
return (person, actor)
|
||||||
|
optionsPairs $
|
||||||
|
map (\ (Entity pid p, Entity _ a) ->
|
||||||
|
( T.concat
|
||||||
|
[ actorName a
|
||||||
|
, " ~"
|
||||||
|
, username2text $ personUsername p
|
||||||
|
]
|
||||||
|
, pid
|
||||||
|
)
|
||||||
|
)
|
||||||
|
l
|
||||||
|
selectRole = selectField optionsEnum
|
||||||
|
|
||||||
{-
|
{-
|
||||||
editProjectAForm :: SharerId -> Entity Project -> AForm Handler Project
|
editProjectAForm :: SharerId -> Entity Project -> AForm Handler Project
|
||||||
editProjectAForm sid (Entity jid project) = Project
|
editProjectAForm sid (Entity jid project) = Project
|
||||||
|
|
|
@ -157,6 +157,7 @@ type LoomKeyHashid = KeyHashid Loom
|
||||||
type TicketDeckKeyHashid = KeyHashid TicketDeck
|
type TicketDeckKeyHashid = KeyHashid TicketDeck
|
||||||
type TicketLoomKeyHashid = KeyHashid TicketLoom
|
type TicketLoomKeyHashid = KeyHashid TicketLoom
|
||||||
type SigKeyKeyHashid = KeyHashid SigKey
|
type SigKeyKeyHashid = KeyHashid SigKey
|
||||||
|
type ProjectKeyHashid = KeyHashid Project
|
||||||
|
|
||||||
-- This is where we define all of the routes in our application. For a full
|
-- This is where we define all of the routes in our application. For a full
|
||||||
-- explanation of the syntax, please see:
|
-- explanation of the syntax, please see:
|
||||||
|
@ -982,3 +983,20 @@ instance YesodBreadcrumbs App where
|
||||||
ClothReplyOnR l c _ -> ("Reply", Just $ ClothR l c)
|
ClothReplyOnR l c _ -> ("Reply", Just $ ClothR l c)
|
||||||
|
|
||||||
ClothDepR l c p -> (keyHashidText p, Just $ ClothDepsR l c)
|
ClothDepR l c p -> (keyHashidText p, Just $ ClothDepsR l c)
|
||||||
|
|
||||||
|
ProjectR d -> ("Project $" <> keyHashidText d, Just HomeR)
|
||||||
|
ProjectInboxR d -> ("Inbox", Just $ ProjectR d)
|
||||||
|
ProjectOutboxR d -> ("Outbox", Just $ ProjectR d)
|
||||||
|
ProjectOutboxItemR d i -> (keyHashidText i, Just $ ProjectOutboxR d)
|
||||||
|
ProjectFollowersR d -> ("Followers", Just $ ProjectR d)
|
||||||
|
|
||||||
|
ProjectMessageR d m -> ("Message #" <> keyHashidText m, Just $ ProjectR d)
|
||||||
|
|
||||||
|
ProjectNewR -> ("New Project", Just HomeR)
|
||||||
|
|
||||||
|
ProjectStampR d k -> ("Stamp #" <> keyHashidText k, Just $ ProjectR d)
|
||||||
|
|
||||||
|
ProjectCollabsR d -> ("Collaborators", Just $ ProjectR d)
|
||||||
|
|
||||||
|
ProjectInviteR d -> ("Invite", Just $ ProjectR d)
|
||||||
|
ProjectRemoveR _ _ -> ("", Nothing)
|
||||||
|
|
|
@ -122,7 +122,7 @@ getHomeR = do
|
||||||
where
|
where
|
||||||
personalOverview :: Entity Person -> Handler Html
|
personalOverview :: Entity Person -> Handler Html
|
||||||
personalOverview (Entity pid _person) = do
|
personalOverview (Entity pid _person) = do
|
||||||
(repos, decks, looms) <- runDB $ (,,)
|
(repos, decks, looms, projects) <- runDB $ (,,,)
|
||||||
<$> (E.select $ E.from $ \ (recip `E.InnerJoin` collab `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` repo `E.InnerJoin` actor) -> do
|
<$> (E.select $ E.from $ \ (recip `E.InnerJoin` collab `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` repo `E.InnerJoin` actor) -> do
|
||||||
E.on $ repo E.^. RepoActor E.==. actor E.^. ActorId
|
E.on $ repo E.^. RepoActor E.==. actor E.^. ActorId
|
||||||
E.on $ topic E.^. CollabTopicRepoRepo E.==. repo E.^. RepoId
|
E.on $ topic E.^. CollabTopicRepoRepo E.==. repo E.^. RepoId
|
||||||
|
@ -153,15 +153,26 @@ getHomeR = do
|
||||||
E.orderBy [E.asc $ loom E.^. LoomId]
|
E.orderBy [E.asc $ loom E.^. LoomId]
|
||||||
return (loom, actor, collab)
|
return (loom, actor, collab)
|
||||||
)
|
)
|
||||||
|
<*> (E.select $ E.from $ \ (recip `E.InnerJoin` collab `E.InnerJoin` topic `E.InnerJoin` enable `E.InnerJoin` project `E.InnerJoin` actor) -> do
|
||||||
|
E.on $ project E.^. ProjectActor E.==. actor E.^. ActorId
|
||||||
|
E.on $ topic E.^. CollabTopicProjectProject E.==. project E.^. ProjectId
|
||||||
|
E.on $ topic E.^. CollabTopicProjectCollab E.==. enable E.^. CollabEnableCollab
|
||||||
|
E.on $ recip E.^. CollabRecipLocalCollab E.==. topic E.^. CollabTopicProjectCollab
|
||||||
|
E.on $ recip E.^. CollabRecipLocalCollab E.==. collab E.^. CollabId
|
||||||
|
E.where_ $ recip E.^. CollabRecipLocalPerson E.==. E.val pid
|
||||||
|
E.orderBy [E.asc $ project E.^. ProjectId]
|
||||||
|
return (project, actor, collab)
|
||||||
|
)
|
||||||
hashRepo <- getEncodeKeyHashid
|
hashRepo <- getEncodeKeyHashid
|
||||||
hashDeck <- getEncodeKeyHashid
|
hashDeck <- getEncodeKeyHashid
|
||||||
hashLoom <- getEncodeKeyHashid
|
hashLoom <- getEncodeKeyHashid
|
||||||
|
hashProject <- getEncodeKeyHashid
|
||||||
defaultLayout $(widgetFile "personal-overview")
|
defaultLayout $(widgetFile "personal-overview")
|
||||||
|
|
||||||
getBrowseR :: Handler Html
|
getBrowseR :: Handler Html
|
||||||
getBrowseR = do
|
getBrowseR = do
|
||||||
(people, groups, repos, decks, looms) <- runDB $
|
(people, groups, repos, decks, looms, projects) <- runDB $
|
||||||
(,,,,)
|
(,,,,,)
|
||||||
<$> (E.select $ E.from $ \ (person `E.InnerJoin` actor) -> do
|
<$> (E.select $ E.from $ \ (person `E.InnerJoin` actor) -> do
|
||||||
E.on $ person E.^. PersonActor E.==. actor E.^. ActorId
|
E.on $ person E.^. PersonActor E.==. actor E.^. ActorId
|
||||||
E.orderBy [E.asc $ person E.^. PersonId]
|
E.orderBy [E.asc $ person E.^. PersonId]
|
||||||
|
@ -187,6 +198,11 @@ getBrowseR = do
|
||||||
E.orderBy [E.asc $ loom E.^. LoomId]
|
E.orderBy [E.asc $ loom E.^. LoomId]
|
||||||
return (loom, actor)
|
return (loom, actor)
|
||||||
)
|
)
|
||||||
|
<*> (E.select $ E.from $ \ (project `E.InnerJoin` actor) -> do
|
||||||
|
E.on $ project E.^. ProjectActor E.==. actor E.^. ActorId
|
||||||
|
E.orderBy [E.asc $ project E.^. ProjectId]
|
||||||
|
return (project, actor)
|
||||||
|
)
|
||||||
{-
|
{-
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
repoRows <- forM repos $
|
repoRows <- forM repos $
|
||||||
|
@ -209,6 +225,7 @@ getBrowseR = do
|
||||||
hashRepo <- getEncodeKeyHashid
|
hashRepo <- getEncodeKeyHashid
|
||||||
hashDeck <- getEncodeKeyHashid
|
hashDeck <- getEncodeKeyHashid
|
||||||
hashLoom <- getEncodeKeyHashid
|
hashLoom <- getEncodeKeyHashid
|
||||||
|
hashProject <- getEncodeKeyHashid
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle "Welcome to Vervis!"
|
setTitle "Welcome to Vervis!"
|
||||||
$(widgetFile "browse")
|
$(widgetFile "browse")
|
||||||
|
|
332
src/Vervis/Handler/Project.hs
Normal file
332
src/Vervis/Handler/Project.hs
Normal file
|
@ -0,0 +1,332 @@
|
||||||
|
{- This file is part of Vervis.
|
||||||
|
-
|
||||||
|
- Written in 2016, 2019, 2022, 2023 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/>.
|
||||||
|
-}
|
||||||
|
|
||||||
|
module Vervis.Handler.Project
|
||||||
|
( getProjectR
|
||||||
|
, getProjectInboxR
|
||||||
|
, postProjectInboxR
|
||||||
|
, getProjectOutboxR
|
||||||
|
, getProjectOutboxItemR
|
||||||
|
, getProjectFollowersR
|
||||||
|
|
||||||
|
, getProjectMessageR
|
||||||
|
|
||||||
|
, getProjectNewR
|
||||||
|
, postProjectNewR
|
||||||
|
|
||||||
|
, getProjectStampR
|
||||||
|
|
||||||
|
, getProjectCollabsR
|
||||||
|
, getProjectInviteR
|
||||||
|
, postProjectInviteR
|
||||||
|
, postProjectRemoveR
|
||||||
|
)
|
||||||
|
where
|
||||||
|
|
||||||
|
import Control.Applicative
|
||||||
|
import Control.Monad
|
||||||
|
import Control.Monad.Trans.Except
|
||||||
|
import Control.Monad.Trans.Maybe
|
||||||
|
import Data.Aeson
|
||||||
|
import Data.Bitraversable
|
||||||
|
import Data.ByteString (ByteString)
|
||||||
|
import Data.Default.Class
|
||||||
|
import Data.Foldable
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
|
import Data.Text (Text)
|
||||||
|
import Data.Time.Clock
|
||||||
|
import Data.Traversable
|
||||||
|
import Database.Persist
|
||||||
|
import Network.HTTP.Types.Method
|
||||||
|
import Text.Blaze.Html (Html)
|
||||||
|
import Yesod.Auth (requireAuth)
|
||||||
|
import Yesod.Core
|
||||||
|
import Yesod.Core.Handler (redirect, setMessage, lookupPostParam, notFound)
|
||||||
|
import Yesod.Form.Functions (runFormPost, runFormGet)
|
||||||
|
import Yesod.Form.Types (FormResult (..))
|
||||||
|
import Yesod.Persist.Core (runDB, get404, getBy404)
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Lazy as BL
|
||||||
|
import qualified Database.Esqueleto as E
|
||||||
|
|
||||||
|
import Database.Persist.JSON
|
||||||
|
import Development.PatchMediaType
|
||||||
|
import Network.FedURI
|
||||||
|
import Web.ActivityPub hiding (Project (..), Repo (..), Actor (..), ActorDetail (..), ActorLocal (..))
|
||||||
|
import Yesod.ActivityPub
|
||||||
|
import Yesod.FedURI
|
||||||
|
import Yesod.Hashids
|
||||||
|
import Yesod.MonadSite
|
||||||
|
|
||||||
|
import qualified Web.ActivityPub as AP
|
||||||
|
|
||||||
|
import Control.Monad.Trans.Except.Local
|
||||||
|
import Data.Either.Local
|
||||||
|
import Data.Paginate.Local
|
||||||
|
import Database.Persist.Local
|
||||||
|
import Yesod.Form.Local
|
||||||
|
import Yesod.Persist.Local
|
||||||
|
|
||||||
|
import Vervis.Access
|
||||||
|
import Vervis.API
|
||||||
|
import Vervis.Federation.Auth
|
||||||
|
import Vervis.Federation.Collab
|
||||||
|
import Vervis.Federation.Discussion
|
||||||
|
import Vervis.Federation.Offer
|
||||||
|
import Vervis.Federation.Ticket
|
||||||
|
import Vervis.FedURI
|
||||||
|
import Vervis.Form.Ticket
|
||||||
|
import Vervis.Form.Tracker
|
||||||
|
import Vervis.Foundation
|
||||||
|
import Vervis.Model
|
||||||
|
import Vervis.Paginate
|
||||||
|
import Vervis.Persist.Actor
|
||||||
|
import Vervis.Persist.Collab
|
||||||
|
import Vervis.Recipient
|
||||||
|
import Vervis.Settings
|
||||||
|
import Vervis.Ticket
|
||||||
|
import Vervis.TicketFilter
|
||||||
|
import Vervis.Time
|
||||||
|
import Vervis.Web.Actor
|
||||||
|
import Vervis.Widget
|
||||||
|
import Vervis.Widget.Person
|
||||||
|
import Vervis.Widget.Ticket
|
||||||
|
import Vervis.Widget.Tracker
|
||||||
|
|
||||||
|
import qualified Vervis.Client as C
|
||||||
|
|
||||||
|
getProjectR :: KeyHashid Project -> Handler TypedContent
|
||||||
|
getProjectR projectHash = do
|
||||||
|
projectID <- decodeKeyHashid404 projectHash
|
||||||
|
(project, actor, sigKeyIDs) <- runDB $ do
|
||||||
|
d <- get404 projectID
|
||||||
|
let aid = projectActor d
|
||||||
|
a <- getJust aid
|
||||||
|
sigKeys <- selectKeysList [SigKeyActor ==. aid] [Asc SigKeyId]
|
||||||
|
return (d, a, sigKeys)
|
||||||
|
|
||||||
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
|
hashSigKey <- getEncodeKeyHashid
|
||||||
|
perActor <- asksSite $ appPerActorKeys . appSettings
|
||||||
|
let projectAP = AP.Project
|
||||||
|
{ AP.projectActor = AP.Actor
|
||||||
|
{ AP.actorLocal = AP.ActorLocal
|
||||||
|
{ AP.actorId = encodeRouteLocal $ ProjectR projectHash
|
||||||
|
, AP.actorInbox = encodeRouteLocal $ ProjectInboxR projectHash
|
||||||
|
, AP.actorOutbox =
|
||||||
|
Just $ encodeRouteLocal $ ProjectOutboxR projectHash
|
||||||
|
, AP.actorFollowers =
|
||||||
|
Just $ encodeRouteLocal $ ProjectFollowersR projectHash
|
||||||
|
, AP.actorFollowing = Nothing
|
||||||
|
, AP.actorPublicKeys =
|
||||||
|
map (Left . encodeRouteLocal) $
|
||||||
|
if perActor
|
||||||
|
then map (ProjectStampR projectHash . hashSigKey) sigKeyIDs
|
||||||
|
else [ActorKey1R, ActorKey2R]
|
||||||
|
, AP.actorSshKeys = []
|
||||||
|
}
|
||||||
|
, AP.actorDetail = AP.ActorDetail
|
||||||
|
{ AP.actorType = AP.ActorTypeProject
|
||||||
|
, AP.actorUsername = Nothing
|
||||||
|
, AP.actorName = Just $ actorName actor
|
||||||
|
, AP.actorSummary = Just $ actorDesc actor
|
||||||
|
}
|
||||||
|
}
|
||||||
|
, AP.projectTracker = Nothing
|
||||||
|
, AP.projectChildren = []
|
||||||
|
, AP.projectParents = []
|
||||||
|
, AP.projectComponents = []
|
||||||
|
}
|
||||||
|
provideHtmlAndAP projectAP $ redirectToPrettyJSON here
|
||||||
|
where
|
||||||
|
here = ProjectR projectHash
|
||||||
|
|
||||||
|
getProjectInboxR :: KeyHashid Project -> Handler TypedContent
|
||||||
|
getProjectInboxR = getInbox ProjectInboxR projectActor
|
||||||
|
|
||||||
|
postProjectInboxR :: KeyHashid Project -> Handler ()
|
||||||
|
postProjectInboxR projectHash = do
|
||||||
|
projectID <- decodeKeyHashid404 projectHash
|
||||||
|
postInbox $ LocalActorProject projectID
|
||||||
|
|
||||||
|
getProjectOutboxR :: KeyHashid Project -> Handler TypedContent
|
||||||
|
getProjectOutboxR = getOutbox ProjectOutboxR ProjectOutboxItemR projectActor
|
||||||
|
|
||||||
|
getProjectOutboxItemR
|
||||||
|
:: KeyHashid Project -> KeyHashid OutboxItem -> Handler TypedContent
|
||||||
|
getProjectOutboxItemR = getOutboxItem ProjectOutboxItemR projectActor
|
||||||
|
|
||||||
|
getProjectFollowersR :: KeyHashid Project -> Handler TypedContent
|
||||||
|
getProjectFollowersR = getActorFollowersCollection ProjectFollowersR projectActor
|
||||||
|
|
||||||
|
getProjectMessageR :: KeyHashid Project -> KeyHashid LocalMessage -> Handler Html
|
||||||
|
getProjectMessageR _ _ = notFound
|
||||||
|
|
||||||
|
getProjectNewR :: Handler Html
|
||||||
|
getProjectNewR = do
|
||||||
|
((_result, widget), enctype) <- runFormPost newProjectForm
|
||||||
|
defaultLayout $(widgetFile "project/new")
|
||||||
|
|
||||||
|
postProjectNewR :: Handler Html
|
||||||
|
postProjectNewR = do
|
||||||
|
NewProject name desc <- runFormPostRedirect ProjectNewR newProjectForm
|
||||||
|
|
||||||
|
personEntity@(Entity personID person) <- requireAuth
|
||||||
|
personHash <- encodeKeyHashid personID
|
||||||
|
(maybeSummary, audience, detail) <- C.createProject personHash name desc
|
||||||
|
(localRecips, remoteRecips, fwdHosts, action) <-
|
||||||
|
C.makeServerInput Nothing maybeSummary audience $ AP.CreateActivity $ AP.Create (AP.CreateProject detail Nothing) Nothing
|
||||||
|
result <-
|
||||||
|
runExceptT $
|
||||||
|
handleViaActor personID Nothing localRecips remoteRecips fwdHosts action
|
||||||
|
|
||||||
|
case result of
|
||||||
|
Left e -> do
|
||||||
|
setMessage $ toHtml e
|
||||||
|
redirect ProjectNewR
|
||||||
|
Right createID -> do
|
||||||
|
maybeProjectID <- runDB $ getKeyBy $ UniqueProjectCreate createID
|
||||||
|
case maybeProjectID of
|
||||||
|
Nothing -> error "Can't find the newly created project"
|
||||||
|
Just projectID -> do
|
||||||
|
projectHash <- encodeKeyHashid projectID
|
||||||
|
setMessage "New project created"
|
||||||
|
redirect $ ProjectR projectHash
|
||||||
|
|
||||||
|
getProjectStampR :: KeyHashid Project -> KeyHashid SigKey -> Handler TypedContent
|
||||||
|
getProjectStampR = servePerActorKey projectActor LocalActorProject
|
||||||
|
|
||||||
|
getProjectCollabsR :: KeyHashid Project -> Handler Html
|
||||||
|
getProjectCollabsR projectHash = do
|
||||||
|
projectID <- decodeKeyHashid404 projectHash
|
||||||
|
(project, actor, collabs, invites, joins) <- runDB $ do
|
||||||
|
project <- get404 projectID
|
||||||
|
actor <- getJust $ projectActor project
|
||||||
|
collabs <- do
|
||||||
|
grants <-
|
||||||
|
getTopicGrants CollabTopicProjectCollab CollabTopicProjectProject projectID
|
||||||
|
for grants $ \ (role, actor, ct, time) ->
|
||||||
|
(,role,ct,time) <$> getPersonWidgetInfo actor
|
||||||
|
invites <- do
|
||||||
|
invites' <-
|
||||||
|
getTopicInvites CollabTopicProjectCollab CollabTopicProjectProject projectID
|
||||||
|
for invites' $ \ (inviter, recip, time, role) -> (,,,)
|
||||||
|
<$> (getPersonWidgetInfo =<< bitraverse grabPerson pure inviter)
|
||||||
|
<*> getPersonWidgetInfo recip
|
||||||
|
<*> pure time
|
||||||
|
<*> pure role
|
||||||
|
joins <- do
|
||||||
|
joins' <-
|
||||||
|
getTopicJoins CollabTopicProjectCollab CollabTopicProjectProject projectID
|
||||||
|
for joins' $ \ (recip, time, role) ->
|
||||||
|
(,time,role) <$> getPersonWidgetInfo recip
|
||||||
|
return (project, actor, collabs, invites, joins)
|
||||||
|
defaultLayout $(widgetFile "project/collab/list")
|
||||||
|
where
|
||||||
|
grabPerson actorID = do
|
||||||
|
actorByKey <- getLocalActor actorID
|
||||||
|
case actorByKey of
|
||||||
|
LocalActorPerson personID -> return personID
|
||||||
|
_ -> error "Surprise, local inviter actor isn't a Person"
|
||||||
|
|
||||||
|
getProjectInviteR :: KeyHashid Project -> Handler Html
|
||||||
|
getProjectInviteR projectHash = do
|
||||||
|
projectID <- decodeKeyHashid404 projectHash
|
||||||
|
((_result, widget), enctype) <- runFormPost $ projectInviteForm projectID
|
||||||
|
defaultLayout $(widgetFile "project/collab/new")
|
||||||
|
|
||||||
|
postProjectInviteR :: KeyHashid Project -> Handler Html
|
||||||
|
postProjectInviteR projectHash = do
|
||||||
|
projectID <- decodeKeyHashid404 projectHash
|
||||||
|
ProjectInvite recipPersonID role <-
|
||||||
|
runFormPostRedirect (ProjectInviteR projectHash) $ projectInviteForm projectID
|
||||||
|
|
||||||
|
personEntity@(Entity personID person) <- requireAuth
|
||||||
|
personHash <- encodeKeyHashid personID
|
||||||
|
recipPersonHash <- encodeKeyHashid recipPersonID
|
||||||
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
|
|
||||||
|
result <- runExceptT $ do
|
||||||
|
(maybeSummary, audience, invite) <- do
|
||||||
|
let uRecipient = encodeRouteHome $ PersonR recipPersonHash
|
||||||
|
uResource = encodeRouteHome $ ProjectR projectHash
|
||||||
|
C.invite personID uRecipient uResource role
|
||||||
|
grantID <- do
|
||||||
|
maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID
|
||||||
|
fromMaybeE maybeItem "You need to be a collaborator in the Project to invite people"
|
||||||
|
grantHash <- encodeKeyHashid grantID
|
||||||
|
let uCap = encodeRouteHome $ ProjectOutboxItemR projectHash grantHash
|
||||||
|
(localRecips, remoteRecips, fwdHosts, action) <-
|
||||||
|
C.makeServerInput (Just uCap) maybeSummary audience $ AP.InviteActivity invite
|
||||||
|
let cap =
|
||||||
|
Left (LocalActorProject projectID, LocalActorProject projectHash, grantID)
|
||||||
|
handleViaActor
|
||||||
|
personID (Just cap) localRecips remoteRecips fwdHosts action
|
||||||
|
|
||||||
|
case result of
|
||||||
|
Left e -> do
|
||||||
|
setMessage $ toHtml e
|
||||||
|
redirect $ ProjectInviteR projectHash
|
||||||
|
Right inviteID -> do
|
||||||
|
setMessage "Invite sent"
|
||||||
|
redirect $ ProjectCollabsR projectHash
|
||||||
|
|
||||||
|
postProjectRemoveR :: KeyHashid Project -> CollabTopicProjectId -> Handler Html
|
||||||
|
postProjectRemoveR projectHash ctID = do
|
||||||
|
projectID <- decodeKeyHashid404 projectHash
|
||||||
|
|
||||||
|
personEntity@(Entity personID person) <- requireAuth
|
||||||
|
personHash <- encodeKeyHashid personID
|
||||||
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
|
|
||||||
|
result <- runExceptT $ do
|
||||||
|
mpidOrU <- lift $ runDB $ runMaybeT $ do
|
||||||
|
CollabTopicProject collabID projectID' <- MaybeT $ get ctID
|
||||||
|
guard $ projectID' == projectID
|
||||||
|
_ <- MaybeT $ getBy $ UniqueCollabEnable collabID
|
||||||
|
member <-
|
||||||
|
Left <$> MaybeT (getValBy $ UniqueCollabRecipLocal collabID) <|>
|
||||||
|
Right <$> MaybeT (getValBy $ UniqueCollabRecipRemote collabID)
|
||||||
|
lift $
|
||||||
|
bitraverse
|
||||||
|
(pure . collabRecipLocalPerson)
|
||||||
|
(getRemoteActorURI <=< getJust . collabRecipRemoteActor)
|
||||||
|
member
|
||||||
|
pidOrU <- maybe notFound pure mpidOrU
|
||||||
|
(maybeSummary, audience, remove) <- do
|
||||||
|
uRecipient <-
|
||||||
|
case pidOrU of
|
||||||
|
Left pid -> encodeRouteHome . PersonR <$> encodeKeyHashid pid
|
||||||
|
Right u -> pure u
|
||||||
|
let uResource = encodeRouteHome $ ProjectR projectHash
|
||||||
|
C.remove personID uRecipient uResource
|
||||||
|
grantID <- do
|
||||||
|
maybeItem <- lift $ runDB $ getGrant CollabTopicProjectCollab CollabTopicProjectProject projectID personID
|
||||||
|
fromMaybeE maybeItem "You need to be a collaborator in the Project to remove people"
|
||||||
|
grantHash <- encodeKeyHashid grantID
|
||||||
|
let uCap = encodeRouteHome $ ProjectOutboxItemR projectHash grantHash
|
||||||
|
(localRecips, remoteRecips, fwdHosts, action) <-
|
||||||
|
C.makeServerInput (Just uCap) maybeSummary audience $ AP.RemoveActivity remove
|
||||||
|
let cap =
|
||||||
|
Left (LocalActorProject projectID, LocalActorProject projectHash, grantID)
|
||||||
|
handleViaActor
|
||||||
|
personID (Just cap) localRecips remoteRecips fwdHosts action
|
||||||
|
|
||||||
|
case result of
|
||||||
|
Left e -> do
|
||||||
|
setMessage $ toHtml e
|
||||||
|
Right removeID ->
|
||||||
|
setMessage "Remove sent"
|
||||||
|
redirect $ ProjectCollabsR projectHash
|
|
@ -100,6 +100,10 @@ instance Hashable LoomId where
|
||||||
hashWithSalt salt = hashWithSalt salt . fromSqlKey
|
hashWithSalt salt = hashWithSalt salt . fromSqlKey
|
||||||
hash = hash . fromSqlKey
|
hash = hash . fromSqlKey
|
||||||
|
|
||||||
|
instance Hashable ProjectId where
|
||||||
|
hashWithSalt salt = hashWithSalt salt . fromSqlKey
|
||||||
|
hash = hash . fromSqlKey
|
||||||
|
|
||||||
{-
|
{-
|
||||||
instance PersistEntityGraph Ticket TicketDependency where
|
instance PersistEntityGraph Ticket TicketDependency where
|
||||||
sourceParam = ticketDependencyParent
|
sourceParam = ticketDependencyParent
|
||||||
|
|
|
@ -81,14 +81,16 @@ getLocalActorEnt actorID = do
|
||||||
mr <- getBy $ UniqueRepoActor actorID
|
mr <- getBy $ UniqueRepoActor actorID
|
||||||
md <- getBy $ UniqueDeckActor actorID
|
md <- getBy $ UniqueDeckActor actorID
|
||||||
ml <- getBy $ UniqueLoomActor actorID
|
ml <- getBy $ UniqueLoomActor actorID
|
||||||
|
mj <- getBy $ UniqueProjectActor actorID
|
||||||
return $
|
return $
|
||||||
case (mp, mg, mr, md, ml) of
|
case (mp, mg, mr, md, ml, mj) of
|
||||||
(Nothing, Nothing, Nothing, Nothing, Nothing) -> error "Unused ActorId"
|
(Nothing, Nothing, Nothing, Nothing, Nothing, Nothing) -> error "Unused ActorId"
|
||||||
(Just p, Nothing, Nothing, Nothing, Nothing) -> LocalActorPerson p
|
(Just p, Nothing, Nothing, Nothing, Nothing, Nothing) -> LocalActorPerson p
|
||||||
(Nothing, Just g, Nothing, Nothing, Nothing) -> LocalActorGroup g
|
(Nothing, Just g, Nothing, Nothing, Nothing, Nothing) -> LocalActorGroup g
|
||||||
(Nothing, Nothing, Just r, Nothing, Nothing) -> LocalActorRepo r
|
(Nothing, Nothing, Just r, Nothing, Nothing, Nothing) -> LocalActorRepo r
|
||||||
(Nothing, Nothing, Nothing, Just d, Nothing) -> LocalActorDeck d
|
(Nothing, Nothing, Nothing, Just d, Nothing, Nothing) -> LocalActorDeck d
|
||||||
(Nothing, Nothing, Nothing, Nothing, Just l) -> LocalActorLoom l
|
(Nothing, Nothing, Nothing, Nothing, Just l, Nothing) -> LocalActorLoom l
|
||||||
|
(Nothing, Nothing, Nothing, Nothing, Nothing, Just j) -> LocalActorProject j
|
||||||
_ -> error "Multi-usage of an ActorId"
|
_ -> error "Multi-usage of an ActorId"
|
||||||
|
|
||||||
getLocalActorEntity
|
getLocalActorEntity
|
||||||
|
@ -105,6 +107,8 @@ getLocalActorEntity (LocalActorDeck d) =
|
||||||
fmap (LocalActorDeck . Entity d) <$> get d
|
fmap (LocalActorDeck . Entity d) <$> get d
|
||||||
getLocalActorEntity (LocalActorLoom l) =
|
getLocalActorEntity (LocalActorLoom l) =
|
||||||
fmap (LocalActorLoom . Entity l) <$> get l
|
fmap (LocalActorLoom . Entity l) <$> get l
|
||||||
|
getLocalActorEntity (LocalActorProject r) =
|
||||||
|
fmap (LocalActorProject . Entity r) <$> get r
|
||||||
|
|
||||||
verifyLocalActivityExistsInDB
|
verifyLocalActivityExistsInDB
|
||||||
:: MonadIO m
|
:: MonadIO m
|
||||||
|
|
|
@ -63,15 +63,18 @@ getCollabTopic collabID = do
|
||||||
maybeRepo <- getValBy $ UniqueCollabTopicRepo collabID
|
maybeRepo <- getValBy $ UniqueCollabTopicRepo collabID
|
||||||
maybeDeck <- getValBy $ UniqueCollabTopicDeck collabID
|
maybeDeck <- getValBy $ UniqueCollabTopicDeck collabID
|
||||||
maybeLoom <- getValBy $ UniqueCollabTopicLoom collabID
|
maybeLoom <- getValBy $ UniqueCollabTopicLoom collabID
|
||||||
|
maybeProject <- getValBy $ UniqueCollabTopicProject collabID
|
||||||
return $
|
return $
|
||||||
case (maybeRepo, maybeDeck, maybeLoom) of
|
case (maybeRepo, maybeDeck, maybeLoom, maybeProject) of
|
||||||
(Nothing, Nothing, Nothing) -> error "Found Collab without topic"
|
(Nothing, Nothing, Nothing, Nothing) -> error "Found Collab without topic"
|
||||||
(Just r, Nothing, Nothing) ->
|
(Just r, Nothing, Nothing, Nothing) ->
|
||||||
GrantResourceRepo $ collabTopicRepoRepo r
|
GrantResourceRepo $ collabTopicRepoRepo r
|
||||||
(Nothing, Just d, Nothing) ->
|
(Nothing, Just d, Nothing, Nothing) ->
|
||||||
GrantResourceDeck $ collabTopicDeckDeck d
|
GrantResourceDeck $ collabTopicDeckDeck d
|
||||||
(Nothing, Nothing, Just l) ->
|
(Nothing, Nothing, Just l, Nothing) ->
|
||||||
GrantResourceLoom $ collabTopicLoomLoom l
|
GrantResourceLoom $ collabTopicLoomLoom l
|
||||||
|
(Nothing, Nothing, Nothing, Just l) ->
|
||||||
|
GrantResourceProject $ collabTopicProjectProject l
|
||||||
_ -> error "Found Collab with multiple topics"
|
_ -> error "Found Collab with multiple topics"
|
||||||
|
|
||||||
getCollabTopic'
|
getCollabTopic'
|
||||||
|
@ -80,15 +83,18 @@ getCollabTopic' collabID = do
|
||||||
maybeRepo <- getBy $ UniqueCollabTopicRepo collabID
|
maybeRepo <- getBy $ UniqueCollabTopicRepo collabID
|
||||||
maybeDeck <- getBy $ UniqueCollabTopicDeck collabID
|
maybeDeck <- getBy $ UniqueCollabTopicDeck collabID
|
||||||
maybeLoom <- getBy $ UniqueCollabTopicLoom collabID
|
maybeLoom <- getBy $ UniqueCollabTopicLoom collabID
|
||||||
|
maybeProject <- getBy $ UniqueCollabTopicProject collabID
|
||||||
return $
|
return $
|
||||||
case (maybeRepo, maybeDeck, maybeLoom) of
|
case (maybeRepo, maybeDeck, maybeLoom, maybeProject) of
|
||||||
(Nothing, Nothing, Nothing) -> error "Found Collab without topic"
|
(Nothing, Nothing, Nothing, Nothing) -> error "Found Collab without topic"
|
||||||
(Just (Entity k r), Nothing, Nothing) ->
|
(Just (Entity k r), Nothing, Nothing, Nothing) ->
|
||||||
(delete k, GrantResourceRepo $ collabTopicRepoRepo r)
|
(delete k, GrantResourceRepo $ collabTopicRepoRepo r)
|
||||||
(Nothing, Just (Entity k d), Nothing) ->
|
(Nothing, Just (Entity k d), Nothing, Nothing) ->
|
||||||
(delete k, GrantResourceDeck $ collabTopicDeckDeck d)
|
(delete k, GrantResourceDeck $ collabTopicDeckDeck d)
|
||||||
(Nothing, Nothing, Just (Entity k l)) ->
|
(Nothing, Nothing, Just (Entity k l), Nothing) ->
|
||||||
(delete k, GrantResourceLoom $ collabTopicLoomLoom l)
|
(delete k, GrantResourceLoom $ collabTopicLoomLoom l)
|
||||||
|
(Nothing, Nothing, Nothing, Just (Entity k l)) ->
|
||||||
|
(delete k, GrantResourceProject $ collabTopicProjectProject l)
|
||||||
_ -> error "Found Collab with multiple topics"
|
_ -> error "Found Collab with multiple topics"
|
||||||
|
|
||||||
getGrantRecip (GrantRecipPerson k) e = GrantRecipPerson <$> getEntityE k e
|
getGrantRecip (GrantRecipPerson k) e = GrantRecipPerson <$> getEntityE k e
|
||||||
|
@ -284,19 +290,7 @@ verifyCapability (capActor, capItem) actor resource requiredRole = do
|
||||||
throwE "Collab recipient is someone else"
|
throwE "Collab recipient is someone else"
|
||||||
|
|
||||||
-- Find the local topic, on which this Collab gives access
|
-- Find the local topic, on which this Collab gives access
|
||||||
topic <- lift $ do
|
topic <- lift $ getCollabTopic collabID
|
||||||
maybeRepo <- getValBy $ UniqueCollabTopicRepo collabID
|
|
||||||
maybeDeck <- getValBy $ UniqueCollabTopicDeck collabID
|
|
||||||
maybeLoom <- getValBy $ UniqueCollabTopicLoom collabID
|
|
||||||
case (maybeRepo, maybeDeck, maybeLoom) of
|
|
||||||
(Nothing, Nothing, Nothing) -> error "Collab without topic"
|
|
||||||
(Just r, Nothing, Nothing) ->
|
|
||||||
return $ GrantResourceRepo $ collabTopicRepoRepo r
|
|
||||||
(Nothing, Just d, Nothing) ->
|
|
||||||
return $ GrantResourceDeck $ collabTopicDeckDeck d
|
|
||||||
(Nothing, Nothing, Just l) ->
|
|
||||||
return $ GrantResourceLoom $ collabTopicLoomLoom l
|
|
||||||
_ -> error "Collab with multiple topics"
|
|
||||||
|
|
||||||
-- Verify that topic is indeed the sender of the Grant
|
-- Verify that topic is indeed the sender of the Grant
|
||||||
unless (grantResourceLocalActor topic == capActor) $
|
unless (grantResourceLocalActor topic == capActor) $
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2016, 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2016, 2019, 2020, 2022, 2023
|
||||||
|
- by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -92,6 +93,9 @@ getLocalAuthor lmid aid name = do
|
||||||
LocalActorLoom loomID -> do
|
LocalActorLoom loomID -> do
|
||||||
loomHash <- encodeKeyHashid loomID
|
loomHash <- encodeKeyHashid loomID
|
||||||
return $ "+" <> keyHashidText loomHash
|
return $ "+" <> keyHashidText loomHash
|
||||||
|
LocalActorProject projectID -> do
|
||||||
|
projectHash <- encodeKeyHashid projectID
|
||||||
|
return $ "$" <> keyHashidText projectHash
|
||||||
return $ MessageTreeNodeLocal lmid authorByKey code name
|
return $ MessageTreeNodeLocal lmid authorByKey code name
|
||||||
|
|
||||||
getAllMessages :: AppDB DiscussionId -> Handler [MessageTreeNode]
|
getAllMessages :: AppDB DiscussionId -> Handler [MessageTreeNode]
|
||||||
|
|
|
@ -69,6 +69,7 @@ module Vervis.Recipient
|
||||||
, RepoRoutes (..)
|
, RepoRoutes (..)
|
||||||
, DeckRoutes (..)
|
, DeckRoutes (..)
|
||||||
, LoomRoutes (..)
|
, LoomRoutes (..)
|
||||||
|
, ProjectRoutes (..)
|
||||||
, DeckFamilyRoutes (..)
|
, DeckFamilyRoutes (..)
|
||||||
, LoomFamilyRoutes (..)
|
, LoomFamilyRoutes (..)
|
||||||
, RecipientRoutes (..)
|
, RecipientRoutes (..)
|
||||||
|
@ -192,6 +193,7 @@ parseLocalActor (GroupR gkhid) = Just $ LocalActorGroup gkhid
|
||||||
parseLocalActor (RepoR rkhid) = Just $ LocalActorRepo rkhid
|
parseLocalActor (RepoR rkhid) = Just $ LocalActorRepo rkhid
|
||||||
parseLocalActor (DeckR dkhid) = Just $ LocalActorDeck dkhid
|
parseLocalActor (DeckR dkhid) = Just $ LocalActorDeck dkhid
|
||||||
parseLocalActor (LoomR lkhid) = Just $ LocalActorLoom lkhid
|
parseLocalActor (LoomR lkhid) = Just $ LocalActorLoom lkhid
|
||||||
|
parseLocalActor (ProjectR jkhid) = Just $ LocalActorProject jkhid
|
||||||
parseLocalActor _ = Nothing
|
parseLocalActor _ = Nothing
|
||||||
|
|
||||||
renderLocalActor :: LocalActor -> Route App
|
renderLocalActor :: LocalActor -> Route App
|
||||||
|
@ -200,6 +202,7 @@ renderLocalActor (LocalActorGroup gkhid) = GroupR gkhid
|
||||||
renderLocalActor (LocalActorRepo rkhid) = RepoR rkhid
|
renderLocalActor (LocalActorRepo rkhid) = RepoR rkhid
|
||||||
renderLocalActor (LocalActorDeck dkhid) = DeckR dkhid
|
renderLocalActor (LocalActorDeck dkhid) = DeckR dkhid
|
||||||
renderLocalActor (LocalActorLoom lkhid) = LoomR lkhid
|
renderLocalActor (LocalActorLoom lkhid) = LoomR lkhid
|
||||||
|
renderLocalActor (LocalActorProject jkhid) = ProjectR jkhid
|
||||||
|
|
||||||
data LocalStageBy f
|
data LocalStageBy f
|
||||||
= LocalStagePersonFollowers (f Person)
|
= LocalStagePersonFollowers (f Person)
|
||||||
|
@ -213,6 +216,8 @@ data LocalStageBy f
|
||||||
|
|
||||||
| LocalStageLoomFollowers (f Loom)
|
| LocalStageLoomFollowers (f Loom)
|
||||||
| LocalStageClothFollowers (f Loom) (f TicketLoom)
|
| LocalStageClothFollowers (f Loom) (f TicketLoom)
|
||||||
|
|
||||||
|
| LocalStageProjectFollowers (f Project)
|
||||||
deriving (Generic, FunctorB, ConstraintsB)
|
deriving (Generic, FunctorB, ConstraintsB)
|
||||||
|
|
||||||
deriving instance AllBF Eq f LocalStageBy => Eq (LocalStageBy f)
|
deriving instance AllBF Eq f LocalStageBy => Eq (LocalStageBy f)
|
||||||
|
@ -235,6 +240,8 @@ parseLocalStage (LoomFollowersR lkhid) =
|
||||||
Just $ LocalStageLoomFollowers lkhid
|
Just $ LocalStageLoomFollowers lkhid
|
||||||
parseLocalStage (ClothFollowersR lkhid ltkhid) =
|
parseLocalStage (ClothFollowersR lkhid ltkhid) =
|
||||||
Just $ LocalStageClothFollowers lkhid ltkhid
|
Just $ LocalStageClothFollowers lkhid ltkhid
|
||||||
|
parseLocalStage (ProjectFollowersR jkhid) =
|
||||||
|
Just $ LocalStageProjectFollowers jkhid
|
||||||
parseLocalStage _ = Nothing
|
parseLocalStage _ = Nothing
|
||||||
|
|
||||||
renderLocalStage :: LocalStage -> Route App
|
renderLocalStage :: LocalStage -> Route App
|
||||||
|
@ -252,6 +259,8 @@ renderLocalStage (LocalStageLoomFollowers lkhid) =
|
||||||
LoomFollowersR lkhid
|
LoomFollowersR lkhid
|
||||||
renderLocalStage (LocalStageClothFollowers lkhid ltkhid) =
|
renderLocalStage (LocalStageClothFollowers lkhid ltkhid) =
|
||||||
ClothFollowersR lkhid ltkhid
|
ClothFollowersR lkhid ltkhid
|
||||||
|
renderLocalStage (LocalStageProjectFollowers jkhid) =
|
||||||
|
ProjectFollowersR jkhid
|
||||||
|
|
||||||
parseLocalRecipient :: Route App -> Maybe (Either LocalActor LocalStage)
|
parseLocalRecipient :: Route App -> Maybe (Either LocalActor LocalStage)
|
||||||
parseLocalRecipient r =
|
parseLocalRecipient r =
|
||||||
|
@ -263,6 +272,7 @@ localActorFollowers (LocalActorGroup g) = LocalStageGroupFollowers g
|
||||||
localActorFollowers (LocalActorRepo r) = LocalStageRepoFollowers r
|
localActorFollowers (LocalActorRepo r) = LocalStageRepoFollowers r
|
||||||
localActorFollowers (LocalActorDeck d) = LocalStageDeckFollowers d
|
localActorFollowers (LocalActorDeck d) = LocalStageDeckFollowers d
|
||||||
localActorFollowers (LocalActorLoom l) = LocalStageLoomFollowers l
|
localActorFollowers (LocalActorLoom l) = LocalStageLoomFollowers l
|
||||||
|
localActorFollowers (LocalActorProject j) = LocalStageProjectFollowers j
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Converting between KeyHashid, Key, Identity and Entity
|
-- Converting between KeyHashid, Key, Identity and Entity
|
||||||
|
@ -327,6 +337,8 @@ hashLocalStagePure ctx = f
|
||||||
LocalStageClothFollowers
|
LocalStageClothFollowers
|
||||||
(encodeKeyHashidPure ctx l)
|
(encodeKeyHashidPure ctx l)
|
||||||
(encodeKeyHashidPure ctx c)
|
(encodeKeyHashidPure ctx c)
|
||||||
|
f (LocalStageProjectFollowers j) =
|
||||||
|
LocalStageProjectFollowers $ encodeKeyHashidPure ctx j
|
||||||
|
|
||||||
getHashLocalStage
|
getHashLocalStage
|
||||||
:: (MonadSite m, YesodHashids (SiteEnv m))
|
:: (MonadSite m, YesodHashids (SiteEnv m))
|
||||||
|
@ -364,6 +376,8 @@ unhashLocalStagePure ctx = f
|
||||||
LocalStageClothFollowers
|
LocalStageClothFollowers
|
||||||
<$> decodeKeyHashidPure ctx l
|
<$> decodeKeyHashidPure ctx l
|
||||||
<*> decodeKeyHashidPure ctx c
|
<*> decodeKeyHashidPure ctx c
|
||||||
|
f (LocalStageProjectFollowers j) =
|
||||||
|
LocalStageProjectFollowers <$> decodeKeyHashidPure ctx j
|
||||||
|
|
||||||
unhashLocalStage
|
unhashLocalStage
|
||||||
:: (MonadSite m, YesodHashids (SiteEnv m))
|
:: (MonadSite m, YesodHashids (SiteEnv m))
|
||||||
|
@ -405,6 +419,7 @@ getLocalActorID (LocalActorGroup g) = fmap groupActor <$> get g
|
||||||
getLocalActorID (LocalActorRepo r) = fmap repoActor <$> get r
|
getLocalActorID (LocalActorRepo r) = fmap repoActor <$> get r
|
||||||
getLocalActorID (LocalActorDeck d) = fmap deckActor <$> get d
|
getLocalActorID (LocalActorDeck d) = fmap deckActor <$> get d
|
||||||
getLocalActorID (LocalActorLoom l) = fmap loomActor <$> get l
|
getLocalActorID (LocalActorLoom l) = fmap loomActor <$> get l
|
||||||
|
getLocalActorID (LocalActorProject j) = fmap projectActor <$> get j
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Intermediate recipient types
|
-- Intermediate recipient types
|
||||||
|
@ -428,6 +443,8 @@ data LeafDeck = LeafDeck | LeafDeckFollowers deriving (Eq, Ord)
|
||||||
|
|
||||||
data LeafLoom = LeafLoom | LeafLoomFollowers deriving (Eq, Ord)
|
data LeafLoom = LeafLoom | LeafLoomFollowers deriving (Eq, Ord)
|
||||||
|
|
||||||
|
data LeafProject = LeafProject | LeafProjectFollowers deriving (Eq, Ord)
|
||||||
|
|
||||||
data PieceDeck
|
data PieceDeck
|
||||||
= PieceDeck LeafDeck
|
= PieceDeck LeafDeck
|
||||||
| PieceTicket (KeyHashid TicketDeck) LeafTicket
|
| PieceTicket (KeyHashid TicketDeck) LeafTicket
|
||||||
|
@ -444,6 +461,7 @@ data LocalRecipient
|
||||||
| RecipRepo (KeyHashid Repo) LeafRepo
|
| RecipRepo (KeyHashid Repo) LeafRepo
|
||||||
| RecipDeck (KeyHashid Deck) PieceDeck
|
| RecipDeck (KeyHashid Deck) PieceDeck
|
||||||
| RecipLoom (KeyHashid Loom) PieceLoom
|
| RecipLoom (KeyHashid Loom) PieceLoom
|
||||||
|
| RecipProject (KeyHashid Project) LeafProject
|
||||||
deriving (Eq, Ord)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
recipientFromActor :: LocalActor -> LocalRecipient
|
recipientFromActor :: LocalActor -> LocalRecipient
|
||||||
|
@ -457,6 +475,8 @@ recipientFromActor (LocalActorDeck dkhid) =
|
||||||
RecipDeck dkhid $ PieceDeck LeafDeck
|
RecipDeck dkhid $ PieceDeck LeafDeck
|
||||||
recipientFromActor (LocalActorLoom lkhid) =
|
recipientFromActor (LocalActorLoom lkhid) =
|
||||||
RecipLoom lkhid $ PieceLoom LeafLoom
|
RecipLoom lkhid $ PieceLoom LeafLoom
|
||||||
|
recipientFromActor (LocalActorProject jkhid) =
|
||||||
|
RecipProject jkhid LeafProject
|
||||||
|
|
||||||
recipientFromStage :: LocalStage -> LocalRecipient
|
recipientFromStage :: LocalStage -> LocalRecipient
|
||||||
recipientFromStage (LocalStagePersonFollowers pkhid) =
|
recipientFromStage (LocalStagePersonFollowers pkhid) =
|
||||||
|
@ -473,6 +493,8 @@ recipientFromStage (LocalStageLoomFollowers lkhid) =
|
||||||
RecipLoom lkhid $ PieceLoom LeafLoomFollowers
|
RecipLoom lkhid $ PieceLoom LeafLoomFollowers
|
||||||
recipientFromStage (LocalStageClothFollowers lkhid ltkhid) =
|
recipientFromStage (LocalStageClothFollowers lkhid ltkhid) =
|
||||||
RecipLoom lkhid $ PieceCloth ltkhid LeafClothFollowers
|
RecipLoom lkhid $ PieceCloth ltkhid LeafClothFollowers
|
||||||
|
recipientFromStage (LocalStageProjectFollowers jkhid) =
|
||||||
|
RecipProject jkhid LeafProjectFollowers
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- Recipient set types
|
-- Recipient set types
|
||||||
|
@ -493,19 +515,22 @@ groupLocalRecipients = organize . partitionByActor
|
||||||
, [(KeyHashid Repo, LeafRepo)]
|
, [(KeyHashid Repo, LeafRepo)]
|
||||||
, [(KeyHashid Deck, PieceDeck)]
|
, [(KeyHashid Deck, PieceDeck)]
|
||||||
, [(KeyHashid Loom, PieceLoom)]
|
, [(KeyHashid Loom, PieceLoom)]
|
||||||
|
, [(KeyHashid Project, LeafProject)]
|
||||||
)
|
)
|
||||||
partitionByActor = foldl' f ([], [], [], [], [])
|
partitionByActor = foldl' f ([], [], [], [], [], [])
|
||||||
where
|
where
|
||||||
f (p, g, r, d, l) (RecipPerson pkhid pleaf) =
|
f (p, g, r, d, l, j) (RecipPerson pkhid pleaf) =
|
||||||
((pkhid, pleaf) : p, g, r, d, l)
|
((pkhid, pleaf) : p, g, r, d, l, j)
|
||||||
f (p, g, r, d, l) (RecipGroup gkhid gleaf) =
|
f (p, g, r, d, l, j) (RecipGroup gkhid gleaf) =
|
||||||
(p, (gkhid, gleaf) : g, r, d, l)
|
(p, (gkhid, gleaf) : g, r, d, l, j)
|
||||||
f (p, g, r, d, l) (RecipRepo rkhid rleaf) =
|
f (p, g, r, d, l, j) (RecipRepo rkhid rleaf) =
|
||||||
(p, g, (rkhid, rleaf) : r, d, l)
|
(p, g, (rkhid, rleaf) : r, d, l, j)
|
||||||
f (p, g, r, d, l) (RecipDeck dkhid dpiece) =
|
f (p, g, r, d, l, j) (RecipDeck dkhid dpiece) =
|
||||||
(p, g, r, (dkhid, dpiece) : d, l)
|
(p, g, r, (dkhid, dpiece) : d, l, j)
|
||||||
f (p, g, r, d, l) (RecipLoom lkhid lpiece) =
|
f (p, g, r, d, l, j) (RecipLoom lkhid lpiece) =
|
||||||
(p, g, r, d, (lkhid, lpiece) : l)
|
(p, g, r, d, (lkhid, lpiece) : l, j)
|
||||||
|
f (p, g, r, d, l, j) (RecipProject jkhid jleaf) =
|
||||||
|
(p, g, r, d, l, (jkhid, jleaf) : j)
|
||||||
|
|
||||||
organize
|
organize
|
||||||
:: ( [(KeyHashid Person, LeafPerson)]
|
:: ( [(KeyHashid Person, LeafPerson)]
|
||||||
|
@ -513,9 +538,10 @@ groupLocalRecipients = organize . partitionByActor
|
||||||
, [(KeyHashid Repo, LeafRepo)]
|
, [(KeyHashid Repo, LeafRepo)]
|
||||||
, [(KeyHashid Deck, PieceDeck)]
|
, [(KeyHashid Deck, PieceDeck)]
|
||||||
, [(KeyHashid Loom, PieceLoom)]
|
, [(KeyHashid Loom, PieceLoom)]
|
||||||
|
, [(KeyHashid Project, LeafProject)]
|
||||||
)
|
)
|
||||||
-> RecipientRoutes
|
-> RecipientRoutes
|
||||||
organize (p, g, r, d, l) = RecipientRoutes
|
organize (p, g, r, d, l, j) = RecipientRoutes
|
||||||
{ recipPeople =
|
{ recipPeople =
|
||||||
map (second $ foldr orLP $ PersonRoutes False False) $ groupByKeySort p
|
map (second $ foldr orLP $ PersonRoutes False False) $ groupByKeySort p
|
||||||
, recipGroups =
|
, recipGroups =
|
||||||
|
@ -544,6 +570,8 @@ groupLocalRecipients = organize . partitionByActor
|
||||||
. partitionEithers . NE.toList . NE.map pl2either
|
. partitionEithers . NE.toList . NE.map pl2either
|
||||||
) $
|
) $
|
||||||
groupByKeySort l
|
groupByKeySort l
|
||||||
|
, recipProjects =
|
||||||
|
map (second $ foldr orLJ $ ProjectRoutes False False) $ groupByKeySort j
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
groupByKey :: (Foldable f, Eq a) => f (a, b) -> [(a, NonEmpty b)]
|
groupByKey :: (Foldable f, Eq a) => f (a, b) -> [(a, NonEmpty b)]
|
||||||
|
@ -585,6 +613,11 @@ groupLocalRecipients = organize . partitionByActor
|
||||||
orLC _ cr@(ClothRoutes True) = cr
|
orLC _ cr@(ClothRoutes True) = cr
|
||||||
orLC LeafClothFollowers cr@(ClothRoutes _) = cr { routeClothFollowers = True }
|
orLC LeafClothFollowers cr@(ClothRoutes _) = cr { routeClothFollowers = True }
|
||||||
|
|
||||||
|
orLJ :: LeafProject -> ProjectRoutes -> ProjectRoutes
|
||||||
|
orLJ _ rr@(ProjectRoutes True True) = rr
|
||||||
|
orLJ LeafProject rr@(ProjectRoutes _ _) = rr { routeProject = True }
|
||||||
|
orLJ LeafProjectFollowers rr@(ProjectRoutes _ _) = rr { routeProjectFollowers = True }
|
||||||
|
|
||||||
pd2either :: PieceDeck -> Either LeafDeck (KeyHashid TicketDeck, LeafTicket)
|
pd2either :: PieceDeck -> Either LeafDeck (KeyHashid TicketDeck, LeafTicket)
|
||||||
pd2either (PieceDeck ld) = Left ld
|
pd2either (PieceDeck ld) = Left ld
|
||||||
pd2either (PieceTicket ltkhid lt) = Right (ltkhid, lt)
|
pd2either (PieceTicket ltkhid lt) = Right (ltkhid, lt)
|
||||||
|
@ -622,6 +655,7 @@ localRecipSieve' sieve allowPeople allowOthers routes = RecipientRoutes
|
||||||
, recipRepos = applySieve' applyRepo recipRepos
|
, recipRepos = applySieve' applyRepo recipRepos
|
||||||
, recipDecks = applySieve' applyDeck recipDecks
|
, recipDecks = applySieve' applyDeck recipDecks
|
||||||
, recipLooms = applySieve' applyLoom recipLooms
|
, recipLooms = applySieve' applyLoom recipLooms
|
||||||
|
, recipProjects = applySieve' applyProject recipProjects
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
applySieve
|
applySieve
|
||||||
|
@ -725,6 +759,17 @@ localRecipSieve' sieve allowPeople allowOthers routes = RecipientRoutes
|
||||||
then Nothing
|
then Nothing
|
||||||
else Just (lkhid, LoomFamilyRoutes loom cloths)
|
else Just (lkhid, LoomFamilyRoutes loom cloths)
|
||||||
|
|
||||||
|
applyProject _ (This _) = Nothing
|
||||||
|
applyProject rkhid (That r) =
|
||||||
|
if allowOthers && routeProject r
|
||||||
|
then Just (rkhid, ProjectRoutes True False)
|
||||||
|
else Nothing
|
||||||
|
applyProject rkhid (These (ProjectRoutes r' rf') (ProjectRoutes r rf)) =
|
||||||
|
let merged = ProjectRoutes (r && (r' || allowOthers)) (rf && rf')
|
||||||
|
in if merged == ProjectRoutes False False
|
||||||
|
then Nothing
|
||||||
|
else Just (rkhid, merged)
|
||||||
|
|
||||||
actorIsAddressed :: RecipientRoutes -> LocalActor -> Bool
|
actorIsAddressed :: RecipientRoutes -> LocalActor -> Bool
|
||||||
actorIsAddressed recips = isJust . verify
|
actorIsAddressed recips = isJust . verify
|
||||||
where
|
where
|
||||||
|
@ -743,6 +788,9 @@ actorIsAddressed recips = isJust . verify
|
||||||
verify (LocalActorLoom l) = do
|
verify (LocalActorLoom l) = do
|
||||||
routes <- lookup l $ recipLooms recips
|
routes <- lookup l $ recipLooms recips
|
||||||
guard $ routeLoom $ familyLoom routes
|
guard $ routeLoom $ familyLoom routes
|
||||||
|
verify (LocalActorProject j) = do
|
||||||
|
routes <- lookup j $ recipProjects recips
|
||||||
|
guard $ routeProject routes
|
||||||
|
|
||||||
data ParsedAudience u = ParsedAudience
|
data ParsedAudience u = ParsedAudience
|
||||||
{ paudLocalRecips :: RecipientRoutes
|
{ paudLocalRecips :: RecipientRoutes
|
||||||
|
|
|
@ -378,6 +378,8 @@ getLocalActors actorIDs = do
|
||||||
selectKeysList [DeckActor <-. actorIDs] []
|
selectKeysList [DeckActor <-. actorIDs] []
|
||||||
, map LocalActorLoom <$>
|
, map LocalActorLoom <$>
|
||||||
selectKeysList [LoomActor <-. actorIDs] []
|
selectKeysList [LoomActor <-. actorIDs] []
|
||||||
|
, map LocalActorProject <$>
|
||||||
|
selectKeysList [ProjectActor <-. actorIDs] []
|
||||||
]
|
]
|
||||||
case compare (length localActors) (length actorIDs) of
|
case compare (length localActors) (length actorIDs) of
|
||||||
LT -> error "Found actor ID not used by any specific actor"
|
LT -> error "Found actor ID not used by any specific actor"
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
{- This file is part of Vervis.
|
{- This file is part of Vervis.
|
||||||
-
|
-
|
||||||
- Written in 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
- Written in 2019, 2022, 2023 by fr33domlover <fr33domlover@riseup.net>.
|
||||||
-
|
-
|
||||||
- ♡ Copying is an act of love. Please copy, reuse and share.
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
-
|
-
|
||||||
|
@ -16,6 +16,7 @@
|
||||||
module Vervis.Widget.Tracker
|
module Vervis.Widget.Tracker
|
||||||
( deckNavW
|
( deckNavW
|
||||||
, loomNavW
|
, loomNavW
|
||||||
|
, projectNavW
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
|
@ -38,3 +39,8 @@ loomNavW (Entity loomID loom) actor = do
|
||||||
loomHash <- encodeKeyHashid loomID
|
loomHash <- encodeKeyHashid loomID
|
||||||
hashRepo <- getEncodeKeyHashid
|
hashRepo <- getEncodeKeyHashid
|
||||||
$(widgetFile "loom/widget/nav")
|
$(widgetFile "loom/widget/nav")
|
||||||
|
|
||||||
|
projectNavW :: Entity Project -> Actor -> Widget
|
||||||
|
projectNavW (Entity projectID project) actor = do
|
||||||
|
projectHash <- encodeKeyHashid projectID
|
||||||
|
$(widgetFile "project/widget/nav")
|
||||||
|
|
|
@ -1715,6 +1715,7 @@ data CreateObject u
|
||||||
| CreateTicketTracker ActorDetail (Maybe (Authority u, ActorLocal u))
|
| CreateTicketTracker ActorDetail (Maybe (Authority u, ActorLocal u))
|
||||||
| CreateRepository ActorDetail VersionControlSystem (Maybe (Authority u, ActorLocal u))
|
| CreateRepository ActorDetail VersionControlSystem (Maybe (Authority u, ActorLocal u))
|
||||||
| CreatePatchTracker ActorDetail (NonEmpty (ObjURI u)) (Maybe (Authority u, ActorLocal u))
|
| CreatePatchTracker ActorDetail (NonEmpty (ObjURI u)) (Maybe (Authority u, ActorLocal u))
|
||||||
|
| CreateProject ActorDetail (Maybe (Authority u, ActorLocal u))
|
||||||
|
|
||||||
parseCreateObject :: UriMode u => Object -> Parser (CreateObject u)
|
parseCreateObject :: UriMode u => Object -> Parser (CreateObject u)
|
||||||
parseCreateObject o
|
parseCreateObject o
|
||||||
|
@ -1737,6 +1738,11 @@ parseCreateObject o
|
||||||
repos <- o .:*+ "tracksPatchesFor"
|
repos <- o .:*+ "tracksPatchesFor"
|
||||||
ml <- parseActorLocal o
|
ml <- parseActorLocal o
|
||||||
return $ CreatePatchTracker d repos ml
|
return $ CreatePatchTracker d repos ml
|
||||||
|
<|> do d <- parseActorDetail o
|
||||||
|
unless (actorType d == ActorTypeProject) $
|
||||||
|
fail "type isn't Project"
|
||||||
|
ml <- parseActorLocal o
|
||||||
|
return $ CreateProject d ml
|
||||||
|
|
||||||
encodeCreateObject :: UriMode u => CreateObject u -> Series
|
encodeCreateObject :: UriMode u => CreateObject u -> Series
|
||||||
encodeCreateObject (CreateNote h note) = toSeries h note
|
encodeCreateObject (CreateNote h note) = toSeries h note
|
||||||
|
@ -1751,6 +1757,8 @@ encodeCreateObject (CreatePatchTracker d repos ml)
|
||||||
= encodeActorDetail d
|
= encodeActorDetail d
|
||||||
<> "tracksPatchesFor" .=*+ repos
|
<> "tracksPatchesFor" .=*+ repos
|
||||||
<> maybe mempty (uncurry encodeActorLocal) ml
|
<> maybe mempty (uncurry encodeActorLocal) ml
|
||||||
|
encodeCreateObject (CreateProject d ml) =
|
||||||
|
encodeActorDetail d <> maybe mempty (uncurry encodeActorLocal) ml
|
||||||
|
|
||||||
data Create u = Create
|
data Create u = Create
|
||||||
{ createObject :: CreateObject u
|
{ createObject :: CreateObject u
|
||||||
|
@ -1770,6 +1778,7 @@ parseCreate o a luActor = do
|
||||||
CreateTicketTracker _ _ -> return ()
|
CreateTicketTracker _ _ -> return ()
|
||||||
CreateRepository _ _ _ -> return ()
|
CreateRepository _ _ _ -> return ()
|
||||||
CreatePatchTracker _ _ _ -> return ()
|
CreatePatchTracker _ _ _ -> return ()
|
||||||
|
CreateProject _ _ -> return ()
|
||||||
Create obj <$> o .:? "target"
|
Create obj <$> o .:? "target"
|
||||||
|
|
||||||
encodeCreate :: UriMode u => Create u -> Series
|
encodeCreate :: UriMode u => Create u -> Series
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
$# This file is part of Vervis.
|
$# This file is part of Vervis.
|
||||||
$#
|
$#
|
||||||
$# Written in 2016, 2018, 2019, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
$# Written in 2016, 2018, 2019, 2022, 2023
|
||||||
|
$# by fr33domlover <fr33domlover@riseup.net>.
|
||||||
$#
|
$#
|
||||||
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
$# ♡ Copying is an act of love. Please copy, reuse and share.
|
||||||
$#
|
$#
|
||||||
|
@ -96,3 +97,12 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
<li>
|
<li>
|
||||||
<a href=@{LoomR $ hashLoom loomID}>
|
<a href=@{LoomR $ hashLoom loomID}>
|
||||||
+#{keyHashidText $ hashLoom loomID} #{actorName actor}
|
+#{keyHashidText $ hashLoom loomID} #{actorName actor}
|
||||||
|
|
||||||
|
<h2>Projects
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall (Entity projectID _, Entity _ actor) <- projects
|
||||||
|
<li>
|
||||||
|
<a href=@{ProjectR $ hashProject projectID}>
|
||||||
|
$#{keyHashidText $ hashProject projectID} #{actorName actor}
|
||||||
|
$# #{abcde}
|
||||||
|
|
|
@ -33,6 +33,9 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
|
||||||
<li>
|
<li>
|
||||||
<a href=@{LoomNewR}>
|
<a href=@{LoomNewR}>
|
||||||
Create a new patch tracker
|
Create a new patch tracker
|
||||||
|
<li>
|
||||||
|
<a href=@{ProjectNewR}>
|
||||||
|
Create a new project
|
||||||
<li>
|
<li>
|
||||||
<a href=@{PublishOfferMergeR}>
|
<a href=@{PublishOfferMergeR}>
|
||||||
Open a merge request
|
Open a merge request
|
||||||
|
@ -85,3 +88,14 @@ $# Comment on a ticket or merge request
|
||||||
]
|
]
|
||||||
<a href=@{LoomR $ hashLoom loomID}>
|
<a href=@{LoomR $ hashLoom loomID}>
|
||||||
+#{keyHashidText $ hashLoom loomID} #{actorName actor}
|
+#{keyHashidText $ hashLoom loomID} #{actorName actor}
|
||||||
|
|
||||||
|
<h2>Your projects
|
||||||
|
|
||||||
|
<ul>
|
||||||
|
$forall (Entity projectID _, Entity _ actor, Entity _ (Collab role)) <- projects
|
||||||
|
<li>
|
||||||
|
[
|
||||||
|
#{show role}
|
||||||
|
]
|
||||||
|
<a href=@{ProjectR $ hashProject projectID}>
|
||||||
|
$#{keyHashidText $ hashProject projectID} #{actorName actor}
|
||||||
|
|
59
templates/project/collab/list.hamlet
Normal file
59
templates/project/collab/list.hamlet
Normal file
|
@ -0,0 +1,59 @@
|
||||||
|
$# This file is part of Vervis.
|
||||||
|
$#
|
||||||
|
$# Written in 2016, 2019, 2022, 2023 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/>.
|
||||||
|
|
||||||
|
^{projectNavW (Entity projectID project) actor}
|
||||||
|
|
||||||
|
<h2>Collaborators
|
||||||
|
|
||||||
|
<table>
|
||||||
|
<tr>
|
||||||
|
<th>Role
|
||||||
|
<th>Collaborator
|
||||||
|
<th>Since
|
||||||
|
$forall (person, role, ctID, since) <- collabs
|
||||||
|
<tr>
|
||||||
|
<td>#{show role}
|
||||||
|
<td>^{personLinkFedW person}
|
||||||
|
<td>#{showDate since}
|
||||||
|
<td>^{buttonW POST "Remove" (ProjectRemoveR projectHash ctID)}
|
||||||
|
|
||||||
|
<h2>Invites
|
||||||
|
|
||||||
|
<table>
|
||||||
|
<tr>
|
||||||
|
<th>Inviter
|
||||||
|
<th>Invitee
|
||||||
|
<th>Role
|
||||||
|
<th>Time
|
||||||
|
$forall (inviter, invitee, time, role) <- invites
|
||||||
|
<tr>
|
||||||
|
<td>^{personLinkFedW inviter}
|
||||||
|
<td>^{personLinkFedW invitee}
|
||||||
|
<td>#{show role}
|
||||||
|
<td>#{showDate time}
|
||||||
|
|
||||||
|
<a href=@{ProjectInviteR projectHash}>Invite…
|
||||||
|
|
||||||
|
<h2>Joins
|
||||||
|
|
||||||
|
<table>
|
||||||
|
<tr>
|
||||||
|
<th>Joiner
|
||||||
|
<th>Role
|
||||||
|
<th>Time
|
||||||
|
$forall (joiner, time, role) <- joins
|
||||||
|
<tr>
|
||||||
|
<td>^{personLinkFedW joiner}
|
||||||
|
<td>#{show role}
|
||||||
|
<td>#{showDate time}
|
18
templates/project/collab/new.hamlet
Normal file
18
templates/project/collab/new.hamlet
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
$# This file is part of Vervis.
|
||||||
|
$#
|
||||||
|
$# Written in 2016, 2023 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/>.
|
||||||
|
|
||||||
|
<form method=POST action=@{ProjectInviteR projectHash} enctype=#{enctype}>
|
||||||
|
^{widget}
|
||||||
|
<div class="submit">
|
||||||
|
<input type="submit">
|
18
templates/project/new.hamlet
Normal file
18
templates/project/new.hamlet
Normal file
|
@ -0,0 +1,18 @@
|
||||||
|
$# This file is part of Vervis.
|
||||||
|
$#
|
||||||
|
$# Written in 2016, 2022 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/>.
|
||||||
|
|
||||||
|
<form method=POST action=@{ProjectNewR} enctype=#{enctype}>
|
||||||
|
^{widget}
|
||||||
|
<div class="submit">
|
||||||
|
<input type="submit">
|
36
templates/project/widget/nav.hamlet
Normal file
36
templates/project/widget/nav.hamlet
Normal file
|
@ -0,0 +1,36 @@
|
||||||
|
$# This file is part of Vervis.
|
||||||
|
$#
|
||||||
|
$# Written in 2019, 2022, 2023 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/>.
|
||||||
|
|
||||||
|
<div>
|
||||||
|
<span>
|
||||||
|
[[ 🏗
|
||||||
|
<a href=@{ProjectR projectHash}>
|
||||||
|
$#{keyHashidText projectHash} #{actorName actor}
|
||||||
|
]] ::
|
||||||
|
<span>
|
||||||
|
<a href=@{ProjectInboxR projectHash}>
|
||||||
|
[📥 Inbox]
|
||||||
|
<span>
|
||||||
|
<a href=@{ProjectOutboxR projectHash}>
|
||||||
|
[📤 Outbox]
|
||||||
|
<span>
|
||||||
|
<a href=@{ProjectFollowersR projectHash}>
|
||||||
|
[🐤 Followers]
|
||||||
|
<span>
|
||||||
|
<a href=@{ProjectCollabsR projectHash}>
|
||||||
|
[🤝 Collaborators]
|
||||||
|
<span>
|
||||||
|
[No wiki]
|
||||||
|
<span>
|
||||||
|
[✏ Edit]
|
13
th/models
13
th/models
|
@ -647,13 +647,6 @@ CollabRecipRemoteJoin
|
||||||
|
|
||||||
-------------------------------- Collab topic --------------------------------
|
-------------------------------- Collab topic --------------------------------
|
||||||
|
|
||||||
-- Removed for now, until I figure out whether/how to federate custom roles
|
|
||||||
--CollabRoleLocal
|
|
||||||
-- collab CollabId
|
|
||||||
-- role RoleId
|
|
||||||
--
|
|
||||||
-- UniqueCollabRoleLocal collab
|
|
||||||
|
|
||||||
CollabTopicRepo
|
CollabTopicRepo
|
||||||
collab CollabId
|
collab CollabId
|
||||||
repo RepoId
|
repo RepoId
|
||||||
|
@ -672,6 +665,12 @@ CollabTopicLoom
|
||||||
|
|
||||||
UniqueCollabTopicLoom collab
|
UniqueCollabTopicLoom collab
|
||||||
|
|
||||||
|
CollabTopicProject
|
||||||
|
collab CollabId
|
||||||
|
project ProjectId
|
||||||
|
|
||||||
|
UniqueCollabTopicProject collab
|
||||||
|
|
||||||
CollabEnable
|
CollabEnable
|
||||||
collab CollabId
|
collab CollabId
|
||||||
grant OutboxItemId
|
grant OutboxItemId
|
||||||
|
|
18
th/routes
18
th/routes
|
@ -304,3 +304,21 @@
|
||||||
|
|
||||||
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/new-dep ClothDepNewR GET POST
|
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/new-dep ClothDepNewR GET POST
|
||||||
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/deps/#TicketDepKeyHashid/delete ClothDepDeleteR POST
|
-- /looms/#LoomKeyHashid/cloths/#TicketLoomKeyHashid/deps/#TicketDepKeyHashid/delete ClothDepDeleteR POST
|
||||||
|
|
||||||
|
---- Project -----------------------------------------------------------------
|
||||||
|
|
||||||
|
/projects/#ProjectKeyHashid ProjectR GET
|
||||||
|
/projects/#ProjectKeyHashid/inbox ProjectInboxR GET POST
|
||||||
|
/projects/#ProjectKeyHashid/outbox ProjectOutboxR GET
|
||||||
|
/projects/#ProjectKeyHashid/outbox/#OutboxItemKeyHashid ProjectOutboxItemR GET
|
||||||
|
/projects/#ProjectKeyHashid/followers ProjectFollowersR GET
|
||||||
|
|
||||||
|
/projects/#ProjectKeyHashid/messages/#LocalMessageKeyHashid ProjectMessageR GET
|
||||||
|
|
||||||
|
/new-project ProjectNewR GET POST
|
||||||
|
|
||||||
|
/projects/#ProjectKeyHashid/stamps/#SigKeyKeyHashid ProjectStampR GET
|
||||||
|
|
||||||
|
/projects/#ProjectKeyHashid/collabs ProjectCollabsR GET
|
||||||
|
/projects/#ProjectKeyHashid/invite ProjectInviteR GET POST
|
||||||
|
/projects/#ProjectKeyHashid/remove/#CollabTopicProjectId ProjectRemoveR POST
|
||||||
|
|
|
@ -149,6 +149,7 @@ library
|
||||||
Vervis.Actor.Loom
|
Vervis.Actor.Loom
|
||||||
Vervis.Actor.Person
|
Vervis.Actor.Person
|
||||||
Vervis.Actor.Person.Client
|
Vervis.Actor.Person.Client
|
||||||
|
Vervis.Actor.Project
|
||||||
Vervis.Actor.Repo
|
Vervis.Actor.Repo
|
||||||
Vervis.API
|
Vervis.API
|
||||||
Vervis.Avatar
|
Vervis.Avatar
|
||||||
|
@ -210,6 +211,7 @@ library
|
||||||
Vervis.Handler.Person
|
Vervis.Handler.Person
|
||||||
Vervis.Handler.Repo
|
Vervis.Handler.Repo
|
||||||
--Vervis.Handler.Role
|
--Vervis.Handler.Role
|
||||||
|
Vervis.Handler.Project
|
||||||
--Vervis.Handler.Sharer
|
--Vervis.Handler.Sharer
|
||||||
Vervis.Handler.Ticket
|
Vervis.Handler.Ticket
|
||||||
-- Vervis.Handler.Wiki
|
-- Vervis.Handler.Wiki
|
||||||
|
|
Loading…
Reference in a new issue