68 lines
2.2 KiB
Haskell
68 lines
2.2 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Allocation.New
|
|
( getAllocationNewR, postAllocationNewR
|
|
) where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
|
|
import Handler.Allocation.Form
|
|
|
|
import qualified Crypto.Random as Crypto
|
|
|
|
import qualified Data.Set as Set
|
|
|
|
|
|
getAllocationNewR, postAllocationNewR :: Handler Html
|
|
getAllocationNewR = postAllocationNewR
|
|
postAllocationNewR = do
|
|
(mAct, (formView, formEnc)) <- runDB $ do
|
|
((formRes, formView), formEnc) <- runFormPost . renderAForm FormStandard $ allocationForm Nothing
|
|
|
|
mAct <- formResultMaybe formRes $ \AllocationForm{..} -> runMaybeT $ do
|
|
allocationMatchingSeed <- liftIO $ Crypto.getRandomBytes 32
|
|
|
|
insertRes <- lift $ insertUnique Allocation
|
|
{ allocationTerm = afTerm
|
|
, allocationSchool = afSchool
|
|
, allocationShorthand = afShorthand
|
|
, allocationName = afName
|
|
, allocationLegacyShorthands = Set.toList afLegacyShorthands
|
|
, allocationDescription = afDescription
|
|
, allocationStaffDescription = afStaffDescription
|
|
, allocationStaffRegisterFrom = afStaffRegisterFrom
|
|
, allocationStaffRegisterTo = afStaffRegisterTo
|
|
, allocationStaffAllocationFrom = afStaffAllocationFrom
|
|
, allocationStaffAllocationTo = afStaffAllocationTo
|
|
, allocationRegisterFrom = afRegisterFrom
|
|
, allocationRegisterTo = afRegisterTo
|
|
, allocationRegisterByStaffFrom = afRegisterByStaffFrom
|
|
, allocationRegisterByStaffTo = afRegisterByStaffTo
|
|
, allocationRegisterByCourse = afRegisterByCourse
|
|
, allocationOverrideDeregister = afOverrideDeregister
|
|
, allocationMatchingSeed
|
|
}
|
|
|
|
unless (is _Just insertRes) $ do
|
|
addMessageI Error MsgAllocationNewAlreadyExists
|
|
mzero
|
|
|
|
return $ do
|
|
addMessageI Success MsgAllocationNewSuccess
|
|
redirect $ AllocationR afTerm afSchool afShorthand AShowR
|
|
|
|
return (mAct, (formView, formEnc))
|
|
|
|
sequence_ mAct
|
|
|
|
siteLayoutMsg MsgTitleAllocationNew $ do
|
|
setTitleI MsgTitleAllocationNew
|
|
|
|
wrapForm formView def
|
|
{ formAction = Just $ SomeRoute AllocationNewR
|
|
, formEncoding = formEnc
|
|
}
|