-- | Database administrative functions

{-# LANGUAGE CPP, FlexibleContexts, OverloadedStrings, RecordWildCards #-}

module Database.MongoDB.Admin (
    -- * Admin
    -- ** Collection
    CollectionOption(..), createCollection, renameCollection, dropCollection,
    validateCollection,
    -- ** Index
    Index(..), IndexName, index, ensureIndex, createIndex, dropIndex,
    getIndexes, dropIndexes,
    -- ** User
    allUsers, addUser, removeUser,
    -- ** Database
    admin, cloneDatabase, copyDatabase, dropDatabase, repairDatabase,
    -- ** Server
    serverBuildInfo, serverVersion,
    -- * Diagnotics
    -- ** Collection
    collectionStats, dataSize, storageSize, totalIndexSize, totalSize,
    -- ** Profiling
    ProfilingLevel(..), getProfilingLevel, MilliSec, setProfilingLevel,
    -- ** Database
    dbStats, OpNum, currentOp, killOp,
    -- ** Server
    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)

-- * Admin

-- ** Collection

data CollectionOption = Capped | MaxByteSize Int | MaxItems Int  deriving (Int -> CollectionOption -> ShowS
[CollectionOption] -> ShowS
CollectionOption -> String
(Int -> CollectionOption -> ShowS)
-> (CollectionOption -> String)
-> ([CollectionOption] -> ShowS)
-> Show CollectionOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollectionOption -> ShowS
showsPrec :: Int -> CollectionOption -> ShowS
$cshow :: CollectionOption -> String
show :: CollectionOption -> String
$cshowList :: [CollectionOption] -> ShowS
showList :: [CollectionOption] -> ShowS
Show, CollectionOption -> CollectionOption -> Bool
(CollectionOption -> CollectionOption -> Bool)
-> (CollectionOption -> CollectionOption -> Bool)
-> Eq CollectionOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CollectionOption -> CollectionOption -> Bool
== :: CollectionOption -> CollectionOption -> Bool
$c/= :: CollectionOption -> CollectionOption -> Bool
/= :: CollectionOption -> CollectionOption -> Bool
Eq)

coptElem :: CollectionOption -> Field
coptElem :: CollectionOption -> Field
coptElem CollectionOption
Capped = Database
"capped" Database -> Bool -> Field
forall v. Val v => Database -> v -> Field
=: Bool
True
coptElem (MaxByteSize Int
n) = Database
"size" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: Int
n
coptElem (MaxItems Int
n) = Database
"max" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: Int
n

createCollection :: (MonadIO m) => [CollectionOption] -> Collection -> Action m Document
-- ^ Create collection with given options. You only need to call this to set options, otherwise a collection is created automatically on first use with no options.
createCollection :: forall (m :: * -> *).
MonadIO m =>
[CollectionOption] -> Database -> Action m Order
createCollection [CollectionOption]
opts Database
col = Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand (Order -> Action m Order) -> Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ [Database
"create" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
col] Order -> Order -> Order
forall a. [a] -> [a] -> [a]
++ (CollectionOption -> Field) -> [CollectionOption] -> Order
forall a b. (a -> b) -> [a] -> [b]
map CollectionOption -> Field
coptElem [CollectionOption]
opts

renameCollection :: (MonadIO m) => Collection -> Collection -> Action m Document
-- ^ Rename first collection to second collection
renameCollection :: forall (m :: * -> *).
MonadIO m =>
Database -> Database -> Action m Order
renameCollection Database
from Database
to = do
    Database
db <- Action m Database
forall (m :: * -> *). Monad m => Action m Database
thisDatabase
    Database -> Action m Order -> Action m Order
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
admin (Action m Order -> Action m Order)
-> Action m Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"renameCollection" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
db Database -> Database -> Database
<.> Database
from, Database
"to" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
db Database -> Database -> Database
<.> Database
to, Database
"dropTarget" Database -> Bool -> Field
forall v. Val v => Database -> v -> Field
=: Bool
True]

