1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
{-
DB.hs: abstraction of HaskellDB interface to ShareGuard database
Copyright (C) 2011 Clint Adams <clint@gnu.org>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as
published by the Free Software Foundation, either version 3 of the
License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
-}
module DB (
withDB,
getUserPw,
getUserDirs,
getOwnership,
-- insertUserPw,
-- insertUserDir,
-- insertOwnership
) where
import Database.HaskellDB.HDBC.SQLite3
import Database.HaskellDB
import Config as C
import qualified ShareGuardDB
import qualified ShareGuardDB.User as U
import qualified ShareGuardDB.Directory_user as F
import qualified ShareGuardDB.Directory as O
import Control.Monad.Trans
withDB :: MonadIO m => C.Config -> (Database -> m a) -> m a
withDB x = sqliteConnect (C.database x)
getUserPw :: Database -> IO [(String,String)]
getUserPw db = do
let q = do
u <- table U.user
r <- project (U.username << u!U.username # U.password << u!U.password)
return r
rs <- query db q
return $ map (\r -> (r!U.username,r!U.password)) rs
getUserDirs :: Database -> IO [(String,String)]
getUserDirs db = do
let q = do
f <- table F.directory_user
u <- table U.user
d <- table O.directory
restrict (f!F.user_id .==. u!U.xid .&&. f!F.directory_id .==. d!O.xid)
r <- project (U.username << u!U.username # O.name << d!O.name)
return r
rs <- query db q
return $ map (\r -> (r!U.username,r!O.name)) rs
getOwnership :: Database -> IO [(String,String)]
getOwnership db = do
let q = do
d <- table O.directory
u <- table U.user
restrict (d!O.owner_id .==. u!U.xid)
r <- project (O.name << d!O.name # U.username << u!U.username)
return r
rs <- query db q
return $ map (\r -> (r!O.name,r!U.username)) rs
{-
insertUserPw :: Database -> (String,String) -> IO ()
insertUserPw db (u,p) = insert db U.users (U.user <<- u # U.password <<- p)
insertUserDir :: Database -> (String,String) -> IO ()
insertUserDir db (u,d) = insert db F.fuckedAuth (F.user <<- u # F.directory <<- d)
insertOwnership :: Database -> (String,String) -> IO ()
insertOwnership db (d,o) = insert db O.ownership (O.directory <<- d # O.owner <<- o)
-}
|
