1 {-# LANGUAGE OverloadedStrings #-}
    2 module Databrary.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 Databrary.Ops
   19 import Databrary.Has
   20 import qualified Databrary.JSON as JSON
   21 import Databrary.Service.Types
   22 import Databrary.Model.Id
   23 import Databrary.Model.Permission
   24 import Databrary.Model.Party
   25 import Databrary.Model.Authorize
   26 import Databrary.Model.Volume
   27 import Databrary.Model.VolumeAccess
   28 import Databrary.Model.Slot
   29 import Databrary.Model.Activity
   30 import Databrary.HTTP.Path.Parser
   31 import Databrary.Action
   32 import Databrary.Controller.Paths
   33 import Databrary.Controller.Angular
   34 import Databrary.Controller.Party
   35 import Databrary.Controller.Volume
   36 import Databrary.Controller.Container
   37 
   38 viewSiteActivityHandler :: Action -- TODO: GET only
   39 viewSiteActivityHandler = withAuth $ do
   40   ss <- focusIO $ readIORef . serviceStats
   41   vl <- map (second $ ("volume" JSON..=:) . (\v -> volumeJSONSimple v)) . 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