debug(firm): attempt to find error when using firm communication
This commit is contained in:
parent
f627de503e
commit
5d8802732a
@ -259,6 +259,7 @@ ghc-options:
|
|||||||
- -j
|
- -j
|
||||||
- -freduction-depth=0
|
- -freduction-depth=0
|
||||||
- -fprof-auto-calls
|
- -fprof-auto-calls
|
||||||
|
- -g
|
||||||
when:
|
when:
|
||||||
- condition: flag(pedantic)
|
- condition: flag(pedantic)
|
||||||
ghc-options:
|
ghc-options:
|
||||||
|
|||||||
@ -2,7 +2,7 @@
|
|||||||
--
|
--
|
||||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||||
|
|
||||||
{-# OPTIONS -Wno-unused-top-binds -Wno-unused-imports #-} -- TODO: remove me, for debugging only
|
{-# OPTIONS -Wno-unused-top-binds -Wno-unused-imports -Wno-unused-binds #-} -- TODO: remove me, for debugging only
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances
|
{-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
@ -804,7 +804,7 @@ handleFirmCommR ultDest mbFsh = do
|
|||||||
)
|
)
|
||||||
-}
|
-}
|
||||||
|
|
||||||
selected <- mapM decryptUserId =<< lookupGlobalGetParams GetRecipient -- retrieve selected users
|
selected <- mapM decryptUserId =<< lookupGlobalGetParams GetRecipient -- retrieve selected users
|
||||||
empys <- ifMaybeM mbCid selected (\cid -> -- get all employees or stick with selected users, if no company was pre-selected (to limit choices)
|
empys <- ifMaybeM mbCid selected (\cid -> -- get all employees or stick with selected users, if no company was pre-selected (to limit choices)
|
||||||
E.unValue <<$>> runDB (E.select $ do
|
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)
|
||||||
|
|||||||
@ -134,6 +134,7 @@ crTestFirmCommunication jCompany comm = do
|
|||||||
|
|
||||||
commR :: CommunicationRoute -> Handler Html
|
commR :: CommunicationRoute -> Handler Html
|
||||||
commR CommunicationRoute{..} = do
|
commR CommunicationRoute{..} = do
|
||||||
|
$logWarnS "COMM" "Communication handleer started"
|
||||||
cUser <- maybeAuth
|
cUser <- maybeAuth
|
||||||
|
|
||||||
MsgRenderer mr <- getMsgRenderer
|
MsgRenderer mr <- getMsgRenderer
|
||||||
@ -153,6 +154,7 @@ commR CommunicationRoute{..} = do
|
|||||||
chosen' <- fmap (maybe id cons cUser . catMaybes) $ mapM decrypt' =<< lookupGlobalGetParams GetRecipient
|
chosen' <- fmap (maybe id cons cUser . catMaybes) $ mapM decrypt' =<< lookupGlobalGetParams GetRecipient
|
||||||
|
|
||||||
return (suggested, chosen')
|
return (suggested, chosen')
|
||||||
|
$logWarnS "COMM" "Communication handler DB done"
|
||||||
|
|
||||||
let
|
let
|
||||||
lookupUser :: UserId -> User
|
lookupUser :: UserId -> User
|
||||||
@ -236,6 +238,7 @@ 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,6 +249,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
|
||||||
@ -253,7 +257,8 @@ commR CommunicationRoute{..} = do
|
|||||||
<$> aopt textField (fslI MsgCommSubject & addAttr "uw-enter-as-tab" "") Nothing
|
<$> aopt textField (fslI MsgCommSubject & addAttr "uw-enter-as-tab" "") Nothing
|
||||||
<*> (markupOutput <$> areq htmlField (fslI MsgCommBody) Nothing)
|
<*> (markupOutput <$> areq htmlField (fslI MsgCommBody) Nothing)
|
||||||
<*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField) (fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing)
|
<*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField) (fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing)
|
||||||
)
|
)
|
||||||
|
$logWarnS "COMM" "Communication handler run form post done" -- NOT SEEN
|
||||||
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
|
||||||
@ -262,13 +267,14 @@ 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")
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user