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