juandelacosa 0.1.1 → 0.1.2
raw patch · 8 files changed
+258/−180 lines, 8 filesdep +optparse-applicativedep −docoptdep −interpolatedstring-perl6
Dependencies added: optparse-applicative
Dependencies removed: docopt, interpolatedstring-perl6
Files
- ChangeLog.md +7/−0
- README.md +15/−15
- juandelacosa.cabal +54/−51
- src/Application.hs +9/−7
- src/LogFormat.hs +1/−1
- src/Main.hs +99/−59
- src/Server.hs +71/−45
- static/juandelacosa.js +2/−2
ChangeLog.md view
@@ -1,3 +1,10 @@+0.1.2+=====++* Rewrite to use `optparse-applicative` instead of `docopt`.+* Rewrite to use `getAddrInfo` instead of `inet_addr`.++ 0.1.1 =====
README.md view
@@ -2,7 +2,7 @@ =============== HTTP server for managing [MariaDB](http://mariadb.org/) users.-Designed to work behind [Sproxy](https://github.com/zalora/sproxy)+Designed to work behind [Sproxy](http://hackage.haskell.org/package/sproxy2). and assuming users' logins are their email addresses (MariaDB allows up to 80 characters). @@ -17,7 +17,7 @@ Installation ============- $ git clone https://github.com/zalora/juandelacosa.git+ $ git clone https://github.com/ip1981/juandelacosa.git $ cd juandelacosa $ cabal install @@ -25,19 +25,19 @@ ===== Type `juandelacosa --help` to see usage summary: - Usage:- juandelacosa [options]-- Options:- -f, --file=MYCNF Read this MySQL client config file- -g, --group=GROUP Read this options group in the above file [default: client]-- -d, --datadir=DIR Data directory including static files [default: <cabal data dir>]-- -s, --socket=SOCK Listen on this UNIX-socket [default: /tmp/juandelacosa.sock]- -p, --port=PORT Instead of UNIX-socket, listen on this TCP port (localhost)+ Usage: juandelacosa [-f|--file FILE] [-g|--group STRING] [-d|--datadir DIR]+ [(-p|--port INT) | (-s|--socket PATH)] - -h, --help Show this message+ Available options:+ -f,--file FILE Read this MySQL client config file+ -g,--group STRING Read this options group in the above file+ (default: "client")+ -d,--datadir DIR Data directory including static files+ (default: "/home/pashev/.cabal/share/x86_64-linux-ghc-8.8.4/juandelacosa-0.1.2")+ -p,--port INT listen on this TCP port (localhost only)+ -s,--socket PATH Listen on this UNIX-socket+ (default: "/tmp/juandelacosa.sock")+ -h,--help Show this help text Database Privileges@@ -53,6 +53,6 @@ Screenshots =========== -+ 
juandelacosa.cabal view
@@ -1,59 +1,62 @@-name: juandelacosa-version: 0.1.1-synopsis: Manage users in MariaDB >= 10.1.1+name: juandelacosa+version: 0.1.2+cabal-version: 1.20+license: MIT+license-file: LICENSE+copyright: 2016, Zalora South East Asia Pte. Ltd+maintainer: Igor Pashev <pashev.igor@gmail.com>+author: Igor Pashev <pashev.igor@gmail.com>+synopsis: Manage users in MariaDB >= 10.1.1 description:- HTTP server for managing MariaDB users. Designed to work behind- Sproxy and assuming users' logins are their email addresses- (MariaDB allows up to 80 characters).-license: MIT-license-file: LICENSE-author: Igor Pashev <pashev.igor@gmail.com>-maintainer: Igor Pashev <pashev.igor@gmail.com>-copyright: 2016, Zalora South East Asia Pte. Ltd-category: Databases, Web-build-type: Simple-extra-source-files: README.md ChangeLog.md-cabal-version: >= 1.20+ HTTP server for managing MariaDB users. Designed to work behind+ Sproxy and assuming users' logins are their email addresses+ (MariaDB allows up to 80 characters).++category: Databases, Web+build-type: Simple data-files:- index.html- static/external/bootstrap/css/*.min.css- static/external/bootstrap/js/*.min.js- static/external/jquery-2.2.4.min.js- static/juandelacosa.js+ index.html+ static/external/bootstrap/css/*.min.css+ static/external/bootstrap/js/*.min.js+ static/external/jquery-2.2.4.min.js+ static/juandelacosa.js +extra-source-files:+ README.md+ ChangeLog.md+ source-repository head- type: git- location: https://github.com/zalora/juandelacosa.git+ type: git+ location: https://github.com/ip1981/juandelacosa.git executable juandelacosa- default-language: Haskell2010- ghc-options: -Wall -static- hs-source-dirs: src- main-is: Main.hs+ main-is: Main.hs+ hs-source-dirs: src other-modules:- Application- LogFormat- Server- build-depends:- base >= 4.8 && < 50- , base64-bytestring >= 1.0- , bytestring >= 0.10- , data-default-class- , docopt >= 0.7- , entropy >= 0.3- , fast-logger- , http-types >= 0.9- , interpolatedstring-perl6 >= 1.0- , mtl >= 2.2- , mysql >= 0.1- , mysql-simple >= 0.2- , network >= 2.6- , resource-pool >= 0.2- , scotty >= 0.10- , text >= 1.2- , unix >= 2.7- , wai >= 3.2- , wai-extra >= 3.0- , wai-middleware-static >= 0.8- , warp >= 3.2+ Application+ LogFormat+ Server + default-language: Haskell2010+ ghc-options: -Wall -static+ build-depends:+ base >=4.8 && <50,+ base64-bytestring >=1.0,+ bytestring >=0.10,+ data-default-class -any,+ entropy >=0.3,+ fast-logger -any,+ http-types >=0.9,+ mtl >=2.2,+ mysql >=0.1,+ mysql-simple >=0.2,+ network >=2.6,+ optparse-applicative >=0.13.0.0,+ resource-pool >=0.2,+ scotty >=0.10,+ text >=1.2,+ unix >=2.7,+ wai >=3.2,+ wai-extra >=3.0,+ wai-middleware-static >=0.8,+ warp >=3.2
src/Application.hs view
@@ -10,6 +10,7 @@ import Data.ByteString.Base64 (encode) import Data.Default.Class (def) import Data.Pool (Pool, withResource)+import Data.Text.Lazy (Text, toLower) import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8) import Database.MySQL.Simple (Connection, Only(..), query, execute) import Network.HTTP.Types (notFound404, badRequest400)@@ -36,14 +37,10 @@ juanDeLaCosa :: Pool Connection -> Middleware -> FilePath -> ScottyM () juanDeLaCosa p logger dataDir = do- let- index_html = dataDir ++ "/" ++ "index.html"- middleware logger middleware $ staticPolicy (hasPrefix "static" >-> addBase dataDir)- get "/" $ file index_html- get "/index.html" $ file index_html+ get "/" $ file (dataDir ++ "/" ++ "index.html") post "/resetMyPassword" $ apiResetMyPassword p get "/whoAmI" $ apiWhoAmI p@@ -53,7 +50,8 @@ apiWhoAmI p = header "From" >>= \case Nothing -> status badRequest400 >> text "Missing header `From'"- Just login -> do+ Just email -> do+ let login = emailToLogin email [ Only n ] <- withDB p $ \c -> query c "SELECT COUNT(*) FROM mysql.user WHERE User=? AND Host='%'" [ LBS.toStrict . encodeUtf8 $ login ]@@ -65,7 +63,8 @@ apiResetMyPassword p = header "From" >>= \case Nothing -> status badRequest400 >> text "Missing header `From'"- Just login -> do+ Just email -> do+ let login = emailToLogin email password <- liftIO $ BS.takeWhile (/= '=') . encode <$> getEntropy 13 _ <- withDB p $ \c -> execute c "SET PASSWORD FOR ?@'%' = PASSWORD(?)" [ LBS.toStrict . encodeUtf8 $ login, password ]@@ -74,4 +73,7 @@ withDB :: Pool Connection -> (Connection -> IO a) -> ActionM a withDB p a = liftIO $ withResource p (liftIO . a)++emailToLogin :: Text -> Text+emailToLogin = toLower
src/LogFormat.hs view
@@ -12,7 +12,7 @@ import System.Log.FastLogger (LogStr, toLogStr) import qualified Data.ByteString.Char8 as BS --- Sligthly modified Common Log Format.+-- Sligthly modified Combined Log Format. -- User ID extracted from the From header. logFormat :: BS.ByteString -> Request -> Status -> Maybe Integer -> LogStr logFormat t req st msize = ""
src/Main.hs view
@@ -1,73 +1,113 @@-{-# LANGUAGE QuasiQuotes #-}--module Main (- main-) where+module Main+ ( main+ ) where import Data.ByteString.Char8 (pack)-import Data.Maybe (fromJust) import Data.Version (showVersion) import Database.MySQL.Base (ConnectInfo(..)) import Database.MySQL.Base.Types (Option(ReadDefaultFile, ReadDefaultGroup)) import Paths_juandelacosa (getDataDir, version) -- from cabal-import System.Environment (getArgs)-import Text.InterpolatedString.Perl6 (qc)-import qualified System.Console.Docopt.NoTH as O--import Server (server)--usage :: IO String-usage = do- dataDir <- getDataDir- return $- "juandelacosa " ++ showVersion version- ++ " manage MariaDB user and roles" ++ [qc|+import System.IO.Unsafe (unsafePerformIO) -Usage:- juandelacosa [options]+import Options.Applicative+ ( Parser+ , (<**>)+ , (<|>)+ , auto+ , execParser+ , fullDesc+ , header+ , help+ , helper+ , info+ , long+ , metavar+ , option+ , optional+ , short+ , showDefault+ , strOption+ , value+ ) -Options:- -f, --file=MYCNF Read this MySQL client config file- -g, --group=GROUP Read this options group in the above file [default: client]+import Server (Listen(Port, Socket), server) - -d, --datadir=DIR Data directory including static files [default: {dataDir}]+data Config =+ Config+ { file :: Maybe FilePath+ , group :: String+ , datadir :: FilePath+ , listen :: Listen+ } - -s, --socket=SOCK Listen on this UNIX-socket [default: /tmp/juandelacosa.sock]- -p, --port=PORT Instead of UNIX-socket, listen on this TCP port (localhost)+parseListen :: Parser Listen+parseListen = port <|> socket+ where+ port =+ Port <$>+ option+ auto+ (long "port" <>+ short 'p' <>+ metavar "INT" <> help "listen on this TCP port (localhost only)")+ socket =+ Socket <$>+ option+ auto+ (long "socket" <>+ short 's' <>+ metavar "PATH" <>+ value "/tmp/juandelacosa.sock" <>+ showDefault <> help "Listen on this UNIX-socket") - -h, --help Show this message+{-# NOINLINE dataDir #-}+dataDir :: FilePath+dataDir = unsafePerformIO getDataDir -|]+parseConfig :: Parser Config+parseConfig =+ Config <$>+ optional+ (strOption+ (long "file" <>+ short 'f' <> metavar "FILE" <> help "Read this MySQL client config file")) <*>+ strOption+ (long "group" <>+ short 'g' <>+ metavar "STRING" <>+ value "client" <>+ showDefault <> help "Read this options group in the above file") <*>+ strOption+ (long "datadir" <>+ short 'd' <>+ metavar "DIR" <>+ value dataDir <>+ showDefault <> help "Data directory including static files") <*>+ parseListen -main :: IO()-main = do- doco <- O.parseUsageOrExit =<< usage- args <- O.parseArgsOrExit doco =<< getArgs- if args `O.isPresent` O.longOption "help"- then putStrLn $ O.usage doco- else do- let- file = O.getArg args $ O.longOption "file"- group = fromJust $ O.getArg args $ O.longOption "group"- port = O.getArg args $ O.longOption "port"- socket = fromJust $ O.getArg args $ O.longOption "socket"- datadir = fromJust $ O.getArg args $ O.longOption "datadir"- -- XXX: mysql package maps empty strings to NULL- -- which is what we need, see documentation for mysql_real_connect()- let myInfo = ConnectInfo {- connectDatabase = "",- connectHost = "",- connectOptions = case file of- Nothing -> []- Just f -> [ ReadDefaultFile f, ReadDefaultGroup (pack group) ],- connectPassword = "",- connectPath = "",- connectPort = 0,- connectSSL = Nothing,- connectUser = ""- }- let listen = case port of- Nothing -> Right socket- Just p -> Left $ read p- server listen myInfo datadir+run :: Config -> IO ()+run cfg = do+ let myInfo =+ ConnectInfo+ { connectDatabase = ""+ , connectHost = ""+ , connectOptions =+ case file cfg of+ Nothing -> []+ Just f ->+ [ReadDefaultFile f, ReadDefaultGroup (pack $ group cfg)]+ , connectPassword = ""+ , connectPath = ""+ , connectPort = 0+ , connectSSL = Nothing+ , connectUser = ""+ }+ server (listen cfg) myInfo (datadir cfg) +main :: IO ()+main = run =<< execParser opts+ where+ opts = info (parseConfig <**> helper) (fullDesc <> header desc)+ desc =+ "juandelacosa " +++ showVersion version ++ " - manage MariaDB user and roles"
src/Server.hs view
@@ -1,67 +1,94 @@ module Server-(- server-) where+ ( Listen(..)+ , server+ ) where -import Control.Exception.Base (throwIO, catch, bracket)+import Control.Exception.Base (bracket, catch, throwIO) import Data.Bits ((.|.)) import Data.Pool (createPool, destroyAllResources) import Database.MySQL.Base (ConnectInfo)-import Network.Socket (socket, setSocketOption, bind, listen, close,- maxListenQueue, getSocketName, inet_addr, Family(AF_UNIX, AF_INET),- SocketType(Stream), SocketOption(ReuseAddr), Socket, SockAddr(SockAddrUnix,- SockAddrInet))-import Network.Wai.Handler.Warp (Port, defaultSettings, runSettingsSocket)+import qualified Database.MySQL.Simple as MySQL+import Network.Socket+ ( AddrInfoFlag(AI_NUMERICSERV)+ , Family(AF_UNIX)+ , SockAddr(SockAddrUnix)+ , Socket+ , SocketOption(ReuseAddr)+ , SocketType(Stream)+ , addrAddress+ , addrFamily+ , addrFlags+ , addrProtocol+ , addrSocketType+ , bind+ , close+ , defaultHints+ , getAddrInfo+ , getSocketName+ , listen+ , maxListenQueue+ , setSocketOption+ , socket+ )+import Network.Wai.Handler.Warp (defaultSettings, runSettingsSocket) import System.IO (hPutStrLn, stderr) import System.IO.Error (isDoesNotExistError)-import System.Posix.Files (removeLink, setFileMode, socketMode, ownerReadMode,- ownerWriteMode, groupReadMode, groupWriteMode)-import qualified Database.MySQL.Simple as MySQL+import System.Posix.Files+ ( groupReadMode+ , groupWriteMode+ , ownerReadMode+ , ownerWriteMode+ , removeLink+ , setFileMode+ , socketMode+ ) import Application (app) -type Listen = Either Port FilePath-+data Listen+ = Socket FilePath+ | Port Int server :: Listen -> ConnectInfo -> FilePath -> IO () server socketSpec mysqlConnInfo dataDir = bracket- ( do- sock <- createSocket socketSpec- mysql <- createPool- (MySQL.connect mysqlConnInfo)- MySQL.close- 1 -- stripes- 60 -- keep alive (seconds)- 10 -- max connections- return (sock, mysql) )- ( \(sock, mysql) -> do- closeSocket sock- destroyAllResources mysql )- ( \(sock, mysql) -> do- listen sock maxListenQueue- hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"- runSettingsSocket defaultSettings sock =<< app mysql dataDir)-+ (do sock <- createSocket socketSpec+ mysql <-+ createPool+ (MySQL.connect mysqlConnInfo)+ MySQL.close+ 1 -- stripes+ 60 -- keep alive (seconds)+ 10 -- max connections+ return (sock, mysql))+ (\(sock, mysql) -> do+ closeSocket sock+ destroyAllResources mysql)+ (\(sock, mysql) -> do+ listen sock maxListenQueue+ hPutStrLn stderr $ "Static files from `" ++ dataDir ++ "'"+ runSettingsSocket defaultSettings sock =<< app mysql dataDir) createSocket :: Listen -> IO Socket-createSocket (Right path) = do+createSocket (Socket path) = do removeIfExists path sock <- socket AF_UNIX Stream 0 bind sock $ SockAddrUnix path- setFileMode path $ socketMode- .|. ownerWriteMode .|. ownerReadMode- .|. groupWriteMode .|. groupReadMode+ setFileMode path $+ socketMode .|. ownerWriteMode .|. ownerReadMode .|. groupWriteMode .|.+ groupReadMode hPutStrLn stderr $ "Listening on UNIX socket `" ++ path ++ "'" return sock-createSocket (Left port) = do- sock <- socket AF_INET Stream 0+createSocket (Port port) = do+ addr:_ <- getAddrInfo (Just hints) (Just "localhost") (Just svc)+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) setSocketOption sock ReuseAddr 1- addr <- inet_addr "127.0.0.1"- bind sock $ SockAddrInet (fromIntegral port) addr+ bind sock $ addrAddress addr hPutStrLn stderr $ "Listening on localhost:" ++ show port return sock-+ where+ svc = show port+ hints = defaultHints {addrFlags = [AI_NUMERICSERV], addrSocketType = Stream} closeSocket :: Socket -> IO () closeSocket sock = do@@ -71,10 +98,9 @@ SockAddrUnix path -> removeIfExists path _ -> return () - removeIfExists :: FilePath -> IO () removeIfExists fileName = removeLink fileName `catch` handleExists- where handleExists e- | isDoesNotExistError e = return ()- | otherwise = throwIO e-+ where+ handleExists e+ | isDoesNotExistError e = return ()+ | otherwise = throwIO e
static/juandelacosa.js view
@@ -8,7 +8,7 @@ var passwordMessage = $('#passwordMessage'); var resetPassword = $('#resetPassword'); - document.title = window.location.hostname + ' - ' + 'Juan De La Cosa';+ document.title = window.location.hostname + ' — ' + 'Juan De La Cosa'; (function whoAmI() { $.ajax({@@ -29,7 +29,7 @@ infoAlert.removeClass().addClass('alert alert-info'); setTimeout(whoAmI, 60 * 1000); } else {- infoHead.text('An error has occured');+ infoHead.text('An error has occurred'); infoAlert.text((0 == jqXHR.readyState) ? 'Service unavailable' : errorThrown); infoAlert.removeClass().addClass('alert alert-danger');