dropCollection :: (MonadIO m, MonadFail m) => Collection -> Action m Bool
-- ^ Delete the given collection! Return @True@ if collection existed (and was deleted); return @False@ if collection did not exist (and no action).
dropCollection :: forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
Database -> Action m Bool
dropCollection Database
coll = do
    Action m ()
forall (m :: * -> *). MonadIO m => Action m ()
resetIndexCache
    Order
r <- Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"drop" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
coll]
    if Database -> Order -> Bool
true1 Database
"ok" Order
r then Bool -> Action m Bool
forall a. a -> ReaderT MongoContext m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else do
        if Database -> Order -> Database
forall v. Val v => Database -> Order -> v
at Database
"errmsg" Order
r Database -> Database -> Bool
forall a. Eq a => a -> a -> Bool
== (Database
"ns not found" :: Text) then Bool -> Action m Bool
forall a. a -> ReaderT MongoContext m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else
            String -> Action m Bool
forall a. String -> ReaderT MongoContext m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Action m Bool) -> String -> Action m Bool
forall a b. (a -> b) -> a -> b
$ String
"dropCollection failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Order -> String
forall a. Show a => a -> String
show Order
r

validateCollection :: (MonadIO m) => Collection -> Action m Document
-- ^ Validate the given collection, scanning the data and indexes for correctness. This operation takes a while.
validateCollection :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
validateCollection Database
coll = Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"validate" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
coll]

-- ** Index

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
(Int -> Index -> ShowS)
-> (Index -> String) -> ([Index] -> ShowS) -> Show Index
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Index -> ShowS
showsPrec :: Int -> Index -> ShowS
$cshow :: Index -> String
show :: Index -> String
$cshowList :: [Index] -> ShowS
showList :: [Index] -> ShowS
Show, Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
/= :: Index -> Index -> Bool
Eq)

idxDocument :: Index -> Database -> Document
idxDocument :: Index -> Database -> Order
idxDocument Index{Bool
Order
Maybe Int
Database
iColl :: Index -> Database
iKey :: Index -> Order
iName :: Index -> Database
iUnique :: Index -> Bool
iDropDups :: Index -> Bool
iExpireAfterSeconds :: Index -> Maybe Int
iColl :: Database
iKey :: Order
iName :: Database
iUnique :: Bool
iDropDups :: Bool
iExpireAfterSeconds :: Maybe Int
..} Database
db = [
    Database
"ns" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
db Database -> Database -> Database
<.> Database
iColl,
    Database
"key" Database -> Order -> Field
forall v. Val v => Database -> v -> Field
=: Order
iKey,
    Database
"name" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
iName,
    Database
"unique" Database -> Bool -> Field
forall v. Val v => Database -> v -> Field
=: Bool
iUnique,
    Database
"dropDups" Database -> Bool -> Field
forall v. Val v => Database -> v -> Field
=: Bool
iDropDups ] Order -> Order -> Order
forall a. [a] -> [a] -> [a]
++ (Maybe Field -> Order
forall a. Maybe a -> [a]
maybeToList (Maybe Field -> Order) -> Maybe Field -> Order
forall a b. (a -> b) -> a -> b
$ (Int -> Field) -> Maybe Int -> Maybe Field
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Database -> Int -> Field
forall v. Val v => Database -> v -> Field
(=:) Database
"expireAfterSeconds") Maybe Int
iExpireAfterSeconds)

index :: Collection -> Order -> Index
-- ^ Spec of index of ordered keys on collection. 'iName' is generated from keys. 'iUnique' and 'iDropDups' are @False@.
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 Maybe Int
forall a. Maybe a
Nothing

