1 files changed, 86 insertions, 0 deletions
diff --git a/DB.hs b/DB.hs
new file mode 100644
index 0000000..d58af62
--- /dev/null
+++ b/DB.hs
@@ -0,0 +1,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)
+-}