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