genName :: Order -> IndexName
genName :: Order -> Database
genName Order
keys = Database -> [Database] -> Database
T.intercalate Database
"_" ((Field -> Database) -> Order -> [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 (Value -> String
forall a. Show a => a -> String
show Value
v)

ensureIndex :: (MonadIO m) => Index -> Action m ()
-- ^ Create index if we did not already create one. May be called repeatedly with practically no performance hit, because we remember if we already called this for the same index (although this memory gets wiped out every 15 minutes, in case another client drops the index and we want to create it again).
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 <- Action m IndexCache
forall (m :: * -> *). MonadIO m => Action m IndexCache
fetchIndexCache
    Set (Database, Database)
set <- IO (Set (Database, Database))
-> ReaderT MongoContext m (Set (Database, Database))
forall a. IO a -> ReaderT MongoContext m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IndexCache -> IO (Set (Database, Database))
forall a. IORef a -> IO a
readIORef IndexCache
icache)
    Bool -> Action m () -> Action m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((Database, Database) -> Set (Database, Database) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member (Database, Database)
k Set (Database, Database)
set) (Action m () -> Action m ()) -> Action m () -> Action m ()
forall a b. (a -> b) -> a -> b
$ do
        AccessMode -> Action m () -> Action m ()
forall (m :: * -> *) a.
Monad m =>
AccessMode -> Action m a -> Action m a
accessMode AccessMode
master (Index -> Action m ()
forall (m :: * -> *). MonadIO m => Index -> Action m ()
createIndex Index
idx)
        IO () -> Action m ()
forall a. IO a -> ReaderT MongoContext m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Action m ()) -> IO () -> Action m ()
forall a b. (a -> b) -> a -> b
$ IndexCache -> Set (Database, Database) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IndexCache
icache ((Database, Database)
-> Set (Database, Database) -> Set (Database, Database)
forall a. Ord a => a -> Set a -> Set a
Set.insert (Database, Database)
k Set (Database, Database)
set)

createIndex :: (MonadIO m) => Index -> Action m ()
-- ^ Create index on the server. This call goes to the server every time.
createIndex :: forall (m :: * -> *). MonadIO m => Index -> Action m ()
createIndex Index
idx = Database -> Order -> Action m ()
forall (m :: * -> *). MonadIO m => Database -> Order -> Action m ()
insert_ Database
"system.indexes" (Order -> Action m ())
-> (Database -> Order) -> Database -> Action m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index -> Database -> Order
idxDocument Index
idx (Database -> Action m ())
-> ReaderT MongoContext m Database -> Action m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ReaderT MongoContext m Database
forall (m :: * -> *). Monad m => Action m Database
thisDatabase

dropIndex :: (MonadIO m) => Collection -> IndexName -> Action m Document
-- ^ Remove the index from the given collection.
dropIndex :: forall (m :: * -> *).
MonadIO m =>
Database -> Database -> Action m Order
dropIndex Database
coll Database
idxName = do
    Action m ()
forall (m :: * -> *). MonadIO m => Action m ()
resetIndexCache
    Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"deleteIndexes" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
coll, Database
"index" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
idxName]

getIndexes :: MonadIO m => Collection -> Action m [Document]
-- ^ Get all indexes on this collection
getIndexes :: forall (m :: * -> *). MonadIO m => Database -> Action m [Order]
getIndexes Database
coll = do
    Database
db <- Action m Database
forall (m :: * -> *). Monad m => Action m Database
thisDatabase
    Cursor -> Action m [Order]
forall (m :: * -> *). MonadIO m => Cursor -> Action m [Order]
rest (Cursor -> Action m [Order])
-> ReaderT MongoContext m Cursor -> Action m [Order]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Query -> ReaderT MongoContext m Cursor
forall (m :: * -> *). MonadIO m => Query -> Action m Cursor
find (Order -> Database -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [Database
"ns" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
db Database -> Database -> Database
<.> Database
coll] Database
"system.indexes")

dropIndexes :: (MonadIO m) => Collection -> Action m Document
-- ^ Drop all indexes on this collection
dropIndexes :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
dropIndexes Database
coll = do
    Action m ()
forall (m :: * -> *). MonadIO m => Action m ()
resetIndexCache
    Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"deleteIndexes" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
coll, Database
"index" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: (Database
"*" :: Text)]

-- *** Index cache

type DbIndexCache = H.BasicHashTable Database IndexCache
-- ^ Cache the indexes we create so repeatedly calling ensureIndex only hits database the first time. Clear cache every once in a while so if someone else deletes index we will recreate it on ensureIndex.

type IndexCache = IORef (Set (Collection, IndexName))

