Format with hindent

1 files changed, 117 insertions, 96 deletions

diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs
index 662a9c7..be44f69 100644
--- a/src/Sproxy/Server/DB.hs
+++ b/src/Sproxy/Server/DB.hs
@@ -1,72 +1,83 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
-module Sproxy.Server.DB (
-  Database
-, DataSource(..)
-, userAccess
-, userExists
-, userGroups
-, start
-) where
+
+module Sproxy.Server.DB
+  ( Database
+  , DataSource(..)
+  , userAccess
+  , userExists
+  , userGroups
+  , start
+  ) where
 
 import Control.Concurrent (forkIO, threadDelay)
 import Control.Exception (SomeException, bracket, catch, finally)
 import Control.Monad (filterM, forever, void)
 import Data.ByteString.Char8 (pack)
+import qualified Data.HashMap.Strict as HM
 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 Data.HashMap.Strict as HM
 import qualified Database.PostgreSQL.Simple as PG
+import Database.SQLite.Simple (NamedParam((:=)))
 import qualified Database.SQLite.Simple as SQLite
+import Text.InterpolatedString.Perl6 (q, qc)
 
-import Sproxy.Server.DB.DataFile ( DataFile(..), GroupMember(..),
-  GroupPrivilege(..), PrivilegeRule(..) )
 import qualified Sproxy.Application.Access as A
 import qualified Sproxy.Logging as Log
-
+import Sproxy.Server.DB.DataFile
+       (DataFile(..), GroupMember(..), GroupPrivilege(..),
+        PrivilegeRule(..))
 
 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
  - 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?
-
+  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 -> Text -> 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 ]
+  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_ :: SQLite.Connection -> Text -> Text -> Text -> Text -> IO [Text]
 userGroups_ c email domain path method =
-  fmap SQLite.fromOnly <$> SQLite.queryNamed c [q|
+  fmap 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 gp.domain = :domain
@@ -77,12 +88,12 @@ userGroups_ c email domain path method =
       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
-     ]
-
+  |]
+    [ ":email" := email -- XXX always in lower case
+    , ":domain" := toLower domain
+    , ":path" := path
+    , ":method" := method -- XXX case-sensitive by RFC2616
+    ]
 
 userAccess :: Database -> Text -> Text -> A.Inquiry -> IO [Text]
 userAccess db email domain inq = do
@@ -90,80 +101,85 @@ userAccess db email domain inq = do
         not . null <$> userGroups_ c email domain (A.path qn) (A.method qn)
   map fst <$> withResource db (\c -> filterM (permitted c) (HM.toList inq))
 
-
 userGroups :: Database -> Text -> Text -> Text -> Text -> IO [Text]
 userGroups db email domain path method =
   withResource db $ \c -> userGroups_ c email domain path method
 
-
 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
-
+  withResource db $ \c ->
+    SQLite.withTransaction c $ do
+      createGroupMember c
+      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
+    Left e -> Log.error $ f ++ ": " ++ show e
     Right df ->
-      withResource db $ \c -> SQLite.withTransaction c $ do
-        refreshGroupMembers c $ \st ->
-          mapM_ (\gm -> submit st (gmGroup gm, toLower $ gmEmail gm)
-                ) (groupMember df)
-
-        refreshGroupPrivileges c $ \st ->
-          mapM_ (\gp -> submit st (gpGroup gp, toLower $ gpDomain gp, gpPrivilege gp)
-                ) (groupPrivilege df)
-
-        refreshPrivilegeRule c $ \st ->
-          mapM_ (\pr -> submit st (toLower $ prDomain pr, prPrivilege pr, prPath pr, prMethod pr)
-                ) (privilegeRule df)
-
-
+      withResource db $ \c ->
+        SQLite.withTransaction c $ do
+          refreshGroupMembers c $ \st ->
+            mapM_
+              (\gm -> submit st (gmGroup gm, toLower $ gmEmail gm))
+              (groupMember df)
+          refreshGroupPrivileges c $ \st ->
+            mapM_
+              (\gp ->
+                 submit st (gpGroup gp, toLower $ gpDomain gp, gpPrivilege gp))
+              (groupPrivilege df)
+          refreshPrivilegeRule c $ \st ->
+            mapM_
+              (\pr ->
+                 submit
+                   st
+                   ( toLower $ prDomain pr
+                   , prPrivilege pr
+                   , prPath pr
+                   , prMethod pr))
+              (privilegeRule df)
 populate db (Just (PostgreSQL connstr)) =
-  void . forkIO . forever . flip finally (7 `minutes` threadDelay)
-  . logException $ do
+  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
-
+    withResource db $ \c ->
+      SQLite.withTransaction c $
+      bracket (PG.connectPostgreSQL $ pack connstr) PG.close $ \pg ->
+        PG.withTransaction pg $ do
           Log.info "db: syncing group_member"
           refreshGroupMembers c $ \st ->
