chore(workflows): migrate archived

src/Model/Migration/Definitions.hs

@@ -103,9 +103,7 @@ data ManualMigration
   | Migration20210208StudyFeaturesRelevanceCachedUUIDs
   | Migration20210318CrontabSubmissionRatedNotification
   | Migration20210608SeparateTermActive
-    -- TODO: migration regarding authorship statements
+  | Migration20220519WorkflowArchivation
-    --         - apply desired non-default modes for IfI
-    --         - set authorship statement texts for IfI
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
   deriving anyclass (Universe, Finite)
 
@@ -1069,6 +1067,21 @@ customMigrations = mapF $ \case
         ALTER TABLE "term" DROP COLUMN "active";
       |]
 
+  Migration20220519WorkflowArchivation -> do
+    now <- liftIO getCurrentTime
+    mArchiveAfter <- lift $ view _appWorkflowWorkflowArchiveAfter
+
+    whenM (and2M (return $ is _Just mArchiveAfter) (not <$> columnExists "workflow_workflow" "archived")) $ do
+      [executeQQ| ALTER TABLE "workflow_workflow" ADD "archived" timestamp with time zone; |]
+      let getWorkflows = [queryQQ| SELECT "workflow_workflow"."id", "workflow_workflow".("state"->>-1)::json->'time', "workflow_workflow".("state"->>-1)::json->'to', "shared_workflow_graph"."graph"->'nodes' FROM "workflow_workflow" INNER JOIN "shared_workflow_graph" ON "workflow_workflow"."graph" = "shared_workflow_graph"."hash"; |]
+          migrateArchived [ fromPersistValue -> Right (wwId :: WorkflowWorkflowId), fromPersistValue -> Right (wpTime :: UTCTime), fromPersistValue -> Right (wpTo :: WorkflowGraphNodeLabel), fromPersistValue -> Right (wGraph :: DBWorkflowGraph) ] = maybeT (return ()) $ do
+            archiveAfter <- hoistMaybe mArchiveAfter
+            WGN{wgnFinal} <- hoistMaybe . Map.lookup wpTo $ wgNodes wGraph
+            let wwArchived = const (max now $ archiveAfter `addUTCTime` wpTime) <$> wgnFinal
+            lift [executeQQ| UPDATE workflow_workflow SET archived = #{wwArchived} WHERE id = #{wwId} |]
+          migrateArchived _ = return ()
+       in runConduit $ getWorkflows .| C.mapM_ migrateArchived
+
 
 tableExists :: MonadIO m => Text -> ReaderT SqlBackend m Bool
 tableExists table = do