dbIndexCache :: DbIndexCache
-- ^ initialize cache and fork thread that clears it every 15 minutes
dbIndexCache :: DbIndexCache
dbIndexCache = IO DbIndexCache -> DbIndexCache
forall a. IO a -> a
unsafePerformIO (IO DbIndexCache -> DbIndexCache)
-> IO DbIndexCache -> DbIndexCache
forall a b. (a -> b) -> a -> b
$ do
    HashTable RealWorld Database IndexCache
table <- IO (HashTable RealWorld Database IndexCache)
IO DbIndexCache
forall (h :: * -> * -> * -> *) k v.
HashTable h =>
IO (IOHashTable h k v)
H.new
    ThreadId
_ <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> (IO () -> IO ()) -> IO () -> IO ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
900000000 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
clearDbIndexCache
    HashTable RealWorld Database IndexCache
-> IO (HashTable RealWorld Database IndexCache)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HashTable RealWorld Database IndexCache
table
{-# NOINLINE dbIndexCache #-}

clearDbIndexCache :: IO ()
clearDbIndexCache :: IO ()
clearDbIndexCache = do
    [Database]
keys <- ((Database, IndexCache) -> Database)
-> [(Database, IndexCache)] -> [Database]
forall a b. (a -> b) -> [a] -> [b]
map (Database, IndexCache) -> Database
forall a b. (a, b) -> a
fst ([(Database, IndexCache)] -> [Database])
-> IO [(Database, IndexCache)] -> IO [Database]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DbIndexCache -> IO [(Database, IndexCache)]
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> IO [(k, v)]
H.toList DbIndexCache
dbIndexCache
    (Database -> IO ()) -> [Database] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (DbIndexCache -> Database -> IO ()
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
-- ^ Get index cache for current database
fetchIndexCache :: forall (m :: * -> *). MonadIO m => Action m IndexCache
fetchIndexCache = do
    Database
db <- Action m Database
forall (m :: * -> *). Monad m => Action m Database
thisDatabase
    IO IndexCache -> Action m IndexCache
forall a. IO a -> ReaderT MongoContext m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IndexCache -> Action m IndexCache)
-> IO IndexCache -> Action m IndexCache
forall a b. (a -> b) -> a -> b
$ do
        Maybe IndexCache
mc <- DbIndexCache -> Database -> IO (Maybe IndexCache)
forall (h :: * -> * -> * -> *) k v.
(HashTable h, Eq k, Hashable k) =>
IOHashTable h k v -> k -> IO (Maybe v)
H.lookup DbIndexCache
dbIndexCache Database
db
        IO IndexCache
-> (IndexCache -> IO IndexCache)
-> Maybe IndexCache
-> IO IndexCache
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Database -> IO IndexCache
newIdxCache Database
db) IndexCache -> IO IndexCache
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe IndexCache
mc
 where
    newIdxCache :: Database -> IO IndexCache
newIdxCache Database
db = do
        IndexCache
idx <- Set (Database, Database) -> IO IndexCache
forall a. a -> IO (IORef a)
newIORef Set (Database, Database)
forall a. Set a
Set.empty
        DbIndexCache -> Database -> IndexCache -> IO ()
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
        IndexCache -> IO IndexCache
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IndexCache
idx

resetIndexCache :: (MonadIO m) => Action m ()
-- ^ reset index cache for current database
resetIndexCache :: forall (m :: * -> *). MonadIO m => Action m ()
resetIndexCache = do
    IndexCache
icache <- Action m IndexCache
forall (m :: * -> *). MonadIO m => Action m IndexCache
fetchIndexCache
    IO () -> Action m ()
forall a. IO a -> ReaderT MongoContext m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IndexCache -> Set (Database, Database) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IndexCache
icache Set (Database, Database)
forall a. Set a
Set.empty)

-- ** User

