From 426c40f0a4f596804eca723e09894f9c5606af6e Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 22 Jun 2021 18:36:36 +0200 Subject: [PATCH] feat(workflows): enum fields --- .../categories/workflows/de-de-formal.msg | 2 ++ .../uniworx/categories/workflows/en-eu.msg | 2 ++ src/Application.hs | 2 +- src/Handler/Utils/Workflow/EdgeForm.hs | 31 +++++++++++++++++-- src/Model/Types/Workflow.hs | 17 +++++++++- src/Utils/Lens.hs | 1 + 6 files changed, 51 insertions(+), 4 deletions(-) diff --git a/messages/uniworx/categories/workflows/de-de-formal.msg b/messages/uniworx/categories/workflows/de-de-formal.msg index 5d83eb826..32456b267 100644 --- a/messages/uniworx/categories/workflows/de-de-formal.msg +++ b/messages/uniworx/categories/workflows/de-de-formal.msg @@ -75,6 +75,8 @@ WorkflowEdgeFormFieldUserNotFound: E-Mail Adresse konnte keinem/keiner Benutzer: WorkflowEdgeFormFieldMultipleNoneAdded: (Noch) keine Einträge WorkflowEdgeFormFieldCaptureUserLabel: Aktuelle:r Benutzer:in +WorkflowEdgeFormEnumFieldNothing: Keine Auswahl + WorkflowEdgeFormFieldDayTooFarPast offset@Integer: Datum liegt zu weit in der Vergangenheit (maximal #{offset} Tage) WorkflowEdgeFormFieldDayTooFarFuture offset@Integer: Datum liegt zu weit in der Zukunft (maximal #{offset} Tage) diff --git a/messages/uniworx/categories/workflows/en-eu.msg b/messages/uniworx/categories/workflows/en-eu.msg index aa8b5c391..41684ae60 100644 --- a/messages/uniworx/categories/workflows/en-eu.msg +++ b/messages/uniworx/categories/workflows/en-eu.msg @@ -34,6 +34,8 @@ WorkflowEdgeFormFieldUserNotFound: Email could not be resolved to an user WorkflowEdgeFormFieldMultipleNoneAdded: No entries (yet) WorkflowEdgeFormFieldCaptureUserLabel: Current user +WorkflowEdgeFormEnumFieldNothing: No selection + WorkflowEdgeFormFieldDayTooFarPast offset: Date is too far in the past (maximum #{offset} days) WorkflowEdgeFormFieldDayTooFarFuture offset: Date is too far in the future (maximum #{offset} days) diff --git a/src/Application.hs b/src/Application.hs index ab3bb8886..bcaf1edda 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -707,4 +707,4 @@ addPWEntry :: User addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do PWHashConf{..} <- getsYesod $ view _appAuthPWHash (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength - void $ insert User{..} \ No newline at end of file + void $ insert User{..} diff --git a/src/Handler/Utils/Workflow/EdgeForm.hs b/src/Handler/Utils/Workflow/EdgeForm.hs index 19869b178..36bdb7be6 100644 --- a/src/Handler/Utils/Workflow/EdgeForm.hs +++ b/src/Handler/Utils/Workflow/EdgeForm.hs @@ -29,7 +29,8 @@ import qualified Crypto.MAC.KMAC as Crypto import qualified Crypto.Saltine.Class as Saltine import qualified Data.Binary as Binary import qualified Data.ByteArray as BA -import Crypto.Hash.Algorithms (SHAKE256) +import Crypto.Hash.Algorithms (SHAKE128, SHAKE256) +import Crypto.MAC.KMAC (kmacGetDigest) import qualified Control.Monad.State.Class as State import Control.Monad.Trans.RWS.Lazy (runRWST, mapRWST) @@ -330,7 +331,7 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec mNudge <- ask case specField of - WorkflowPayloadFieldText{..} -> do + WorkflowPayloadFieldText{..} | Nothing <- wpftPresets -> do prev <- extractPrev @Text wSetTooltip' (fmap slI18n wpftTooltip) $ f wpftOptional @@ -340,6 +341,32 @@ workflowEdgePayloadFields specs = evalRWST (forM specs $ runExceptT . renderSpec & maybe id (addName . ($ "text")) mNudge ) (prev <|> wpftDefault) + WorkflowPayloadFieldText{..} | Just (otoList -> opts) <- wpftPresets -> do + prev <- extractPrev @Text + sBoxKey <- secretBoxKey + let offerNothing = wpftOptional || minLength 2 specs + optList = do + WorkflowPayloadTextPreset{..} <- opts + let optionExternalValue = toPathPiece @(Digest (SHAKE128 128)) . kmacGetDigest . kmaclazy ("payload-field-text-enum" :: ByteString) (Saltine.encode sBoxKey) $ Binary.encode optionInternalValue + optionInternalValue = wptpText + return ( Option + { optionDisplay = slI18n wptpLabel + , .. + } + , toWidget . slI18n <$> wptpTooltip + ) + readExternal = flip Map.lookup . Map.fromList $ map (views _1 (optionExternalValue &&& optionInternalValue)) optList + doExplainedSelectionField = has (folded . _wptpTooltip . _Just) opts + wSetTooltip' (fmap slI18n wpftTooltip) $ + f wpftOptional + (bool (selectField' (guardOn offerNothing $ SomeMessage MsgWorkflowEdgeFormEnumFieldNothing) . return $ OptionList (optList ^.. folded . _1) readExternal) + (explainedSelectionField (guardOn offerNothing (SomeMessage MsgWorkflowEdgeFormEnumFieldNothing, Nothing)) $ return (optList, readExternal)) + doExplainedSelectionField + ) + ( fsl (slI18n wpftLabel) + & maybe id (addName . ($ "text")) mNudge + ) + (prev <|> wpftDefault <|> preview (_head . _1 . to optionInternalValue) optList) WorkflowPayloadFieldNumber{..} -> do prev <- extractPrev @Scientific wSetTooltip' (fmap slI18n wpfnTooltip) $ diff --git a/src/Model/Types/Workflow.hs b/src/Model/Types/Workflow.hs index b1ada90b9..0b92b546e 100644 --- a/src/Model/Types/Workflow.hs +++ b/src/Model/Types/Workflow.hs @@ -17,6 +17,7 @@ module Model.Types.Workflow , WorkflowPayloadSpec(..), _WorkflowPayloadSpec , WorkflowPayloadFieldReference , WorkflowPayloadTimeCapture, WorkflowPayloadTimeCapturePrecision(..) + , WorkflowPayloadTextPreset(..) , WorkflowPayloadField(..) , WorkflowScope(..) , WorkflowScope'(..), classifyWorkflowScope @@ -255,6 +256,13 @@ data WorkflowPayloadTimeCapturePrecision instance Default WorkflowPayloadTimeCapturePrecision where def = WFCaptureDateTime +data WorkflowPayloadTextPreset = WorkflowPayloadTextPreset + { wptpText :: Text + , wptpLabel :: I18nText + , wptpTooltip :: Maybe I18nHtml + } deriving (Eq, Ord, Read, Show, Generic, Typeable) + deriving anyclass (NFData) + -- Don't forget to update the NFData instance for every change! data WorkflowPayloadField fileid userid (payload :: Type) where WorkflowPayloadFieldText :: { wpftLabel :: I18nText @@ -263,6 +271,7 @@ data WorkflowPayloadField fileid userid (payload :: Type) where , wpftDefault :: Maybe Text , wpftLarge :: Bool , wpftOptional :: Bool + , wpftPresets :: Maybe (NonEmpty WorkflowPayloadTextPreset) } -> WorkflowPayloadField fileid userid Text WorkflowPayloadFieldNumber :: { wpfnLabel :: I18nText , wpfnPlaceholder :: Maybe I18nText @@ -374,7 +383,7 @@ instance (Ord fileid, Ord userid, Typeable fileid, Typeable userid, Ord (FileFie instance (NFData fileid, NFData userid, NFData (FileField fileid)) => NFData (WorkflowPayloadField fileid userid payload) where rnf = \case - WorkflowPayloadFieldText{..} -> wpftLabel `deepseq` wpftPlaceholder `deepseq` wpftTooltip `deepseq` wpftDefault `deepseq` wpftLarge `deepseq` wpftOptional `deepseq` () + WorkflowPayloadFieldText{..} -> wpftLabel `deepseq` wpftPlaceholder `deepseq` wpftTooltip `deepseq` wpftDefault `deepseq` wpftLarge `deepseq` wpftOptional `deepseq` wpftPresets `deepseq` () WorkflowPayloadFieldNumber{..} -> wpfnLabel `deepseq` wpfnPlaceholder `deepseq` wpfnTooltip `deepseq` wpfnDefault `deepseq` wpfnMin `deepseq` wpfnMax `deepseq` wpfnStep `deepseq` wpfnOptional `deepseq` () WorkflowPayloadFieldBool{..} -> wpfbLabel `deepseq` wpfbTooltip `deepseq` wpfbDefault `deepseq` wpfbOptional `deepseq` () WorkflowPayloadFieldDay{..} -> wpfdLabel `deepseq` wpfdTooltip `deepseq` wpfdDefault `deepseq` wpfdOptional `deepseq` wpfdMaxPast `deepseq` wpfdMaxFuture `deepseq` () @@ -830,6 +839,10 @@ deriveJSON defaultOptions pathPieceJSON ''WorkflowPayloadTimeCapturePrecision +deriveJSON defaultOptions + { fieldLabelModifier = camelToPathPiece' 1 + } ''WorkflowPayloadTextPreset + instance (FromJSON userid, Ord userid) => FromJSON (WorkflowNodeMessage userid) where parseJSON = genericParseJSON workflowNodeMessageAesonOptions instance (FromJSON userid, Ord userid) => FromJSON (WorkflowEdgeMessage userid) where @@ -927,6 +940,7 @@ instance (ToJSON fileid, ToJSON userid, ToJSON (FileField fileid)) => ToJSON (Wo , "default" JSON..= wpftDefault , "large" JSON..= wpftLarge , "optional" JSON..= wpftOptional + , "presets" JSON..= wpftPresets ] toJSON WorkflowPayloadFieldNumber{..} = JSON.object $ omitNothing [ "tag" JSON..= WPFNumber' @@ -1007,6 +1021,7 @@ instance ( FromJSON fileid, FromJSON userid wpftDefault <- o JSON..:? "default" wpftLarge <- o JSON..:? "large" JSON..!= False wpftOptional <- o JSON..: "optional" + wpftPresets <- o JSON..:? "presets" return $ WorkflowPayloadSpec WorkflowPayloadFieldText{..} WPFNumber' -> do wpfnLabel <- o JSON..: "label" diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 7605d1e0e..d64fb01e8 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -260,6 +260,7 @@ makeLenses_ ''WorkflowScope makeLenses_ ''WorkflowInstance makeLenses_ ''WorkflowInstanceDescription makeLenses_ ''WorkflowWorkflow +makeLenses_ ''WorkflowPayloadTextPreset makeLenses_ ''WorkflowGraph makeLenses_ ''WorkflowGraphNode