1 {-# LANGUAGE ScopedTypeVariables #-}
    2 module Controller.Metric
    3   ( postVolumeMetric
    4   , deleteVolumeMetric
    5   ) where
    6 
    7 import Control.Invertible.Monoidal ((>|<))
    8 
    9 import qualified Data.Aeson as Aeson
   10 import Model.Id
   11 import Model.Permission
   12 import Model.Volume
   13 import Model.Category
   14 import Model.Metric
   15 import Model.VolumeMetric
   16 import HTTP.Path.Parser
   17 import Action.Route
   18 import Action
   19 import Controller.Paths
   20 import Controller.Volume
   21 
   22 postVolumeMetric :: ActionRoute (Id Volume, Either (Id Category) (Id Metric))
   23 postVolumeMetric = action PUT (pathJSON >/> pathId </> (pathId >|< pathId)) $ \(vi, cm) -> withAuth $ do
   24   v <- getVolume PermissionEDIT vi
   25   addedMetrics <-
   26       AddVolumeCategoryOrMetricResponse <$>
   27          either
   28               (addVolumeCategory v)
   29               (\metricId' -> do
   30                   metricAdded <- addVolumeMetric v metricId'
   31                   return $ if metricAdded then [metricId'] else [])
   32               cm
   33   return $ okResponse [] $ (Aeson.encode . unwrap) addedMetrics
   34 
   35 newtype AddVolumeMetricsResponse = AddVolumeCategoryOrMetricResponse { unwrap :: [Id Metric] }
   36 
   37 deleteVolumeMetric :: ActionRoute (Id Volume, Either (Id Category) (Id Metric))
   38 deleteVolumeMetric = action DELETE (pathJSON >/> pathId </> (pathId >|< pathId)) $ \(vi, cm) -> withAuth $ do
   39   v <- getVolume PermissionEDIT vi
   40   r <- DeleteVolumeMetricsResponse <$> either (removeVolumeCategory v) (fmap fromEnum . removeVolumeMetric v) cm
   41   return $ okResponse [] $ (Aeson.encode . wasDeleted) r
   42 
   43 newtype DeleteVolumeMetricsResponse = DeleteVolumeMetricsResponse { wasDeleted :: Int }