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