{-# 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
(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
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
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
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
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]
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
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 ()
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 ()
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
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]
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
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)]
type DbIndexCache = H.BasicHashTable Database IndexCache
type IndexCache = IORef (Set (Collection, IndexName))
dbIndexCache :: DbIndexCache
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
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 ()
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)
allUsers :: MonadIO m => Action m [Document]
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 ()
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")
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 = 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
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
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
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)]
serverBuildInfo :: (MonadIO m) => Action m Document
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
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
collectionStats :: (MonadIO m) => Collection -> Action m Document
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
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
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
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)
data ProfilingLevel
= Off
| Slow
| All
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
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 ()
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 ()
dbStats :: (MonadIO m) => Action m Document
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)
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")
type OpNum = Int
killOp :: (MonadIO m) => OpNum -> Action m (Maybe Document)
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")
serverStatus :: (MonadIO m) => Action m Document
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)]