allUsers :: MonadIO m => Action m [Document]
-- ^ Fetch all users of this database
allUsers :: forall (m :: * -> *). MonadIO m => Action m [Order]
allUsers = (Order -> Order) -> [Order] -> [Order]
forall a b. (a -> b) -> [a] -> [b]
map ([Database] -> Order -> Order
exclude [Database
"_id"]) ([Order] -> [Order])
-> ReaderT MongoContext m [Order] -> ReaderT MongoContext m [Order]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` (Cursor -> ReaderT MongoContext m [Order]
forall (m :: * -> *). MonadIO m => Cursor -> Action m [Order]
rest (Cursor -> ReaderT MongoContext m [Order])
-> ReaderT MongoContext m Cursor -> ReaderT MongoContext m [Order]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Query -> ReaderT MongoContext m Cursor
forall (m :: * -> *). MonadIO m => Query -> Action m Cursor
find
    (Order -> Database -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [] Database
"system.users") {sort = ["user" =: (1 :: Int)], project = ["user" =: (1 :: Int), "readOnly" =: (1 :: Int)]})

addUser :: (MonadIO m)
        => Bool -> Username -> Password -> Action m ()
-- ^ Add user with password with read-only access if the boolean argument is @True@, or read-write access if it's @False@
addUser :: forall (m :: * -> *).
MonadIO m =>
Bool -> Database -> Database -> Action m ()
addUser Bool
readOnly Database
user Database
pass = do
    Maybe Order
mu <- Query -> Action m (Maybe Order)
forall (m :: * -> *). MonadIO m => Query -> Action m (Maybe Order)
findOne (Order -> Database -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [Database
"user" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
user] Database
"system.users")
    let usr :: Order
usr = Order -> Order -> Order
merge [Database
"readOnly" Database -> Bool -> Field
forall v. Val v => Database -> v -> Field
=: Bool
readOnly, Database
"pwd" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database -> Database -> Database
pwHash Database
user Database
pass] (Order -> (Order -> Order) -> Maybe Order -> Order
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Database
"user" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
user] Order -> Order
forall a. a -> a
id Maybe Order
mu)
    Database -> Order -> Action m ()
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 = Selection -> Action m ()
forall (m :: * -> *). MonadIO m => Selection -> Action m ()
delete (Order -> Database -> Selection
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [Database
"user" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
user] Database
"system.users")

-- ** Database

admin :: Database
-- ^ The \"admin\" database, which stores user authorization and authentication data plus other system collections.
admin :: Database
admin = Database
"admin"

cloneDatabase :: (MonadIO m) => Database -> Host -> Action m Document
-- ^ Copy database from given host to the server I am connected to. Fails and returns @"ok" = 0@ if we don't have permission to read from given server (use 'copyDatabase' in this case).
cloneDatabase :: forall (m :: * -> *).
MonadIO m =>
Database -> Host -> Action m Order
cloneDatabase Database
db Host
fromHost = Database -> Action m Order -> Action m Order
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
db (Action m Order -> Action m Order)
-> Action m Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"clone" Database -> String -> Field
forall v. Val v => Database -> v -> Field
=: Host -> String
showHostPort Host
fromHost]

copyDatabase :: (MonadIO m) => Database -> Host -> Maybe (Username, Password) -> Database -> Action m Document
-- ^ Copy database from given host to the server I am connected to. If username & password is supplied use them to read from given host.
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" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int), Database
"fromhost" Database -> String -> Field
forall v. Val v => Database -> v -> Field
=: Host -> String
showHostPort Host
fromHost, Database
"fromdb" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
fromDb, Database
"todb" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
toDb]
    Database -> Action m Order -> Action m Order
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
admin (Action m Order -> Action m Order)
-> Action m Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ case Maybe (Database, Database)
mup of
        Maybe (Database, Database)
Nothing -> Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand Order
c
        Just (Database
usr, Database
pss) -> do
            Database
n <- Database -> Order -> Database
forall v. Val v => Database -> Order -> v
at Database
"nonce" (Order -> Database)
-> Action m Order -> ReaderT MongoContext m Database
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"copydbgetnonce" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int), Database
"fromhost" Database -> String -> Field
forall v. Val v => Database -> v -> Field
=: Host -> String
showHostPort Host
fromHost]
            Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand (Order -> Action m Order) -> Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ Order
c Order -> Order -> Order
forall a. [a] -> [a] -> [a]
++ [Database
"username" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
usr, Database
"nonce" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
n, Database
"key" Database -> Database -> Field
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
-- ^ Delete the given database!
dropDatabase :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
dropDatabase Database
db = Database -> Action m Order -> Action m Order
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
db (Action m Order -> Action m Order)
-> Action m Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"dropDatabase" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]

repairDatabase :: (MonadIO m) => Database -> Action m Document
-- ^ Attempt to fix any corrupt records. This operation takes a while.
repairDatabase :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
repairDatabase Database
db = Database -> Action m Order -> Action m Order
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
db (Action m Order -> Action m Order)
-> Action m Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"repairDatabase" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]

-- ** Server

serverBuildInfo :: (MonadIO m) => Action m Document
-- ^ Return a document containing the parameters used to compile the server instance.
serverBuildInfo :: forall (m :: * -> *). MonadIO m => Action m Order
serverBuildInfo = Database -> Action m Order -> Action m Order
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
admin (Action m Order -> Action m Order)
-> Action m Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"buildinfo" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]

serverVersion :: (MonadIO m) => Action m Text
-- ^ Return the version of the server instance.
serverVersion :: forall (m :: * -> *). MonadIO m => Action m Database
serverVersion = Database -> Order -> Database
forall v. Val v => Database -> Order -> v
at Database
"version" (Order -> Database)
-> ReaderT MongoContext m Order -> ReaderT MongoContext m Database
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` ReaderT MongoContext m Order
forall (m :: * -> *). MonadIO m => Action m Order
serverBuildInfo