-            PG.forEach_ pg
-              [q|SELECT "group", lower(email) FROM group_member|] $ \r ->
-                submit st (r :: (Text, Text))
+            PG.forEach_ pg [q|SELECT "group", lower(email) FROM group_member|] $ \r ->
+              submit st (r :: (Text, Text))
           count c "group_member"
-
           Log.info "db: syncing group_privilege"
           refreshGroupPrivileges c $ \st ->
-            PG.forEach_ pg
+            PG.forEach_
+              pg
               [q|SELECT "group", lower(domain), privilege FROM group_privilege|] $ \r ->
-                submit st (r :: (Text, Text, Text))
+              submit st (r :: (Text, Text, Text))
           count c "group_privilege"
-
           Log.info "db: syncing privilege_rule"
           refreshPrivilegeRule c $ \st ->
-            PG.forEach_ pg
+            PG.forEach_
+              pg
               [q|SELECT lower(domain), privilege, path, method FROM privilege_rule|] $ \r ->
-                submit st (r :: (Text, Text, Text, Text))
+              submit st (r :: (Text, Text, Text, Text))
           count c "privilege_rule"
 
-
 -- 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.ToRow values => SQLite.Statement -> values -> IO ()
-submit st v = SQLite.withBind st v $ void (SQLite.nextRow st :: IO (Maybe [Int]))
-
+submit st v =
+  SQLite.withBind st v $ void (SQLite.nextRow st :: IO (Maybe [Int]))
 
 createGroupMember :: SQLite.Connection -> IO ()
-createGroupMember c = SQLite.execute_ c [q|
+createGroupMember c =
+  SQLite.execute_
+    c
+    [q|
   CREATE TABLE IF NOT EXISTS group_member (
     "group" TEXT,
     email TEXT,
@@ -175,13 +191,16 @@ refreshGroupMembers :: SQLite.Connection -> (SQLite.Statement -> IO ()) -> IO ()
 refreshGroupMembers c a = do
   SQLite.execute_ c "DROP TABLE IF EXISTS group_member"
   createGroupMember c
-  SQLite.withStatement c
+  SQLite.withStatement
+    c
     [q|INSERT INTO group_member("group", email) VALUES (?, ?)|]
     a
 
-
 createGroupPrivilege :: SQLite.Connection -> IO ()
-createGroupPrivilege c = SQLite.execute_ c [q|
+createGroupPrivilege c =
+  SQLite.execute_
+    c
+    [q|
   CREATE TABLE IF NOT EXISTS group_privilege (
     "group" TEXT,
     domain TEXT,
@@ -190,17 +209,21 @@ createGroupPrivilege c = SQLite.execute_ c [q|
   )
 |]
 
-refreshGroupPrivileges :: SQLite.Connection -> (SQLite.Statement -> IO ()) -> IO ()
+refreshGroupPrivileges ::
+     SQLite.Connection -> (SQLite.Statement -> IO ()) -> IO ()
 refreshGroupPrivileges c a = do
   SQLite.execute_ c "DROP TABLE IF EXISTS group_privilege"
   createGroupPrivilege c
-  SQLite.withStatement c
+  SQLite.withStatement
+    c
     [q|INSERT INTO group_privilege("group", domain, privilege) VALUES (?, ?, ?)|]
     a
 
-
 createPrivilegeRule :: SQLite.Connection -> IO ()
-createPrivilegeRule c = SQLite.execute_ c [q|
+createPrivilegeRule c =
+  SQLite.execute_
+    c
+    [q|
   CREATE TABLE IF NOT EXISTS privilege_rule (
     domain TEXT,
     privilege TEXT,
@@ -210,26 +233,24 @@ createPrivilegeRule c = SQLite.execute_ c [q|
   )
 |]
 
-refreshPrivilegeRule :: SQLite.Connection -> (SQLite.Statement -> IO ()) -> IO ()
+refreshPrivilegeRule ::
+     SQLite.Connection -> (SQLite.Statement -> IO ()) -> IO ()
 refreshPrivilegeRule c a = do
   SQLite.execute_ c "DROP TABLE IF EXISTS privilege_rule"
   createPrivilegeRule c
-  SQLite.withStatement c
+  SQLite.withStatement
+    c
     [q|INSERT INTO privilege_rule(domain, privilege, path, method) VALUES (?, ?, ?, ?)|]
     a
 
-
 count :: SQLite.Connection -> String -> IO ()
 count c table = do
-  r <- fmap SQLite.fromOnly <$> SQLite.query_ c [qc|SELECT COUNT(*) FROM {table}|]
+  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)
-
+logException a = catch a $ \e -> Log.error $ "db: " ++ show (e :: SomeException)
 
 minutes :: Int -> (Int -> IO ()) -> IO ()
 minutes us f = f $ us * 60 * 1000000
-