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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Sproxy.Server.DB (
Database
, DataSource(..)
, userExists
, userGroups
, start
) where
import Control.Concurrent (forkIO, threadDelay)
import Control.Exception (SomeException, bracket, catch, finally)
import Control.Monad (forever, void)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 (pack)
import Data.Pool (Pool, createPool, withResource)
import Data.Text (Text, toLower, unpack)
import Data.Text.Encoding (encodeUtf8)
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 qualified Sproxy.Logging as Log
type Database = Pool SQLite.Connection
data DataSource = PostgreSQL String -- | File FilePath
{- TODO:
- Hash remote tables and update the local only when the remote change
- Switch to REGEX
- Generalize sync procedures for different tables
-}
start :: FilePath -> Maybe DataSource -> IO Database
start home ds = do
Log.info $ "home directory: " ++ show home
db <- createPool
(do c <- SQLite.open $ home ++ "/sproxy.sqlite3"
lvl <- Log.level
SQLite.setTrace c (if lvl == Log.Debug then Just $ Log.debug . unpack else Nothing)
return c)
SQLite.close
1 -- stripes
3600 -- keep alive (seconds). FIXME: no much sense as it's a local file
128 -- max connections. FIXME: make configurable?
withResource db $ \c -> SQLite.execute_ c "PRAGMA journal_mode=WAL"
populate db ds
return db
userExists :: Database -> String -> IO Bool
userExists db email = do
r <- withResource db $ \c -> fmap SQLite.fromOnly <$> SQLite.queryNamed c
"SELECT EXISTS (SELECT 1 FROM group_member WHERE :email LIKE email LIMIT 1)"
[ ":email" := email ]
return $ head r
userGroups :: Database -> String -> Text -> Text -> Text -> IO [ByteString]
userGroups db email domain path method =
withResource db $ \c -> fmap (encodeUtf8 . SQLite.fromOnly) <$> SQLite.queryNamed c [q|
SELECT gm."group" FROM group_privilege gp JOIN group_member gm ON gm."group" = gp."group"
WHERE :email LIKE gm.email
AND :domain LIKE gp.domain
AND gp.privilege IN (
SELECT privilege FROM privilege_rule
WHERE :domain LIKE domain
AND :path LIKE path
AND method = :method
ORDER BY length(path) - length(replace(path, '/', '')) DESC LIMIT 1
)
|] [ ":email" := email -- XXX always in lower case
, ":domain" := toLower domain
, ":path" := path
, ":method" := method -- XXX case-sensitive by RFC2616
]
populate :: Database -> Maybe DataSource -> IO ()
populate db Nothing = do
Log.warn "db: no data source defined"
withResource db $ \c -> SQLite.withTransaction c $ do
createGroupMember c
createGroupPrivilege c
createPrivilegeRule c
-- 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.
populate db (Just (PostgreSQL connstr)) =
void . forkIO . forever . flip finally (7 `minutes` threadDelay)
. logException $ do
Log.info $ "db: synchronizing with " ++ show connstr
withResource db $ \c -> SQLite.withTransaction c $
bracket (PG.connectPostgreSQL $ pack connstr) PG.close $
\pg -> PG.withTransaction pg $ do
Log.info "db: syncing group_member"
dropGroupMember c
createGroupMember c
PG.forEach_ pg
[q|SELECT "group", lower(email) FROM group_member|] $ \r ->
SQLite.execute c
[q|INSERT INTO group_member("group", email) VALUES (?, ?)|]
(r :: (Text, Text))
count c "group_member"
Log.info "db: syncing group_privilege"
dropGroupPrivilege c
createGroupPrivilege c
PG.forEach_ pg
[q|SELECT "group", lower(domain), privilege FROM group_privilege|] $ \r ->
SQLite.execute c
[q|INSERT INTO group_privilege("group", domain, privilege) VALUES (?, ?, ?)|]
(r :: (Text, Text, Text))
count c "group_privilege"
Log.info "db: syncing privilege_rule"
dropPrivilegeRule c
createPrivilegeRule c
PG.forEach_ pg
[q|SELECT lower(domain), privilege, path, method FROM privilege_rule|] $ \r ->
SQLite.execute c
[q|INSERT INTO privilege_rule(domain, privilege, path, method) VALUES (?, ?, ?, ?)|]
(r :: (Text, Text, Text, Text))
count c "privilege_rule"
dropGroupMember :: SQLite.Connection -> IO ()
dropGroupMember c = SQLite.execute_ c "DROP TABLE IF EXISTS group_member"
createGroupMember :: SQLite.Connection -> IO ()
createGroupMember c = SQLite.execute_ c [q|
CREATE TABLE IF NOT EXISTS group_member (
"group" TEXT,
email TEXT,
PRIMARY KEY ("group", email)
)
|]
dropGroupPrivilege :: SQLite.Connection -> IO ()
dropGroupPrivilege c = SQLite.execute_ c "DROP TABLE IF EXISTS group_privilege"
createGroupPrivilege :: SQLite.Connection -> IO ()
createGroupPrivilege c = SQLite.execute_ c [q|
CREATE TABLE IF NOT EXISTS group_privilege (
"group" TEXT,
domain TEXT,
privilege TEXT,
PRIMARY KEY ("group", domain, privilege)
)
|]
dropPrivilegeRule :: SQLite.Connection -> IO ()
dropPrivilegeRule c = SQLite.execute_ c "DROP TABLE IF EXISTS privilege_rule"
createPrivilegeRule :: SQLite.Connection -> IO ()
createPrivilegeRule c = SQLite.execute_ c [q|
CREATE TABLE IF NOT EXISTS privilege_rule (
domain TEXT,
privilege TEXT,
path TEXT,
method TEXT,
PRIMARY KEY (domain, path, method)
)
|]
count :: SQLite.Connection -> String -> IO ()
count c table = do
r <- fmap SQLite.fromOnly <$> SQLite.query_ c [qc|SELECT COUNT(*) FROM {table}|]
Log.info $ "db: " ++ table ++ " rows: " ++ show (head r :: Integer)
logException :: IO () -> IO ()
logException a = catch a $ \e ->
Log.error $ "db: " ++ show (e :: SomeException)
minutes :: Int -> (Int -> IO ()) -> IO ()
minutes us f = f $ us * 60 * 1000000
|
