diff --git a/src/Model/Types/Workflow.hs b/src/Model/Types/Workflow.hs index 0b92b546e..29b7294c3 100644 --- a/src/Model/Types/Workflow.hs +++ b/src/Model/Types/Workflow.hs @@ -1113,13 +1113,43 @@ deriveJSON defaultOptions pathPieceJSON ''WorkflowScope' -deriveToJSON workflowActionAesonOptions ''WorkflowAction +newtype JsonWorkflowActionUser userid = JsonWorkflowActionUser (Maybe (Maybe userid)) + +instance ToJSON userid => ToJSON (JsonWorkflowActionUser userid) where + toJSON (JsonWorkflowActionUser x) = case x of + Nothing -> JSON.Null + Just Nothing -> JSON.object [ "tag" JSON..= ("unauthenticated" :: Text) ] + Just (Just x') -> toJSON x' + +instance FromJSON userid => FromJSON (JsonWorkflowActionUser userid) where + parseJSON JSON.Null = pure $ JsonWorkflowActionUser Nothing + parseJSON x@(JSON.Object _) + | x == JSON.object [ "tag" JSON..= ("unauthenticated" :: Text) ] + = pure . JsonWorkflowActionUser $ Just Nothing + | otherwise + = JsonWorkflowActionUser . Just . Just <$> parseJSON x + parseJSON x = JsonWorkflowActionUser . Just . Just <$> parseJSON x + +instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowAction fileid userid) where + toJSON WorkflowAction{..} = JSON.object + [ "to" JSON..= wpTo + , "via" JSON..= wpVia + , "payload" JSON..= wpPayload + , "user" JSON..= JsonWorkflowActionUser wpUser + , "time" JSON..= wpTime + ] instance ( FromJSON fileid, FromJSON userid , Ord fileid, Ord userid , Typeable fileid, Typeable userid ) => FromJSON (WorkflowAction fileid userid) where - parseJSON = genericParseJSON workflowActionAesonOptions + parseJSON = JSON.withObject "WorkflowAction" $ \o -> do + wpTo <- o JSON..: "to" + wpVia <- o JSON..: "via" + wpPayload <- o JSON..: "payload" + JsonWorkflowActionUser wpUser <- o JSON..: "user" + wpTime <- o JSON..: "time" + return WorkflowAction{..} instance (ToJSON fileid, ToJSON userid) => ToJSON (WorkflowFieldPayloadW fileid userid) where toJSON (WorkflowFieldPayloadW (WFPText t)) = JSON.object