-- * Diagnostics

-- ** Collection

collectionStats :: (MonadIO m) => Collection -> Action m Document
-- ^ Return some storage statistics for the given collection.
collectionStats :: forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats Database
coll = Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"collstats" Database -> Database -> Field
forall v. Val v => Database -> v -> Field
=: Database
coll]

dataSize :: (MonadIO m) => Collection -> Action m Int
-- ^ Return the total uncompressed size (in bytes) in memory of all records in the given collection. Does not include indexes.
dataSize :: forall (m :: * -> *). MonadIO m => Database -> Action m Int
dataSize Database
c = Database -> Order -> Int
forall v. Val v => Database -> Order -> v
at Database
"size" (Order -> Int)
-> ReaderT MongoContext m Order -> ReaderT MongoContext m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Database -> ReaderT MongoContext m Order
forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats Database
c

storageSize :: (MonadIO m) => Collection -> Action m Int
-- ^ Return the total bytes allocated to the given collection. Does not include indexes.
storageSize :: forall (m :: * -> *). MonadIO m => Database -> Action m Int
storageSize Database
c = Database -> Order -> Int
forall v. Val v => Database -> Order -> v
at Database
"storageSize" (Order -> Int)
-> ReaderT MongoContext m Order -> ReaderT MongoContext m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Database -> ReaderT MongoContext m Order
forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats Database
c

totalIndexSize :: (MonadIO m) => Collection -> Action m Int
-- ^ The total size in bytes of all indexes in this collection.
totalIndexSize :: forall (m :: * -> *). MonadIO m => Database -> Action m Int
totalIndexSize Database
c = Database -> Order -> Int
forall v. Val v => Database -> Order -> v
at Database
"totalIndexSize" (Order -> Int)
-> ReaderT MongoContext m Order -> ReaderT MongoContext m Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Database -> ReaderT MongoContext m Order
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 <- Database -> Action m Int
forall (m :: * -> *). MonadIO m => Database -> Action m Int
storageSize Database
coll
    [Int]
xs <- (Order -> Action m Int) -> [Order] -> ReaderT MongoContext m [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Order -> Action m Int
forall {m :: * -> *} {r}.
(Val r, MonadIO m) =>
Order -> ReaderT MongoContext m r
isize ([Order] -> ReaderT MongoContext m [Int])
-> ReaderT MongoContext m [Order] -> ReaderT MongoContext m [Int]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Database -> ReaderT MongoContext m [Order]
forall (m :: * -> *). MonadIO m => Database -> Action m [Order]
getIndexes Database
coll
    Int -> Action m Int
forall a. a -> ReaderT MongoContext m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
x [Int]
xs)
 where
    isize :: Order -> ReaderT MongoContext m r
