{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards #-}
module Database.MongoDB.Admin (
CollectionOption(..), createCollection, renameCollection, dropCollection,
validateCollection,
Index(..), IndexName, index, ensureIndex, createIndex, dropIndex,
getIndexes, dropIndexes,
allUsers, addUser, removeUser,
admin, cloneDatabase, copyDatabase, dropDatabase, repairDatabase,
serverBuildInfo, serverVersion,
collectionStats, dataSize, storageSize, totalIndexSize, totalSize,
ProfilingLevel(..), getProfilingLevel, MilliSec, setProfilingLevel,
dbStats, OpNum, currentOp, killOp,
serverStatus
) where
import Prelude hiding (lookup)
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Concurrent (forkIO, threadDelay)
import Control.Monad (forever, unless, liftM)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.Maybe (maybeToList)
import Data.Set (Set)
import System.IO.Unsafe (unsafePerformIO)
import qualified Data.HashTable.IO as H
import qualified Data.Set as Set
import Control.Monad.Trans (MonadIO, liftIO)
import Data.Bson (Document, Field(..), at, (=:), (=?), exclude, merge)
import Data.Text (Text)
import qualified Data.Text as T
import Database.MongoDB.Connection (Host, showHostPort)
import Database.MongoDB.Internal.Protocol (pwHash, pwKey)
import Database.MongoDB.Internal.Util ((<.>), true1)
import Database.MongoDB.Query (Action, Database, Collection, Username, Password,
Order, Query(..), accessMode, master, runCommand,
useDb, thisDatabase, rest, select, find, findOne,
insert_, save, delete)
data CollectionOption = Capped | MaxByteSize Int | MaxItems Int deriving (Int -> CollectionOption -> ShowS
[CollectionOption] -> ShowS
CollectionOption -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CollectionOption] -> ShowS
$cshowList :: [CollectionOption] -> ShowS
show :: CollectionOption -> String
$cshow :: CollectionOption -> String
showsPrec :: Int -> CollectionOption -> ShowS
$cshowsPrec :: Int -> CollectionOption -> ShowS
Show, CollectionOption -> CollectionOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectionOption -> CollectionOption -> Bool
$c/= :: CollectionOption -> CollectionOption -> Bool
== :: CollectionOption -> CollectionOption -> Bool
$c== :: CollectionOption -> CollectionOption -> Bool
Eq)
coptElem :: CollectionOption -> Field
coptElem :: CollectionOption -> Field
coptElem CollectionOption
Capped = Database
"capped" forall v. Val v => Database -> v -> Field
=: Bool
True
coptElem (MaxByteSize Int
n) = Database
"size" forall v. Val v => Database -> v -> Field
=: Int
n
coptElem (MaxItems Int
n) = Database
"max" forall v. Val v => Database -> v -> Field
=: Int
n
createCollection :: (MonadIO m) => [CollectionOption] -> Collection -> Action m Document
createCollection :: forall (m :: * -> *).
MonadIO m =>
[CollectionOption] -> Database -> Action m Order
createCollection [CollectionOption]
opts Database
col = forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand forall a b. (a -> b) -> a -> b
$ [Database
"create" forall v. Val v => Database -> v -> Field
=: Database
col] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map CollectionOption -> Field
coptElem [CollectionOption]
opts
renameCollection :: (MonadIO m) => Collection -> Collection -> Action m Document
renameCollection :: forall (m :: * -> *).
MonadIO m =>
Database -> Database -> Action m Order
renameCollection Database
from Database
to = do
Database
db <- forall (m :: * -> *). Monad m => Action m Database
thisDatabase
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
admin forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"renameCollection" forall v. Val v => Database -> v -> Field
=: Database
db Database -> Database -> Database
<.> Database
from, Database
"to" forall v. Val v => Database -> v -> Field
=: Database
db Database -> Database -> Database
<.> Database
to, Database
"dropTarget" forall v. Val v => Database -> v -> Field
=: Bool
True]
dropCollection :: (MonadIO m, MonadFail m) => Collection -> Action m Bool
dropCollection :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Database -> Action m Bool
dropCollection Database
coll = do
forall (m :: * -> *). MonadIO m => Action m ()
resetIndexCache
Order
r <- forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"drop" forall v. Val v => Database -> v -> Field
=: Database
coll]
if Database -> Order -> Bool
true1 Database
"ok" Order
r then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else do
if forall v. Val v => Database -> Order -> v
at Database
"errmsg" Order
r forall a. Eq a => a -> a -> Bool
== (Database
"ns not found" :: Text) then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"dropCollection failed: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Order
r
validateCollection :: (MonadIO m) => Collection -> Action m Document
validateCollection :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
validateCollection Database
coll = forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"validate" forall v. Val v => Database -> v -> Field
=: Database
coll]
type IndexName = Text
data Index = Index {
Index -> Database
iColl :: Collection,
Index -> Order
iKey :: Order,
Index -> Database
iName :: IndexName,
Index -> Bool
iUnique :: Bool,
Index -> Bool
iDropDups :: Bool,
Index -> Maybe Int
iExpireAfterSeconds :: Maybe Int
} deriving (Int -> Index -> ShowS
[Index] -> ShowS
Index -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Index] -> ShowS
$cshowList :: [Index] -> ShowS
show :: Index -> String
$cshow :: Index -> String
showsPrec :: Int -> Index -> ShowS
$cshowsPrec :: Int -> Index -> ShowS
Show, Index -> Index -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c== :: Index -> Index -> Bool
Eq)
idxDocument :: Index -> Database -> Document
idxDocument :: Index -> Database -> Order
idxDocument Index{Bool
Order
Maybe Int
Database
iExpireAfterSeconds :: Maybe Int
iDropDups :: Bool
iUnique :: Bool
iName :: Database
iKey :: Order
iColl :: Database
iExpireAfterSeconds :: Index -> Maybe Int
iDropDups :: Index -> Bool
iUnique :: Index -> Bool
iName :: Index -> Database
iKey :: Index -> Order
iColl :: Index -> Database
..} Database
db = [
Database
"ns" forall v. Val v => Database -> v -> Field
=: Database
db Database -> Database -> Database
<.> Database
iColl,
Database
"key" forall v. Val v => Database -> v -> Field
=: Order
iKey,
Database
"name" forall v. Val v => Database -> v -> Field
=: Database
iName,
Database
"unique" forall v. Val v => Database -> v -> Field
=: Bool
iUnique,
Database
"dropDups" forall v. Val v => Database -> v -> Field
=: Bool
iDropDups ] forall a. [a] -> [a] -> [a]
++ (forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall v. Val v => Database -> v -> Field
(=:) Database
"expireAfterSeconds") Maybe Int
iExpireAfterSeconds)
index :: Collection -> Order -> Index
index :: Database -> Order -> Index
index Database
coll Order
keys = Database -> Order -> Database -> Bool -> Bool -> Maybe Int -> Index
Index Database
coll Order
keys (Order -> Database
genName Order
keys) Bool
False Bool
False forall a. Maybe a
Nothing
genName :: Order -> IndexName
genName :: Order -> Database
genName Order
keys = Database -> [Database] -> Database
T.intercalate Database
"_" (forall a b. (a -> b) -> [a] -> [b]
map Field -> Database
f Order
keys) where
f :: Field -> Database
f (Database
k := Value
v) = Database
k Database -> Database -> Database
`T.append` Database
"_" Database -> Database -> Database
`T.append` String -> Database
T.pack (forall a. Show a => a -> String
show Value
v)
ensureIndex :: (MonadIO m) => Index -> Action m ()
ensureIndex :: forall (m :: * -> *). MonadIO m => Index -> Action m ()
ensureIndex Index
idx = let k :: (Database, Database)
k = (Index -> Database
iColl Index
idx, Index -> Database
iName Index
idx) in do
IndexCache
icache <- forall (m :: * -> *). MonadIO m => Action m IndexCache
fetchIndexCache
Set (Database, Database)
set <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IORef a -> IO a
readIORef IndexCache
icache)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Ord a => a -> Set a -> Bool
Set.member (Database, Database)
k Set (Database, Database)
set) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a.
Monad m =>
AccessMode -> Action m a -> Action m a
accessMode AccessMode
master (forall (m :: * -> *). MonadIO m => Index -> Action m ()
createIndex Index
idx)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IndexCache
icache (forall a. Ord a => a -> Set a -> Set a
Set.insert (Database, Database)
k Set (Database, Database)
set)
createIndex :: (MonadIO m) => Index -> Action m ()
createIndex :: forall (m :: * -> *). MonadIO m => Index -> Action m ()
createIndex Index
idx = forall (m :: * -> *). MonadIO m => Database -> Order -> Action m ()
insert_ Database
"system.indexes" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index -> Database -> Order
idxDocument Index
idx forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). Monad m => Action m Database
thisDatabase
dropIndex :: (MonadIO m) => Collection -> IndexName -> Action m Document
dropIndex :: forall (m :: * -> *).
MonadIO m =>
Database -> Database -> Action m Order
dropIndex Database
coll Database
idxName = do
forall (m :: * -> *). MonadIO m => Action m ()
resetIndexCache
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"deleteIndexes" forall v. Val v => Database -> v -> Field
=: Database
coll, Database
"index" forall v. Val v => Database -> v -> Field
=: Database
idxName]
getIndexes :: MonadIO m => Collection -> Action m [Document]
getIndexes :: forall (m :: * -> *). MonadIO m => Database -> Action m [Order]
getIndexes Database
coll = do
Database
db <- forall (m :: * -> *). Monad m => Action m Database
thisDatabase
forall (m :: * -> *). MonadIO m => Cursor -> Action m [Order]
rest forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => Query -> Action m Cursor
find (forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [Database
"ns" forall v. Val v => Database -> v -> Field
=: Database
db Database -> Database -> Database
<.> Database
coll] Database
"system.indexes")
dropIndexes :: (MonadIO m) => Collection -> Action m Document
dropIndexes :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
dropIndexes Database
coll = do
forall (m :: * -> *). MonadIO m => Action m ()
resetIndexCache
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"deleteIndexes" forall v. Val v => Database -> v -> Field
=: Database
coll, Database
"index" forall v. Val v => Database -> v -> Field
=: (Database
"*" :: Text)]
type DbIndexCache = H.BasicHashTable Database IndexCache
type IndexCache = IORef (Set (Collection, IndexName))
dbIndexCache :: DbIndexCache
dbIndexCache :: DbIndexCache
dbIndexCache = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
HashTable RealWorld Database IndexCache
table <- forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
ThreadId
_ <- IO () -> IO ThreadId
forkIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
900000000 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
clearDbIndexCache
forall (m :: * -> *) a. Monad m => a -> m a
return HashTable RealWorld Database IndexCache
table
{-# NOINLINE dbIndexCache #-}
clearDbIndexCache :: IO ()
clearDbIndexCache :: IO ()
clearDbIndexCache = do
[Database]
keys <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList DbIndexCache
dbIndexCache
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO ()
H.delete DbIndexCache
dbIndexCache) [Database]
keys
fetchIndexCache :: (MonadIO m) => Action m IndexCache
fetchIndexCache :: forall (m :: * -> *). MonadIO m => Action m IndexCache
fetchIndexCache = do
Database
db <- forall (m :: * -> *). Monad m => Action m Database
thisDatabase
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Maybe IndexCache
mc <- forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup DbIndexCache
dbIndexCache Database
db
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Database -> IO IndexCache
newIdxCache Database
db) forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexCache
mc
where
newIdxCache :: Database -> IO IndexCache
newIdxCache Database
db = do
IndexCache
idx <- forall a. a -> IO (IORef a)
newIORef forall a. Set a
Set.empty
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> v -> IO ()
H.insert DbIndexCache
dbIndexCache Database
db IndexCache
idx
forall (m :: * -> *) a. Monad m => a -> m a
return IndexCache
idx
resetIndexCache :: (MonadIO m) => Action m ()
resetIndexCache :: forall (m :: * -> *). MonadIO m => Action m ()
resetIndexCache = do
IndexCache
icache <- forall (m :: * -> *). MonadIO m => Action m IndexCache
fetchIndexCache
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a. IORef a -> a -> IO ()
writeIORef IndexCache
icache forall a. Set a
Set.empty)
allUsers :: MonadIO m => Action m [Document]
allUsers :: forall (m :: * -> *). MonadIO m => Action m [Order]
allUsers = forall a b. (a -> b) -> [a] -> [b]
map ([Database] -> Order -> Order
exclude [Database
"_id"]) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (forall (m :: * -> *). MonadIO m => Cursor -> Action m [Order]
rest forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => Query -> Action m Cursor
find
(forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [] Database
"system.users") {sort :: Order
sort = [Database
"user" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)], project :: Order
project = [Database
"user" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int), Database
"readOnly" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]})
addUser :: (MonadIO m)
=> Bool -> Username -> Password -> Action m ()
addUser :: forall (m :: * -> *).
MonadIO m =>
Bool -> Database -> Database -> Action m ()
addUser Bool
readOnly Database
user Database
pass = do
Maybe Order
mu <- forall (m :: * -> *). MonadIO m => Query -> Action m (Maybe Order)
findOne (forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [Database
"user" forall v. Val v => Database -> v -> Field
=: Database
user] Database
"system.users")
let usr :: Order
usr = Order -> Order -> Order
merge [Database
"readOnly" forall v. Val v => Database -> v -> Field
=: Bool
readOnly, Database
"pwd" forall v. Val v => Database -> v -> Field
=: Database -> Database -> Database
pwHash Database
user Database
pass] (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Database
"user" forall v. Val v => Database -> v -> Field
=: Database
user] forall a. a -> a
id Maybe Order
mu)
forall (m :: * -> *). MonadIO m => Database -> Order -> Action m ()
save Database
"system.users" Order
usr
removeUser :: (MonadIO m)
=> Username -> Action m ()
removeUser :: forall (m :: * -> *). MonadIO m => Database -> Action m ()
removeUser Database
user = forall (m :: * -> *). MonadIO m => Selection -> Action m ()
delete (forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [Database
"user" forall v. Val v => Database -> v -> Field
=: Database
user] Database
"system.users")
admin :: Database
admin :: Database
admin = Database
"admin"
cloneDatabase :: (MonadIO m) => Database -> Host -> Action m Document
cloneDatabase :: forall (m :: * -> *).
MonadIO m =>
Database -> Host -> Action m Order
cloneDatabase Database
db Host
fromHost = forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
db forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"clone" forall v. Val v => Database -> v -> Field
=: Host -> String
showHostPort Host
fromHost]
copyDatabase :: (MonadIO m) => Database -> Host -> Maybe (Username, Password) -> Database -> Action m Document
copyDatabase :: forall (m :: * -> *).
MonadIO m =>
Database
-> Host -> Maybe (Database, Database) -> Database -> Action m Order
copyDatabase Database
fromDb Host
fromHost Maybe (Database, Database)
mup Database
toDb = do
let c :: Order
c = [Database
"copydb" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int), Database
"fromhost" forall v. Val v => Database -> v -> Field
=: Host -> String
showHostPort Host
fromHost, Database
"fromdb" forall v. Val v => Database -> v -> Field
=: Database
fromDb, Database
"todb" forall v. Val v => Database -> v -> Field
=: Database
toDb]
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
admin forall a b. (a -> b) -> a -> b
$ case Maybe (Database, Database)
mup of
Maybe (Database, Database)
Nothing -> forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand Order
c
Just (Database
usr, Database
pss) -> do
Database
n <- forall v. Val v => Database -> Order -> v
at Database
"nonce" forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"copydbgetnonce" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int), Database
"fromhost" forall v. Val v => Database -> v -> Field
=: Host -> String
showHostPort Host
fromHost]
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand forall a b. (a -> b) -> a -> b
$ Order
c forall a. [a] -> [a] -> [a]
++ [Database
"username" forall v. Val v => Database -> v -> Field
=: Database
usr, Database
"nonce" forall v. Val v => Database -> v -> Field
=: Database
n, Database
"key" forall v. Val v => Database -> v -> Field
=: Database -> Database -> Database -> Database
pwKey Database
n Database
usr Database
pss]
dropDatabase :: (MonadIO m) => Database -> Action m Document
dropDatabase :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
dropDatabase Database
db = forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
db forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"dropDatabase" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]
repairDatabase :: (MonadIO m) => Database -> Action m Document
repairDatabase :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
repairDatabase Database
db = forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
db forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"repairDatabase" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]
serverBuildInfo :: (MonadIO m) => Action m Document
serverBuildInfo :: forall (m :: * -> *). MonadIO m => Action m Order
serverBuildInfo = forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
admin forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"buildinfo" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]
serverVersion :: (MonadIO m) => Action m Text
serverVersion :: forall (m :: * -> *). MonadIO m => Action m Database
serverVersion = forall v. Val v => Database -> Order -> v
at Database
"version" forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadIO m => Action m Order
serverBuildInfo
collectionStats :: (MonadIO m) => Collection -> Action m Document
collectionStats :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats Database
coll = forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"collstats" forall v. Val v => Database -> v -> Field
=: Database
coll]
dataSize :: (MonadIO m) => Collection -> Action m Int
dataSize :: forall (m :: * -> *). MonadIO m => Database -> Action m Int
dataSize Database
c = forall v. Val v => Database -> Order -> v
at Database
"size" forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats Database
c
storageSize :: (MonadIO m) => Collection -> Action m Int
storageSize :: forall (m :: * -> *). MonadIO m => Database -> Action m Int
storageSize Database
c = forall v. Val v => Database -> Order -> v
at Database
"storageSize" forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats Database
c
totalIndexSize :: (MonadIO m) => Collection -> Action m Int
totalIndexSize :: forall (m :: * -> *). MonadIO m => Database -> Action m Int
totalIndexSize Database
c = forall v. Val v => Database -> Order -> v
at Database
"totalIndexSize" forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats Database
c
totalSize :: MonadIO m => Collection -> Action m Int
totalSize :: forall (m :: * -> *). MonadIO m => Database -> Action m Int
totalSize Database
coll = do
Int
x <- forall (m :: * -> *). MonadIO m => Database -> Action m Int
storageSize Database
coll
[Int]
xs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {m :: * -> *} {r}.
(Val r, MonadIO m) =>
Order -> ReaderT MongoContext m r
isize forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => Database -> Action m [Order]
getIndexes Database
coll
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Num a => a -> a -> a
(+) Int
x [Int]
xs)
where
isize :: Order -> ReaderT MongoContext m r
isize Order
idx = forall v. Val v => Database -> Order -> v
at Database
"storageSize" forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats (Database
coll Database -> Database -> Database
`T.append` Database
".$" Database -> Database -> Database
`T.append` forall v. Val v => Database -> Order -> v
at Database
"name" Order
idx)
data ProfilingLevel
= Off
| Slow
| All
deriving (Int -> ProfilingLevel -> ShowS
[ProfilingLevel] -> ShowS
ProfilingLevel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProfilingLevel] -> ShowS
$cshowList :: [ProfilingLevel] -> ShowS
show :: ProfilingLevel -> String
$cshow :: ProfilingLevel -> String
showsPrec :: Int -> ProfilingLevel -> ShowS
$cshowsPrec :: Int -> ProfilingLevel -> ShowS
Show, Int -> ProfilingLevel
ProfilingLevel -> Int
ProfilingLevel -> [ProfilingLevel]
ProfilingLevel -> ProfilingLevel
ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
ProfilingLevel
-> ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ProfilingLevel
-> ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
$cenumFromThenTo :: ProfilingLevel
-> ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
enumFromTo :: ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
$cenumFromTo :: ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
enumFromThen :: ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
$cenumFromThen :: ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
enumFrom :: ProfilingLevel -> [ProfilingLevel]
$cenumFrom :: ProfilingLevel -> [ProfilingLevel]
fromEnum :: ProfilingLevel -> Int
$cfromEnum :: ProfilingLevel -> Int
toEnum :: Int -> ProfilingLevel
$ctoEnum :: Int -> ProfilingLevel
pred :: ProfilingLevel -> ProfilingLevel
$cpred :: ProfilingLevel -> ProfilingLevel
succ :: ProfilingLevel -> ProfilingLevel
$csucc :: ProfilingLevel -> ProfilingLevel
Enum, ProfilingLevel -> ProfilingLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProfilingLevel -> ProfilingLevel -> Bool
$c/= :: ProfilingLevel -> ProfilingLevel -> Bool
== :: ProfilingLevel -> ProfilingLevel -> Bool
$c== :: ProfilingLevel -> ProfilingLevel -> Bool
Eq)
getProfilingLevel :: (MonadIO m) => Action m ProfilingLevel
getProfilingLevel :: forall (m :: * -> *). MonadIO m => Action m ProfilingLevel
getProfilingLevel = (forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. Val v => Database -> Order -> v
at Database
"was") forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"profile" forall v. Val v => Database -> v -> Field
=: (-Int
1 :: Int)]
type MilliSec = Int
setProfilingLevel :: (MonadIO m) => ProfilingLevel -> Maybe MilliSec -> Action m ()
setProfilingLevel :: forall (m :: * -> *).
MonadIO m =>
ProfilingLevel -> Maybe Int -> Action m ()
setProfilingLevel ProfilingLevel
p Maybe Int
mSlowMs =
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand ([Database
"profile" forall v. Val v => Database -> v -> Field
=: forall a. Enum a => a -> Int
fromEnum ProfilingLevel
p] forall a. [a] -> [a] -> [a]
++ (Database
"slowms" forall a. Val a => Database -> Maybe a -> Order
=? Maybe Int
mSlowMs)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
dbStats :: (MonadIO m) => Action m Document
dbStats :: forall (m :: * -> *). MonadIO m => Action m Order
dbStats = forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"dbstats" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]
currentOp :: (MonadIO m) => Action m (Maybe Document)
currentOp :: forall (m :: * -> *). MonadIO m => Action m (Maybe Order)
currentOp = forall (m :: * -> *). MonadIO m => Query -> Action m (Maybe Order)
findOne (forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [] Database
"$cmd.sys.inprog")
type OpNum = Int
killOp :: (MonadIO m) => OpNum -> Action m (Maybe Document)
killOp :: forall (m :: * -> *). MonadIO m => Int -> Action m (Maybe Order)
killOp Int
op = forall (m :: * -> *). MonadIO m => Query -> Action m (Maybe Order)
findOne (forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [Database
"op" forall v. Val v => Database -> v -> Field
=: Int
op] Database
"$cmd.sys.killop")
serverStatus :: (MonadIO m) => Action m Document
serverStatus :: forall (m :: * -> *). MonadIO m => Action m Order
serverStatus = forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
admin forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"serverStatus" forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]