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