isize Order
idx = Database -> Order -> r
forall v. Val v => Database -> Order -> v
at Database
"storageSize" (Order -> r)
-> ReaderT MongoContext m Order -> ReaderT MongoContext m r
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Database -> ReaderT MongoContext m Order
forall (m :: * -> *). MonadIO m => Database -> Action m Order
collectionStats (Database
coll Database -> Database -> Database
`T.append` Database
".$" Database -> Database -> Database
`T.append` Database -> Order -> Database
forall v. Val v => Database -> Order -> v
at Database
"name" Order
idx)

-- ** Profiling

-- | The available profiler levels.
data ProfilingLevel
    = Off -- ^ No data collection.
    | Slow -- ^ Data collected only for slow operations. The slow operation time threshold is 100ms by default, but can be changed using 'setProfilingLevel'.
    | All -- ^ Data collected for all operations.
    deriving (Int -> ProfilingLevel -> ShowS
[ProfilingLevel] -> ShowS
ProfilingLevel -> String
(Int -> ProfilingLevel -> ShowS)
-> (ProfilingLevel -> String)
-> ([ProfilingLevel] -> ShowS)
-> Show ProfilingLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProfilingLevel -> ShowS
showsPrec :: Int -> ProfilingLevel -> ShowS
$cshow :: ProfilingLevel -> String
show :: ProfilingLevel -> String
$cshowList :: [ProfilingLevel] -> ShowS
showList :: [ProfilingLevel] -> ShowS
Show, Int -> ProfilingLevel
ProfilingLevel -> Int
ProfilingLevel -> [ProfilingLevel]
ProfilingLevel -> ProfilingLevel
ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
ProfilingLevel
-> ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
(ProfilingLevel -> ProfilingLevel)
-> (ProfilingLevel -> ProfilingLevel)
-> (Int -> ProfilingLevel)
-> (ProfilingLevel -> Int)
-> (ProfilingLevel -> [ProfilingLevel])
-> (ProfilingLevel -> ProfilingLevel -> [ProfilingLevel])
-> (ProfilingLevel -> ProfilingLevel -> [ProfilingLevel])
-> (ProfilingLevel
    -> ProfilingLevel -> ProfilingLevel -> [ProfilingLevel])
-> Enum 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
$csucc :: ProfilingLevel -> ProfilingLevel
succ :: ProfilingLevel -> ProfilingLevel
$cpred :: ProfilingLevel -> ProfilingLevel
pred :: ProfilingLevel -> ProfilingLevel
$ctoEnum :: Int -> ProfilingLevel
toEnum :: Int -> ProfilingLevel
$cfromEnum :: ProfilingLevel -> Int
fromEnum :: ProfilingLevel -> Int
$cenumFrom :: ProfilingLevel -> [ProfilingLevel]
enumFrom :: ProfilingLevel -> [ProfilingLevel]
$cenumFromThen :: ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
enumFromThen :: ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
$cenumFromTo :: ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
enumFromTo :: ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
$cenumFromThenTo :: ProfilingLevel
-> ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
enumFromThenTo :: ProfilingLevel
-> ProfilingLevel -> ProfilingLevel -> [ProfilingLevel]
Enum, ProfilingLevel -> ProfilingLevel -> Bool
(ProfilingLevel -> ProfilingLevel -> Bool)
-> (ProfilingLevel -> ProfilingLevel -> Bool) -> Eq ProfilingLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProfilingLevel -> ProfilingLevel -> Bool
== :: ProfilingLevel -> ProfilingLevel -> Bool
$c/= :: ProfilingLevel -> ProfilingLevel -> Bool
/= :: ProfilingLevel -> ProfilingLevel -> Bool
Eq)

