1 {-# LANGUAGE TemplateHaskell, QuasiQuotes, DataKinds, OverloadedStrings #-} 2 module Databrary.Model.Stats 3 ( lookupSiteStats 4 ) where 5 6 import Control.Monad (liftM2) 7 import qualified Data.Array.Unboxed as A 8 import qualified Data.Map.Strict as M 9 import Data.Maybe (fromMaybe, mapMaybe) 10 import Data.Scientific (toBoundedInteger) 11 import Database.PostgreSQL.Typed.Types 12 import Database.PostgreSQL.Typed.Query 13 import Data.ByteString (ByteString) 14 15 import Databrary.Service.DB 16 import Databrary.Model.Stats.Types 17 18 type PGTypeBigInt = PGTypeName "bigint" 19 type PGTypeInterval = PGTypeName "interval" 20 type PGTypeNumeric = PGTypeName "numeric" 21 type PGTypeSmallInt = PGTypeName "smallint" 22 23 pgDecodeColumn' :: PGColumn t (Maybe a) => PGTypeName t -> PGValue -> Maybe a 24 pgDecodeColumn' = pgDecodeColumn unknownPGTypeEnv 25 26 pgDecodeColumnNotNull' :: PGColumn t a => PGTypeName t -> PGValue -> a 27 pgDecodeColumnNotNull' = pgDecodeColumnNotNull unknownPGTypeEnv 28 29 mapQuery :: ByteString -> ([PGValue] -> a) -> PGSimpleQuery a 30 mapQuery qry mkResult = 31 fmap mkResult (rawPGSimpleQuery qry) 32 33 lookupSiteStats :: MonadDB c m => m SiteStats 34 lookupSiteStats = do 35 ac <- dbQuery 36 (fmap 37 (\[csite, ccount] 38 -> (pgDecodeColumn' (PGTypeProxy :: PGTypeName "permission") csite, 39 pgDecodeColumn' (PGTypeProxy :: PGTypeBigInt) ccount)) 40 (rawPGSimpleQuery "SELECT site, count(child) FROM authorize_view WHERE parent = 0 AND child > 4 GROUP BY site")) 41 v <- dbQuery1' 42 (fmap 43 (\[ccount] -> pgDecodeColumn' (PGTypeProxy :: PGTypeBigInt) ccount) 44 (rawPGSimpleQuery "SELECT count(id) FROM volume WHERE id > 0")) 45 vs <- dbQuery1' 46 (mapQuery 47 "SELECT count(volume) FROM volume_access WHERE volume > 0 AND party = 0 AND children >= 'PUBLIC'" 48 (\[ccount] -> pgDecodeColumn' (PGTypeProxy :: PGTypeName "bigint") ccount)) 49 (a, ad, ab) <- 50 dbQuery1' 51 (mapQuery 52 "SELECT count(id), sum(duration), sum(size) FROM asset JOIN slot_asset ON asset = id WHERE volume > 0" 53 (\[ccount, csum1, csum2] -> 54 ( pgDecodeColumn' (PGTypeProxy :: PGTypeBigInt) ccount 55 , pgDecodeColumn' (PGTypeProxy :: PGTypeInterval) csum1 56 , pgDecodeColumn' (PGTypeProxy :: PGTypeNumeric) csum2))) 57 rc <- 58 dbQuery 59 (mapQuery 60 "SELECT category, count(id) FROM record GROUP BY category ORDER BY category" 61 (\[ccategory, ccount] -> 62 ( pgDecodeColumnNotNull' (PGTypeProxy :: PGTypeSmallInt) ccategory 63 , pgDecodeColumn' (PGTypeProxy :: PGTypeBigInt) ccount))) 64 return SiteStats 65 { statsAuthorizedSite = A.accumArray (+) 0 (minBound, maxBound) $ l ac 66 , statsVolumes = z v 67 , statsVolumesShared = z vs 68 , statsAssets = z a 69 , statsAssetDuration = z ad 70 , statsAssetBytes = z $ toBoundedInteger =<< ab 71 , statsRecords = M.fromDistinctAscList $ l rc 72 } 73 where 74 z :: Num a => Maybe a -> a 75 z = fromMaybe 0 76 l :: [(Maybe a, Maybe b)] -> [(a, b)] 77 l = mapMaybe (uncurry $ liftM2 (,))