fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(firm): firm messaging now works fine

Browse Source
This commit is contained in:
Steffen Jost 2023-11-14 16:55:14 +01:00
parent 42ff02d27e
commit 65cdc8ddfe
10 changed files with 160 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/firm/de-de-formal.msg
View File

@ -21,4 +21,5 @@ FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der s
FilterForeignSupervisor: Hat firmenfremde Ansprechpartner FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
FilterFirmPostalAddress: Postalische Firmenadresse vorhanden FilterFirmPostalAddress: Postalische Firmenadresse vorhanden
FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh} FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}

1
messages/uniworx/categories/firm/en-eu.msg
View File

@ -21,4 +21,5 @@ FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
FilterForeignSupervisor: Has company-external supervisors FilterForeignSupervisor: Has company-external supervisors
FilterFirmPostalAddress: Postal company addresse known FilterFirmPostalAddress: Postal company addresse known
FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh} FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
FirmSupervisorIndependent: Independent supervisors
FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users

2
routes
View File

@ -114,7 +114,7 @@
/for/#CryptoUUIDUser/user/profile ForProfileDataR GET !supervisor !self /for/#CryptoUUIDUser/user/profile ForProfileDataR GET !supervisor !self
/firms FirmAllR GET POST !supervisor /firms FirmAllR GET POST !supervisor
/firms/comm FirmsCommR GET POST /firms/comm/+Companies FirmsCommR GET POST
/firm/#CompanyShorthand FirmR GET POST /firm/#CompanyShorthand FirmR GET POST
/firm/#CompanyShorthand/comm FirmCommR GET POST /firm/#CompanyShorthand/comm FirmCommR GET POST
/firm/#CompanyShorthand/users FirmUsersR GET POST !supervisor /firm/#CompanyShorthand/users FirmUsersR GET POST !supervisor

2
src/Foundation/Navigation.hs
View File

@ -124,7 +124,7 @@ breadcrumb ProblemAvsSynchR = i18nCrumb MsgProblemsAvsSynchHeading $ Just
breadcrumb ProblemAvsErrorR = i18nCrumb MsgProblemsAvsErrorHeading $ Just ProblemAvsSynchR breadcrumb ProblemAvsErrorR = i18nCrumb MsgProblemsAvsErrorHeading $ Just ProblemAvsSynchR
breadcrumb FirmAllR = i18nCrumb MsgMenuFirms Nothing breadcrumb FirmAllR = i18nCrumb MsgMenuFirms Nothing
breadcrumb FirmsCommR = i18nCrumb MsgMenuFirmsComm $ Just FirmAllR breadcrumb FirmsCommR{} = i18nCrumb MsgMenuFirmsComm $ Just FirmAllR
breadcrumb FirmR{} = i18nCrumb MsgMenuAdminHeading $ Just FirmAllR -- TODO: change heading or remove breadcrumb FirmR{} = i18nCrumb MsgMenuAdminHeading $ Just FirmAllR -- TODO: change heading or remove
breadcrumb FirmUsersR{} = i18nCrumb MsgMenuFirmUsers $ Just FirmAllR breadcrumb FirmUsersR{} = i18nCrumb MsgMenuFirmUsers $ Just FirmAllR
breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors $ Just $ FirmUsersR fsh breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors $ Just $ FirmUsersR fsh

84
src/Handler/Firm.hs
View File