getProfilingLevel :: (MonadIO m) => Action m ProfilingLevel
-- ^ Get the profiler level.
getProfilingLevel :: forall (m :: * -> *). MonadIO m => Action m ProfilingLevel
getProfilingLevel = (Int -> ProfilingLevel
forall a. Enum a => Int -> a
toEnum (Int -> ProfilingLevel)
-> (Order -> Int) -> Order -> ProfilingLevel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Database -> Order -> Int
forall v. Val v => Database -> Order -> v
at Database
"was") (Order -> ProfilingLevel)
-> ReaderT MongoContext m Order
-> ReaderT MongoContext m ProfilingLevel
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` Order -> ReaderT MongoContext m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"profile" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: (-Int
1 :: Int)]

type MilliSec = Int

setProfilingLevel :: (MonadIO m) => ProfilingLevel -> Maybe MilliSec -> Action m ()
-- ^ Set the profiler level, and optionally the slow operation time threshold (in milliseconds).
setProfilingLevel :: forall (m :: * -> *).
MonadIO m =>
ProfilingLevel -> Maybe Int -> Action m ()
setProfilingLevel ProfilingLevel
p Maybe Int
mSlowMs =
    Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand ([Database
"profile" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: ProfilingLevel -> Int
forall a. Enum a => a -> Int
fromEnum ProfilingLevel
p] Order -> Order -> Order
forall a. [a] -> [a] -> [a]
++ (Database
"slowms" Database -> Maybe Int -> Order
forall a. Val a => Database -> Maybe a -> Order
=? Maybe Int
mSlowMs)) Action m Order
-> ReaderT MongoContext m () -> ReaderT MongoContext m ()
forall a b.
ReaderT MongoContext m a
-> ReaderT MongoContext m b -> ReaderT MongoContext m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ReaderT MongoContext m ()
forall a. a -> ReaderT MongoContext m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- ** Database

dbStats :: (MonadIO m) => Action m Document
-- ^ Return some storage statistics for the given database.
dbStats :: forall (m :: * -> *). MonadIO m => Action m Order
dbStats = Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"dbstats" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]

currentOp :: (MonadIO m) => Action m (Maybe Document)
-- ^ See currently running operation on the database, if any
currentOp :: forall (m :: * -> *). MonadIO m => Action m (Maybe Order)
currentOp = Query -> Action m (Maybe Order)
forall (m :: * -> *). MonadIO m => Query -> Action m (Maybe Order)
findOne (Order -> Database -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [] Database
"$cmd.sys.inprog")

-- | An operation indentifier.
type OpNum = Int

killOp :: (MonadIO m) => OpNum -> Action m (Maybe Document)
-- ^ Terminate the operation specified by the given 'OpNum'.
killOp :: forall (m :: * -> *). MonadIO m => Int -> Action m (Maybe Order)
killOp Int
op = Query -> Action m (Maybe Order)
forall (m :: * -> *). MonadIO m => Query -> Action m (Maybe Order)
findOne (Order -> Database -> Query
forall aQueryOrSelection.
Select aQueryOrSelection =>
Order -> Database -> aQueryOrSelection
select [Database
"op" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: Int
op] Database
"$cmd.sys.killop")

-- ** Server

serverStatus :: (MonadIO m) => Action m Document
-- ^ Return a document with an overview of the state of the database.
serverStatus :: forall (m :: * -> *). MonadIO m => Action m Order
serverStatus = Database -> Action m Order -> Action m Order
forall (m :: * -> *) a.
Monad m =>
Database -> Action m a -> Action m a
useDb Database
admin (Action m Order -> Action m Order)
-> Action m Order -> Action m Order
forall a b. (a -> b) -> a -> b
$ Order -> Action m Order
forall (m :: * -> *). MonadIO m => Order -> Action m Order
runCommand [Database
"serverStatus" Database -> Int -> Field
forall v. Val v => Database -> v -> Field
=: (Int
1 :: Int)]


{- Authors: Tony Hannan <tony@10gen.com>
   Copyright 2011 10gen Inc.
   Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at: http://www.apache.org/licenses/LICENSE-2.0. Unless required by applicable law or agreed to in writing, software distributed under the License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the License for the specific language governing permissions and limitations under the License. -}