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 (,))