From 263fee19f25a4782bf426347e385eedd1742c8da Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <vaupel.sarah@campus.lmu.de>
Date: Fri, 3 Apr 2020 22:11:15 +0200
Subject: [PATCH] fix(workflow): fix node and graph FromJSON instances

---
 src/Model/Types/Workflow.hs | 32 ++++++++++++++++++++++++++------
 1 file changed, 26 insertions(+), 6 deletions(-)

diff --git a/src/Model/Types/Workflow.hs b/src/Model/Types/Workflow.hs
index a6d736d31..d36d666c1 100644
--- a/src/Model/Types/Workflow.hs
+++ b/src/Model/Types/Workflow.hs
@@ -130,7 +130,9 @@ instance (Ord userid, Ord fileid) => Ord (WorkflowGraphEdge userid fileid) where
   e1@WGE{} <= e2@WGE{} = wgeActors e1 <= wgeActors e2 && wgeTarget e1 <= wgeTarget e2 && wgeForm e1 <= wgeForm e2
 
 
-data WorkflowGraph userid fileid = WorkflowGraph (Map WorkflowGraphNodeLabel (WorkflowGraphNode, Set (WorkflowGraphEdge userid fileid)))
+data WorkflowGraph userid fileid = WorkflowGraph
+  { wgNodes :: Map WorkflowGraphNodeLabel (WorkflowGraphNode, Set (WorkflowGraphEdge userid fileid))
+  }
 
 instance (Show userid, Show fileid) => Show (WorkflowGraph userid fileid) where
   show (WorkflowGraph m) = show m
@@ -176,9 +178,18 @@ instance (FromJSON userid) => FromJSON (WorkflowRole userid) where
       _ -> terror $ "WorkflowRole parseJSON error: expected role (user|authorized|initiator), but got " <> role
 
 instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraph userid fileid) where
-  toJSON (WorkflowGraph m) = toJSON m
-instance (FromJSON userid, FromJSON fileid) => FromJSON (WorkflowGraph userid fileid) where
-  parseJSON = parseJSON
+  toJSON WorkflowGraph{..} = JSON.object
+    [ "tag"   JSON..= ("workflow" :: Text)
+    , "nodes" JSON..= wgNodes
+    ]
+instance (FromJSON userid, FromJSON fileid, Ord userid, Ord fileid) => FromJSON (WorkflowGraph userid fileid) where
+  parseJSON = JSON.withObject "WorkflowGraph" $ \o -> do
+    fieldTag <- o JSON..: "tag"
+    case fieldTag of
+      "workflow" -> do
+        wgNodes <- o JSON..: "nodes"
+        return WorkflowGraph{..}
+      _ -> terror $ "WorkflowGraph parseJSON error: expected tag workflow, but got " <> fieldTag
 
 instance (ToJSON userid, ToJSON fileid) => ToJSON (WorkflowGraphEdge userid fileid) where
   toJSON (WGE{..}) = JSON.object
@@ -262,9 +273,18 @@ instance (FromJSON fileid, FromJSON userid) => FromJSON (WorkflowEdgePayloadSpec
       _ -> terror $ "WorkflowEdgePayloadSpecification parseJSON error: expected field tag (text|number|bool|file|user), but got " <> fieldTag
 
 instance ToJSON WorkflowGraphNode where
-  toJSON (WGN{..}) = toJSON wgnStatus
+  toJSON WGN{..} = JSON.object
+    [ "tag"    JSON..= ("node" :: Text)
+    , "status" JSON..= wgnStatus
+    ]
 instance FromJSON WorkflowGraphNode where
-  parseJSON = parseJSON
+  parseJSON = JSON.withObject "WorkflowGraphNode" $ \o -> do
+    fieldTag <- o JSON..: "tag"
+    case fieldTag of
+      "node" -> do
+        wgnStatus <- o JSON..: "status"
+        return WGN{..}
+      _ -> terror $ "WorkflowGraphNode parseJSON error: expected tag node, but got " <> fieldTag
 
 deriveJSON defaultOptions
   { fieldLabelModifier = camelToPathPiece' 1