feat: post on workflow working to create pipeline

api/sql/dump.sql

@@ -10,4 +10,15 @@ CREATE TABLE IF NOT EXISTS pipelines (
 	name VARCHAR(255) NOT NULL,
 	type VARCHAR(255) NOT NULL,
 	params JSONB NOT NULL
+);
+
+CREATE TABLE IF NOT EXISTS reactions (
+	id SERIAL PRIMARY KEY,
+	type VARCHAR(255) NOT NULL,
+	params JSONB NOT NULL,
+	pipeline_id INTEGER NOT NULL,
+	react_order INTEGER NOT NULL,
+	CONSTRAINT fk_pipeline
+		FOREIGN KEY (pipeline_id)
+			REFERENCES pipelines(id)
 );

api/src/Api/Pipeline.hs

@@ -12,7 +12,7 @@ import Servant (Capture, Get, type (:>), JSON, throwError, err401)
 import Servant.API.Generic ((:-))
 import GHC.Generics (Generic)
 import Data.Int (Int64)
-import Db.Pipeline (Pipeline (Pipeline), pipelineSchema, getPipelineById, PipelineId (PipelineId), insertPipeline)
+import Db.Pipeline (Pipeline (Pipeline), pipelineSchema, getPipelineById, PipelineId (PipelineId, toInt64), insertPipeline)
 import Data.Functor.Identity (Identity)
 import Servant.API (Post, Delete, Put, ReqBody)
 import App (AppM, State (State, dbPool))
@@ -28,6 +28,7 @@ import Rel8 (select, each, insert)
 import Core.Reaction (ReactionType, ReactionParams)
 import Core.Pipeline (PipelineType, PipelineParams)
 import Data.Text (Text)
+import Db.Reaction (Reaction (Reaction), ReactionId (ReactionId), insertReaction)
 
 
 data PipelineData = PipelineData
@@ -52,7 +53,7 @@ $(deriveJSON defaultOptions ''PostPipelineData)
 
 data PipelineAPI mode = PipelineAPI
     { get   :: mode :- Capture "id" Int64 :> Get '[JSON] [Pipeline Identity]
-    , post  :: mode :- ReqBody '[JSON] PostPipelineData :> Post '[JSON] (Pipeline Identity)
+    , post  :: mode :- ReqBody '[JSON] PostPipelineData :> Post '[JSON] [ReactionId]
     , put   :: mode :- Capture "id" Int64 :> Put '[JSON] (Pipeline Identity)
     , del   :: mode :- Capture "id" Int64 :> Delete '[JSON] (Pipeline Identity)
     } deriving stock Generic
@@ -73,12 +74,26 @@ createPipeline pipeline = do
     State{dbPool = p} <- ask
     runTransactionWithPool p $ statement () (insert $ insertPipeline pipeline)
 
-postPipelineHandler :: PostPipelineData -> AppM (Pipeline Identity)
+createReaction :: Reaction Identity -> AppM [ReactionId]
+createReaction reaction = do
+    State{dbPool = p} <- ask
+    runTransactionWithPool p $ statement () (insert $ insertReaction reaction)
+
+mapInd :: (a -> Int -> b) -> [a] -> [b]
+mapInd f l = zipWith f l [0..]
+
+
+postPipelineHandler :: PostPipelineData -> AppM [ReactionId]
 postPipelineHandler x = do
     actionId <- createPipeline $ Pipeline (PipelineId 1) (pipelineDataName p) (pipelineDataType p) (pipelineDataParams p)
-    throwError err401
+    sequence $ mapInd (reactionMap (head actionId)) r
     where
         p = action x
+        r = reactions x
+        reactionMap :: PipelineId -> ReactionData -> Int -> AppM ReactionId
+        reactionMap actionId s i = do
+            res <- createReaction $ Reaction (ReactionId 1) (reactionDataType s) (reactionDataParams s) actionId (fromIntegral i)
+            return $ head res
 
 putPipelineHandler :: Int64 -> AppM (Pipeline Identity)
 putPipelineHandler pipelineId = throwError err401

api/src/Db/Reaction.hs

@@ -12,7 +12,7 @@ import Data.Aeson
     ( eitherDecode, defaultOptions, FromJSON, ToJSON )
 import Data.Aeson.TH ( deriveJSON )
 import GHC.Generics (Generic)
-import Rel8 (DBEq, DBType, Column, Rel8able, ReadShow (ReadShow), JSONBEncoded (JSONBEncoded), Result, TableSchema (TableSchema, name, schema, columns), Name, Query, Expr, where_, (==.), lit, each)
+import Rel8 (DBEq, DBType, Column, Rel8able, ReadShow (ReadShow), JSONBEncoded (JSONBEncoded), Result, TableSchema (TableSchema, name, schema, columns), Name, Query, Expr, where_, (==.), lit, each, Insert (Insert, returning), into, rows, onConflict, returning, values, unsafeCastExpr, nextval, OnConflict (DoNothing), Returning (Projection))
 import Data.Text (Text)
 import Data.Int (Int64)
 
@@ -45,9 +45,24 @@ reactionSchema = TableSchema
   , schema = Nothing
   , columns = Reaction
       { reactionId = "id"
-      , reactionOrder = "order"
+      , reactionOrder = "react_order"
       , reactionType = "type"
       , reactionParams = "params"
-      , reactionPipelineId = "pipelineId"
+      , reactionPipelineId = "pipeline_id"
       }
-  }
+  }
+
+
+insertReaction :: Reaction Identity -> Insert [ReactionId]
+insertReaction (Reaction _ type' params pipeId order) = Insert
+    { into = reactionSchema
+    , rows = values [ Reaction {
+        reactionId = unsafeCastExpr $ nextval "reactions_id_seq",
+        reactionType = lit type',
+        reactionParams = lit params,
+        reactionPipelineId = lit pipeId,
+        reactionOrder = lit order
+    } ]
+    , onConflict = DoNothing
+    , returning = Projection reactionId
+    }