1 {-# LANGUAGE OverloadedStrings #-}
    2 module Controller.Activity
    3   ( viewSiteActivityHandler
    4   , viewPartyActivity
    5   , viewVolumeActivity
    6   , viewContainerActivity
    7   ) where
    8 
    9 import Control.Arrow (second)
   10 import Control.Monad (when)
   11 import Data.Function (on)
   12 import Data.IORef (readIORef)
   13 import Data.List (nubBy)
   14 import Data.Maybe (isJust, mapMaybe)
   15 import Data.Monoid ((<>))
   16 import Data.Ord (comparing)
   17 
   18 import Ops
   19 import Has
   20 import qualified JSON
   21 import Service.Types
   22 import Model.Id
   23 import Model.Permission
   24 import Model.Party
   25 import Model.Authorize
   26 import Model.Volume
   27 import Model.VolumeAccess
   28 import Model.Slot
   29 import Model.Activity
   30 import HTTP.Path.Parser
   31 import Action
   32 import Controller.Paths
   33 import Controller.Angular
   34 import Controller.Party
   35 import Controller.Volume
   36 import Controller.Container
   37 
   38 viewSiteActivityHandler :: Action -- TODO: GET only
   39 viewSiteActivityHandler = withAuth $ do
   40   ss <- focusIO $ readIORef . serviceStats
   41   vl <- map (second $ ("volume" JSON..=:) . volumeJSONSimple) . nubBy ((==) `on` volumeId . volumeRow . snd) <$> lookupVolumeShareActivity 8
   42   al <- map (second $ ("party"  JSON..=:) . partyJSON)  . nubBy ((==) `on` partyId  . partyRow  . snd) <$> lookupAuthorizeActivity 8
   43   return
   44     $ okResponse []
   45       $ JSON.pairs $
   46            "stats" JSON..= ss
   47         <> JSON.nestObject "activity" (\u -> map (u . ent) (take 12 $ mergeBy ((fo .) . comparing fst) vl al))
   48     -- HTML -> peeks $ okResponse [] . htmlSiteActivity ss
   49   where
   50   ent (t, j) = j <> "time" JSON..= t
   51   fo GT = LT
   52   fo _ = GT
   53 
   54 viewPartyActivity :: ActionRoute (API, PartyTarget)
   55 viewPartyActivity = action GET (pathAPI </> pathPartyTarget </< "activity") $ \(api, p) -> withAuth $ do
   56   when (api == HTML) angular
   57   v <- getParty (Just PermissionADMIN) p
   58   a <- lookupPartyActivity v
   59   return $ case api of
   60     ~JSON -> okResponse [] $ JSON.toEncoding $ mapMaybe activityJSON a
   61     -- TODO: HTML
   62 
   63 viewVolumeActivity :: ActionRoute (API, Id Volume)
   64 viewVolumeActivity = action GET (pathAPI </> pathId </< "activity") $ \(api, vi) -> withAuth $ do
   65   when (api == HTML) angular
   66   v <- getVolume PermissionEDIT vi
   67   a <- lookupVolumeActivity v
   68   return $ case api of
   69     ~JSON -> okResponse [] $ JSON.toEncoding $ mapMaybe activityJSON a
   70     -- TODO: HTML
   71 
   72 viewContainerActivity :: ActionRoute (API, (Maybe (Id Volume), Id Slot))
   73 viewContainerActivity = action GET (pathAPI </> pathMaybe pathId </> pathSlotId </< "activity") $ \(api, (vi, ci)) -> withAuth $ do
   74   when (api == HTML && isJust vi) angular
   75   v <- getContainer PermissionEDIT vi ci True
   76   a <- lookupContainerActivity v
   77   return $ case api of
   78     ~JSON -> okResponse [] $ JSON.toEncoding $ mapMaybe activityJSON a
   79     -- TODO: HTML