@ -380,13 +380,13 @@ postFirmAllR = do
(firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins (firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
formResult firmRes $ \case formResult firmRes $ \case
(FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset " <> tshow (length fids) <> " companies. TODO" (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset " <> tshow (length fids) <> " companies. TODO"
(FirmAllActNotifyData , fids) -> do (FirmAllActNotifyData , Set.toList -> fids) -> do
usrs <- runDB $ E.select $ E.distinct $ do usrs <- runDB $ E.select $ E.distinct $ do
(usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser) (usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList (Set.toList fids) E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList fids
return $ usr E.^. UserId return $ usr E.^. UserId
cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser] cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
redirect (FirmsCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids]) redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
siteLayoutMsg MsgMenuFirms $ do siteLayoutMsg MsgMenuFirms $ do
setTitleI MsgMenuFirms setTitleI MsgMenuFirms
$(i18nWidgetFile "firm-all") $(i18nWidgetFile "firm-all")
@ -792,48 +792,54 @@ postFirmSupersR fsh = do
getFirmCommR, postFirmCommR :: CompanyShorthand -> Handler Html getFirmCommR, postFirmCommR :: CompanyShorthand -> Handler Html
getFirmCommR = postFirmCommR getFirmCommR = postFirmCommR
postFirmCommR fsh = handleFirmCommR (SomeRoute $ FirmUsersR fsh) (Just fsh) postFirmCommR fsh = handleFirmCommR (SomeRoute $ FirmUsersR fsh) [fsh]
getFirmsCommR, postFirmsCommR :: Handler Html getFirmsCommR, postFirmsCommR :: Companies -> Handler Html
getFirmsCommR = postFirmsCommR getFirmsCommR = postFirmsCommR
postFirmsCommR = handleFirmCommR (SomeRoute FirmAllR) Nothing postFirmsCommR = handleFirmCommR (SomeRoute FirmAllR)
handleFirmCommR :: SomeRoute UniWorX -> Maybe CompanyShorthand -> Handler Html handleFirmCommR :: SomeRoute UniWorX -> Companies -> Handler Html
handleFirmCommR ultDest mbFsh = do handleFirmCommR _ [] = invalidArgs ["At least one company name must be provided."]
let decryptUserId :: CryptoUUIDUser -> Handler UserId handleFirmCommR ultDest cs = do
decryptUserId = decrypt let csKey = CompanyKey <$> cs
-- get employees of chosen companies
mbCid = CompanyKey <$> mbFsh empys <- E.unValue <<$>> runDB (E.select $ do
{-
queryEmpys :: CompanyId -> Handler [UserId]
queryEmpys cid = E.unValue <<$>> runDB (E.select $ do
(emp :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser) (emp :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
E.where_ $ uc E.^. UserCompanyCompany E.==. E.val cid E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList csKey
return $ emp E.^. UserId return $ emp E.^. UserId
) )
-} -- get supervisors of employees
sprs <- E.unValue <<$>> runDB (E.select $ do
selected <- mapM decryptUserId =<< lookupGlobalGetParams GetRecipient -- retrieve selected users spr <- E.from $ E.table @User
E.where_ $ E.exists $ do
empys <- ifMaybeM mbCid selected (\cid -> -- get all employees or stick with selected users, if no company was pre-selected (to limit choices) usrSpr <- E.from $ E.table @UserSupervisor
E.unValue <<$>> runDB (E.select $ do E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. spr E.^. UserId
(emp :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser) E.&&. usrSpr E.^. UserSupervisorUser `E.in_` E.valList empys
E.where_ $ uc E.^. UserCompanyCompany E.==. E.val cid return $ spr E.^. UserId
return $ emp E.^. UserId )
)) -- get companies of all supervisors
sprCmpys <- E.unValue <<$>> runDB (E.select $ do
cmpys <- E.unValue <<$>> runDB (E.select $ do
cmpy <- E.from $ E.table @Company cmpy <- E.from $ E.table @Company
E.where_ $ E.exists $ do E.where_ $ E.exists $ do
usrCmpy <- E.from $ E.table @UserCompany usrCmpy <- E.from $ E.table @UserCompany
E.where_ $ usrCmpy E.^. UserCompanyUser `E.in_` E.valList selected E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
E.&&. usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId E.&&. usrCmpy E.^. UserCompanyUser `E.in_` E.valList sprs
return $ cmpy E.^.CompanyId return $ cmpy E.^.CompanyId
) )
let queryCmpy :: Bool -> CompanyId -> E.SqlQuery (E.SqlExpr (Entity User)) let
queryLoners :: E.SqlQuery (E.SqlExpr (Entity User)) -- get supervisors without any company affiliation
queryLoners = do
spr <- E.from $ E.table @User
E.where_ $ spr E.^. UserId `E.in_` E.valList empys
E.&&. E.notExists (do
sprCmp <- E.from $ E.table @UserCompany
E.where_ $ sprCmp E.^. UserCompanyUser E.==. spr E.^. UserId
)
return $ spr
queryCmpy :: Bool -> CompanyId -> E.SqlQuery (E.SqlExpr (Entity User))
queryCmpy sORe acid = do queryCmpy sORe acid = do
(usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser) (usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
E.where_ $ uc E.^. UserCompanyCompany E.==. E.val acid E.where_ $ uc E.^. UserCompanyCompany E.==. E.val acid
@ -843,20 +849,20 @@ handleFirmCommR ultDest mbFsh = do
usrSpr <- E.from $ E.table @UserSupervisor usrSpr <- E.from $ E.table @UserSupervisor
E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId
E.&&. usrSpr E.^. UserSupervisorUser `E.in_` E.valList empys E.&&. usrSpr E.^. UserSupervisorUser `E.in_` E.valList empys
else -- selected employees for this company only else E.true
usr E.^. UserId `E.in_` E.valList empys
) )
return usr return usr
commR CommunicationRoute commR CommunicationRoute
{ crHeading = SomeMessage $ maybe MsgFirmsNotification MsgFirmNotification mbFsh { crHeading = SomeMessage $ case cs of { [c] -> MsgFirmNotification c; _ -> MsgFirmsNotification }
, crUltDest = ultDest , crUltDest = ultDest
, crJobs = crJobsFirmCommunication mbFsh -- :: Communication -> ConduitT () Job (YesodDB UniWorX) () , crJobs = crJobsFirmCommunication cs -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()
, crTestJobs = crTestFirmCommunication mbFsh -- :: Communication -> ConduitT () Job (YesodDB UniWorX) () , crTestJobs = crTestFirmCommunication cs -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()
, crRecipientAuth = Nothing -- :: Maybe (UserId -> DB AuthResult) -- an optional filter passed to guardAuthResult , crRecipientAuth = Nothing -- :: Maybe (UserId -> DB AuthResult) -- an optional filter passed to guardAuthResult
, crRecipients = -- :: [(RecipientGroup, SqlQuery (SqlExpr (Entity User)))] , crRecipients = -- :: [(RecipientGroup, SqlQuery (SqlExpr (Entity User)))]
[(RGFirmSupervisor $ unCompanyKey acid, queryCmpy True acid) | acid <- cmpys ] <> [(RGFirmSupervisor $ unCompanyKey acid, queryCmpy True acid) | acid <- sprCmpys ] ++
[(RGFirmEmployees $ unCompanyKey acid, queryCmpy False acid) | acid <- cmpys, maybe True (acid ==) mbCid] (RGFirmIndependent, queryLoners) :
[(RGFirmEmployees $ unCompanyKey acid, queryCmpy False acid) | acid <- csKey ]
} }
{- Auswahlbox für Mitteilung: {- Auswahlbox für Mitteilung:

35
src/Handler/Utils/Communication.hs
View File

@ -32,7 +32,7 @@ data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrect
| RGTutorialParticipants CryptoUUIDTutorial | RGTutorialParticipants CryptoUUIDTutorial
| RGExamRegistered CryptoUUIDExam | RGExamRegistered CryptoUUIDExam
| RGSheetSubmittor CryptoUUIDSheet | RGSheetSubmittor CryptoUUIDSheet
| RGFirmSupervisor CompanyShorthand | RGFirmEmployees CompanyShorthand | RGFirmSupervisor CompanyShorthand | RGFirmEmployees CompanyShorthand | RGFirmIndependent
deriving (Eq, Ord, Read, Show, Generic) deriving (Eq, Ord, Read, Show, Generic)
instance LowerBounded RecipientGroup where instance LowerBounded RecipientGroup where
@ -110,8 +110,8 @@ crTestJobsCourseCommunication jCourse comm = do
crJobsCourseCommunication jCourse comm' .| C.filter ((== Right jSender) . jRecipientEmail) crJobsCourseCommunication jCourse comm' .| C.filter ((== Right jSender) . jRecipientEmail)
crJobsFirmCommunication :: Maybe CompanyShorthand -> Communication -> ConduitT () Job (YesodDB UniWorX) () crJobsFirmCommunication :: Companies -> Communication -> ConduitT () Job (YesodDB UniWorX) ()
crJobsFirmCommunication jCompany Communication{..} = do crJobsFirmCommunication jCompanies Communication{..} = do
jSender <- requireAuthId jSender <- requireAuthId
let jMailContent = cContent let jMailContent = cContent
allRecipients = Set.toList $ Set.insert (Right jSender) cRecipients allRecipients = Set.toList $ Set.insert (Right jSender) cRecipients
@ -122,12 +122,12 @@ crJobsFirmCommunication jCompany Communication{..} = do
forM_ allRecipients $ \jRecipientEmail -> forM_ allRecipients $ \jRecipientEmail ->
yield JobSendFirmCommunication{..} yield JobSendFirmCommunication{..}
crTestFirmCommunication :: Maybe CompanyShorthand -> Communication -> ConduitT () Job (YesodDB UniWorX) () crTestFirmCommunication :: Companies -> Communication -> ConduitT () Job (YesodDB UniWorX) ()
crTestFirmCommunication jCompany comm = do crTestFirmCommunication jCompanies comm = do
jSender <- requireAuthId jSender <- requireAuthId
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
let comm' = comm & _cContent . _ccSubject %~ Just . mr . MsgCommCourseTestSubject . fromMaybe (mr MsgUtilCommFirmSubject) let comm' = comm & _cContent . _ccSubject %~ Just . mr . MsgCommCourseTestSubject . fromMaybe (mr MsgUtilCommFirmSubject)
crJobsFirmCommunication jCompany comm' .| C.filter ((== Right jSender) . jRecipientEmail) crJobsFirmCommunication jCompanies comm' .| C.filter ((== Right jSender) . jRecipientEmail)
@ -139,26 +139,24 @@ commR CommunicationRoute{..} = do
uid <- decrypt cID uid <- decrypt cID
whenIsJust crRecipientAuth $ guardAuthResult <=< ($ uid) whenIsJust crRecipientAuth $ guardAuthResult <=< ($ uid)
getEntity uid getEntity uid
cUser <- maybeAuth cUser <- maybeAuth
(chosenRecipients, suggestedRecipients) <- runDB $ (,)
<$> (maybe id cons cUser . catMaybes <$> (mapM decrypt' =<< lookupGlobalGetParams GetRecipient))
<*> (filter (notNull . snd) <$> for crRecipients (\(grp,usrQry) -> (grp,) <$> E.select usrQry))
$logWarnS "COMM" ("Communication handlerwith (sugg:" <> tshow (length suggestedRecipients) <> ", chosen:" <> tshow (length chosenRecipients) <> ")")
MsgRenderer mr <- getMsgRenderer MsgRenderer mr <- getMsgRenderer
mbCurrentRoute <- getCurrentRoute mbCurrentRoute <- getCurrentRoute
(suggestedRecipients, chosenRecipients) <- runDB $ (,)
<$> for crRecipients (\(grp,usrQry) -> (grp,) <$> E.select usrQry)
<*> fmap (maybe id cons cUser . catMaybes) (mapM decrypt' =<< lookupGlobalGetParams GetRecipient)
$logWarnS "COMM" ("Communication handler DB done with (sugg:" <> tshow (length suggestedRecipients) <> ", chosen:" <> tshow (length chosenRecipients) <> ")")
let let
lookupUser :: UserId -> (UserDisplayName,UserSurname) lookupUser :: UserId -> (UserDisplayName,UserSurname)
lookupUser = lookupUser =
let usrMap = Map.fromList $ fmap (\u -> (entityKey u, entityVal u)) $ chosenRecipients ++ concatMap (view _2) suggestedRecipients let usrMap = Map.fromList $ fmap (\u -> (entityKey u, entityVal u)) $ chosenRecipients ++ concatMap (view _2) suggestedRecipients
usrNames Nothing = ("???","???") -- this case only happens during runFormPost when POST Data is present and no form is displayed usrNames Nothing = ("???","???") -- this case only happens during runFormPost when POST Data is present and no form is display
usrNames (Just User{userDisplayName, userSurname}) = (userDisplayName, userSurname) usrNames (Just User{userDisplayName, userSurname}) = (userDisplayName, userSurname)
in usrNames . flip Map.lookup usrMap in usrNames . flip Map.lookup usrMap
let chosenRecipients' = Map.fromList $ chosenRecipients' = Map.fromList $
[ ( (BoundedPosition $ RecipientGroup g, pos) [ ( (BoundedPosition $ RecipientGroup g, pos)
, (Right recp, recp `elem` map entityKey chosenRecipients) , (Right recp, recp `elem` map entityKey chosenRecipients)
) )
@ -172,7 +170,7 @@ commR CommunicationRoute{..} = do
] ]
activeCategories = map RecipientGroup (view _1 <$> suggestedRecipients) `snoc` RecipientCustom activeCategories = map RecipientGroup (view _1 <$> suggestedRecipients) `snoc` RecipientCustom
let recipientAForm :: AForm Handler (Set (Either UserEmail UserId)) recipientAForm :: AForm Handler (Set (Either UserEmail UserId))
recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients') recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients')
where where
miAdd pos@(BoundedPosition RecipientCustom, 0) dim@1 liveliness nudge submitView = guardOn (miAllowAdd pos dim liveliness) $ \csrf -> do miAdd pos@(BoundedPosition RecipientCustom, 0) dim@1 liveliness nudge submitView = guardOn (miAllowAdd pos dim liveliness) $ \csrf -> do
@ -235,7 +233,6 @@ commR CommunicationRoute{..} = do
recipientsListMsg <- messageI Info MsgCommRecipientsList recipientsListMsg <- messageI Info MsgCommRecipientsList
$logWarnS "COMM" "Communication handler some definitions done"
attachmentsMaxSize <- getsYesod $ view _appCommunicationAttachmentsMaxSize attachmentsMaxSize <- getsYesod $ view _appCommunicationAttachmentsMaxSize
let attachmentField = genericFileField $ return FileField let attachmentField = genericFileField $ return FileField
{ fieldIdent = Nothing { fieldIdent = Nothing
@ -246,7 +243,7 @@ commR CommunicationRoute{..} = do
, fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = attachmentsMaxSize , fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = attachmentsMaxSize
, fieldAllEmptyOk = True , fieldAllEmptyOk = True
} }
$logWarnS "COMM" "Communication handler some parameters done" -- SEEN
((commRes,commWdgt),commEncoding) <- runFormPost . identifyForm FIDCommunication . withButtonForm' universeF . renderAForm FormStandard $ Communication ((commRes,commWdgt),commEncoding) <- runFormPost . identifyForm FIDCommunication . withButtonForm' universeF . renderAForm FormStandard $ Communication
<$> recipientAForm <$> recipientAForm
<* aformMessage recipientsListMsg <* aformMessage recipientsListMsg
@ -256,7 +253,6 @@ commR CommunicationRoute{..} = do
<*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField) <*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField)
(fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing) (fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing)
) )
$logWarnS "COMM" "Communication handler run form post done" -- NOT SEEN ANYMORE
formResult commRes $ \case formResult commRes $ \case
(comm, BtnCommunicationSend) -> do (comm, BtnCommunicationSend) -> do
runDBJobs . runConduit $ transPipe (mapReaderT lift) (crJobs comm) .| sinkDBJobs runDBJobs . runConduit $ transPipe (mapReaderT lift) (crJobs comm) .| sinkDBJobs
@ -265,14 +261,13 @@ commR CommunicationRoute{..} = do
(comm, BtnCommunicationTest) -> do (comm, BtnCommunicationTest) -> do
runDBJobs . runConduit $ transPipe (mapReaderT lift) (crTestJobs comm) .| sinkDBJobs runDBJobs . runConduit $ transPipe (mapReaderT lift) (crTestJobs comm) .| sinkDBJobs
addMessageI Info MsgCommTestSuccess addMessageI Info MsgCommTestSuccess
$logWarnS "COMM" "Communication handler form result done"
let formWdgt = wrapForm commWdgt def let formWdgt = wrapForm commWdgt def
{ formMethod = POST { formMethod = POST
, formAction = SomeRoute <$> mbCurrentRoute , formAction = SomeRoute <$> mbCurrentRoute
, formEncoding = commEncoding , formEncoding = commEncoding
, formSubmit = FormNoSubmit , formSubmit = FormNoSubmit
} }
$logWarnS "COMM" "Communication handler finished"
siteLayoutMsg crHeading $ do siteLayoutMsg crHeading $ do
setTitleI crHeading setTitleI crHeading
let commTestTip = $(i18nWidgetFile "comm-test-tip") let commTestTip = $(i18nWidgetFile "comm-test-tip")

4
src/Jobs/Handler/SendCourseCommunication.hs
View File

@ -49,12 +49,12 @@ dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCours
dispatchJobSendFirmCommunication :: Either UserEmail UserId dispatchJobSendFirmCommunication :: Either UserEmail UserId
-> Set Address -> Set Address
-> Maybe CompanyShorthand -> Companies
-> UserId -> UserId
-> UUID -> UUID
-> CommunicationContent -> CommunicationContent
-> JobHandler UniWorX -> JobHandler UniWorX
dispatchJobSendFirmCommunication jRecipientEmail jAllRecipientAddresses _jCompany jSender jMailObjectUUID CommunicationContent{..} = JobHandlerException $ do dispatchJobSendFirmCommunication jRecipientEmail jAllRecipientAddresses _jCompanies jSender jMailObjectUUID CommunicationContent{..} = JobHandlerException $ do
-- (sender,mbComp) <- runDB $ (,) -- (sender,mbComp) <- runDB $ (,)
-- <$> getJust jSender -- <$> getJust jSender
-- <*> ifMaybeM jCompany Nothing get -- <*> ifMaybeM jCompany Nothing get

2
src/Jobs/Types.hs
View File

@ -76,7 +76,7 @@ data Job
} }
| JobSendFirmCommunication { jRecipientEmail :: Either UserEmail UserId | JobSendFirmCommunication { jRecipientEmail :: Either UserEmail UserId
, jAllRecipientAddresses :: Set Address , jAllRecipientAddresses :: Set Address
, jCompany :: Maybe CompanyShorthand , jCompanies :: Companies
, jSender :: UserId , jSender :: UserId
, jMailObjectUUID :: UUID , jMailObjectUUID :: UUID
, jMailContent :: CommunicationContent , jMailContent :: CommunicationContent

1
src/Model/Types/Common.hs
View File

@ -43,6 +43,7 @@ type SchoolShorthand = CI Text
type CompanyName = CI Text type CompanyName = CI Text
type CompanyShorthand = CI Text type CompanyShorthand = CI Text
type Companies = [CI Text]
type CourseName = CI Text type CourseName = CI Text
type CourseShorthand = CI Text type CourseShorthand = CI Text

2
templates/widgets/communication/recipientLayout.hamlet
View File

@ -35,6 +35,8 @@ $if not (null activeCategories)
_{MsgFirmSupervisorOf fsh} _{MsgFirmSupervisorOf fsh}
$of RecipientGroup (RGFirmEmployees fsh) $of RecipientGroup (RGFirmEmployees fsh)
_{MsgFirmEmployeeOf fsh} _{MsgFirmEmployeeOf fsh}
$of RecipientGroup (RGFirmIndependent)
_{MsgFirmSupervisorIndependent}
$if hasContent category $if hasContent category
<fieldset .recipient-category__fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{checkedIdent category}> <fieldset .recipient-category__fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{checkedIdent category}>