diff options
author | Igor Pashev <pashev.igor@gmail.com> | 2016-11-25 23:40:29 +0300 |
---|---|---|
committer | Igor Pashev <pashev.igor@gmail.com> | 2016-11-25 23:51:25 +0300 |
commit | ea17e9c2a3350ba670f95a6fa0ce7716adfa4176 (patch) | |
tree | 1cde3e92d68a816a54ea7b0cca8af0b97e7c291e /src/Sproxy/Server | |
parent | 7ba0b2158124bbf10fbdeeec70fb7e631a32a364 (diff) | |
download | sproxy2-ea17e9c2a3350ba670f95a6fa0ce7716adfa4176.tar.gz |
Make sure all HTTP headers are UTF8-encoded
Especially X-Family-Name, X-Given-Name.
Since we get all the data from JSON and JSON is in UTF8
by default RFC 7159, we are safe.
Refactored to make it less error-prone and to get
as small number of encoding/decoding as possible.
Diffstat (limited to 'src/Sproxy/Server')
-rw-r--r-- | src/Sproxy/Server/DB.hs | 8 |
1 files changed, 3 insertions, 5 deletions
diff --git a/src/Sproxy/Server/DB.hs b/src/Sproxy/Server/DB.hs index b760afc..90e2abd 100644 --- a/src/Sproxy/Server/DB.hs +++ b/src/Sproxy/Server/DB.hs @@ -11,11 +11,9 @@ module Sproxy.Server.DB ( 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 @@ -52,7 +50,7 @@ start home ds = do return db -userExists :: Database -> String -> IO Bool +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)" @@ -60,9 +58,9 @@ userExists db email = do return $ head r -userGroups :: Database -> String -> Text -> Text -> Text -> IO [ByteString] +userGroups :: Database -> Text -> Text -> Text -> Text -> IO [Text] userGroups db email domain path method = - withResource db $ \c -> fmap (encodeUtf8 . SQLite.fromOnly) <$> SQLite.queryNamed c [q| + withResource db $ \c -> 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 :domain LIKE gp.domain |