feat(workflows): enum fields

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)
 

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)
 

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{..}
+  void $ insert User{..}

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) $

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"

src/Utils/Lens.hs

@@ -260,6 +260,7 @@ makeLenses_ ''WorkflowScope
 makeLenses_ ''WorkflowInstance
 makeLenses_ ''WorkflowInstanceDescription
 makeLenses_ ''WorkflowWorkflow
+makeLenses_ ''WorkflowPayloadTextPreset
 
 makeLenses_ ''WorkflowGraph
 makeLenses_ ''WorkflowGraphNode