From be9b6f68a60bec0cda4b905e9311a9076f778976 Mon Sep 17 00:00:00 2001
From: Igor Pashev <pashev.igor@gmail.com>
Date: Sat, 26 Nov 2016 21:41:59 +0300
Subject: Populate permission database from a file

---
 src/Sproxy/Server/DB.hs          | 46 +++++++++++++++++++++++++--
 src/Sproxy/Server/DB/DataFile.hs | 69 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 113 insertions(+), 2 deletions(-)
 create mode 100644 src/Sproxy/Server/DB/DataFile.hs

(limited to 'src/Sproxy/Server')

diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs
index 90e2abd..2823ba0 100644
--- a/src/Sproxy/Server/DB.hs
+++ b/src/Sproxy/Server/DB.hs
@@ -14,17 +14,20 @@ import Control.Monad (forever, void)
 import Data.ByteString.Char8 (pack)
 import Data.Pool (Pool, createPool, withResource)
 import Data.Text (Text, toLower, unpack)
+import Data.Yaml (decodeFileEither)
 import Database.SQLite.Simple (NamedParam((:=)))
 import Text.InterpolatedString.Perl6 (q, qc)
 import qualified Database.PostgreSQL.Simple as PG
 import qualified Database.SQLite.Simple as SQLite
 
+import Sproxy.Server.DB.DataFile ( DataFile(..), GroupMember(..),
+  GroupPrivilege(..), PrivilegeRule(..) )
 import qualified Sproxy.Logging as Log
 
 
 type Database = Pool SQLite.Connection
 
-data DataSource = PostgreSQL String -- | File FilePath
+data DataSource = PostgreSQL String | File FilePath
 
 {- TODO:
  - Hash remote tables and update the local only when the remote change
@@ -77,6 +80,12 @@ userGroups db email domain path method =
      , ":method" := method -- XXX case-sensitive by RFC2616
      ]
 
+-- FIXME short-cut for https://github.com/nurpax/sqlite-simple/issues/50
+-- FIXME nextRow is the only way to execute a prepared statement
+-- FIXME with bound parameters, but we don't expect any results.
+submit :: SQLite.Statement -> IO ()
+submit st = void (SQLite.nextRow st :: IO (Maybe [Int]))
+
 
 populate :: Database -> Maybe DataSource -> IO ()
 
@@ -87,6 +96,40 @@ populate db Nothing = do
     createGroupPrivilege c
     createPrivilegeRule c
 
+populate db (Just (File f)) = do
+  Log.info $ "db: reading " ++ show f
+  r <- decodeFileEither f
+  case r of
+    Left e   -> Log.error $ f ++ ": " ++ show e
+    Right df ->
+      withResource db $ \c -> SQLite.withTransaction c $ do
+        dropGroupMember c
+        createGroupMember c
+        SQLite.withStatement c
+          [q|INSERT INTO group_member("group", email) VALUES (?, ?)|]
+            $ \st -> mapM_ (\gm -> SQLite.withBind st
+                                  (gmGroup gm, toLower $ gmEmail gm)
+                                  (submit st)
+                          ) (groupMember df)
+
+        dropGroupPrivilege c
+        createGroupPrivilege c
+        SQLite.withStatement c
+          [q|INSERT INTO group_privilege("group", domain, privilege) VALUES (?, ?, ?)|]
+            $ \st -> mapM_ (\gp -> SQLite.withBind st
+                                  (gpGroup gp, toLower $ gpDomain gp, gpPrivilege gp)
+                                  (submit st)
+                          ) (groupPrivilege df)
+
+        dropPrivilegeRule c
+        createPrivilegeRule c
+        SQLite.withStatement c
+          [q|INSERT INTO privilege_rule(domain, privilege, path, method) VALUES (?, ?, ?, ?)|]
+            $ \st -> mapM_ (\pr -> SQLite.withBind st
+                                  (toLower $ prDomain pr, prPrivilege pr, prPath pr, prMethod pr)
+                                  (submit st)
+                          ) (privilegeRule df)
+
 -- XXX We keep only required minimum of the data, without any integrity check.
 -- XXX Integrity check should be done somewhere else, e. g. in the master PostgreSQL database,
 -- XXX or during importing the config file.
@@ -155,7 +198,6 @@ createGroupPrivilege c = SQLite.execute_ c [q|
   )
 |]
 
-
 dropPrivilegeRule :: SQLite.Connection -> IO ()
 dropPrivilegeRule c = SQLite.execute_ c "DROP TABLE IF EXISTS privilege_rule"
 
diff --git a/src/Sproxy/Server/DB/DataFile.hs b/src/Sproxy/Server/DB/DataFile.hs
new file mode 100644
index 0000000..efac923
--- /dev/null
+++ b/src/Sproxy/Server/DB/DataFile.hs
@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Sproxy.Server.DB.DataFile (
+  DataFile(..)
+, GroupMember(..)
+, GroupPrivilege(..)
+, PrivilegeRule(..)
+) where
+
+import Control.Applicative (empty)
+import Data.Aeson (FromJSON, parseJSON)
+import Data.Text (Text)
+import Data.Yaml (Value(Object), (.:))
+
+
+data DataFile = DataFile {
+  groupMember    :: [GroupMember]
+, groupPrivilege :: [GroupPrivilege]
+, privilegeRule  :: [PrivilegeRule]
+} deriving (Show)
+
+instance FromJSON DataFile where
+  parseJSON (Object m) = DataFile <$>
+        m .: "group_member"
+    <*> m .: "group_privilege"
+    <*> m .: "privilege_rule"
+  parseJSON _ = empty
+
+
+data GroupMember = GroupMember {
+  gmGroup :: Text
+, gmEmail :: Text
+} deriving (Show)
+
+instance FromJSON GroupMember where
+  parseJSON (Object m) = GroupMember <$>
+        m .: "group"
+    <*> m .: "email"
+  parseJSON _ = empty
+
+
+data GroupPrivilege = GroupPrivilege {
+  gpGroup     :: Text
+, gpDomain    :: Text
+, gpPrivilege :: Text
+} deriving (Show)
+
+instance FromJSON GroupPrivilege where
+  parseJSON (Object m) = GroupPrivilege <$>
+        m .: "group"
+    <*> m .: "domain"
+    <*> m .: "privilege"
+  parseJSON _ = empty
+
+
+data PrivilegeRule = PrivilegeRule {
+  prDomain    :: Text
+, prPrivilege :: Text
+, prPath      :: Text
+, prMethod    :: Text
+} deriving (Show)
+
+instance FromJSON PrivilegeRule where
+  parseJSON (Object m) = PrivilegeRule <$>
+        m .: "domain"
+    <*> m .: "privilege"
+    <*> m .: "path"
+    <*> m .: "method"
+  parseJSON _ = empty
+
-- 
cgit v1.2.3