diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2012, Jeremy Shaw + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Jeremy Shaw nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,142 @@ +module Main where + +import Control.Applicative ((<$>), (<*>), (*>), pure) +import Clckwrks (UserId(..)) +import Clckwrks.ProfileData.Acid (ProfileDataState(..), GetProfileData(..), AddRole(..), RemoveRole(..), GetUserIdUsernames(..)) +import Clckwrks.ProfileData.Types (Role(..)) +import Control.Monad.Reader +import Data.Acid (AcidState) +import Data.Acid.Advanced (query', update') +import Data.Acid.Remote (openRemoteState) +import Network (PortID(UnixSocket)) +import System.Environment +import System.Console.Haskeline +import Text.Parsec +import Text.Parsec.String + +-- right now this just connects to the server and makes UserId 1 an administrator +-- +-- eventually there should be an actually useful command-line interface +{- +main :: IO () +main = + do [socket] <- getArgs + acid <- openRemoteState "localhost" (UnixSocket socket) + update acid (AddRole (UserId 1) Administrator) + pd <- query acid (GetProfileData (UserId 1)) + print pd +-} +main :: IO () +main = + do args <- getArgs + case args of + [socket] -> + do acid <- openRemoteState "localhost" (UnixSocket socket) + putStrLn "type 'help' for a list of commands." + runReaderT (runInputT defaultSettings loop) acid + _ -> putStrLn "Usage: clckwrks-cli path/to/profileData_socket" + +data UserCmd + = UCList + | UCShow UserId + | UCAddRole UserId Role + | UCRemoveRole UserId Role + deriving (Eq, Ord, Read, Show) + +data Command + = User UserCmd + | Quit + | Help + deriving (Eq, Ord, Read, Show) + +showHelp :: String +showHelp = unlines + [ "user list - show all users" + , "user show - show profile data for " + , "user add-role - add a role (such as Administrator)" + , "user remove-role - remove a role" + , "quit - quit" + , "help - show this help" + ] + +pRole :: Parser Role +pRole = + string "Administrator" *> pure Administrator + +pUserId :: Parser UserId +pUserId = UserId <$> (read <$> many1 digit) + +pUserCmd :: Parser UserCmd +pUserCmd = + do string "list" + return UCList + <|> + do string "show" + skipMany1 space + u <- pUserId + return (UCShow u) + <|> + do string "add-role" + skipMany1 space + u <- pUserId + skipMany1 space + r <- pRole + return (UCAddRole u r) + <|> + do string "remove-role" + skipMany1 space + u <- pUserId + skipMany1 space + r <- pRole + return (UCRemoveRole u r) + + +pCommand :: Parser Command +pCommand = + do string "user" + skipMany1 space + User <$> pUserCmd + <|> + do string "quit" *> return Quit + <|> + do string "help" *> return Help + +loop :: InputT (ReaderT (AcidState ProfileDataState) IO) () +loop = do + minput <- getInputLine "% " + case minput of + Nothing -> return () + Just input -> + do let r = parse pCommand input input + case r of + (Left e) -> + do liftIO $ print e + loop + (Right Quit) -> + return () + (Right cmd) -> + do lift $ execCommand cmd + loop + +execCommand :: Command -> ReaderT (AcidState ProfileDataState) IO () +execCommand (User UCList) = + do a <- ask + all <- query' a GetUserIdUsernames + lift $ print all + return () +execCommand (User (UCShow uid)) = + do a <- ask + mpd <- query' a (GetProfileData uid) + case mpd of + Nothing -> lift $ putStrLn $ "Invalid userid." + (Just pd) -> lift $ print pd +execCommand (User (UCAddRole uid role)) = + do a <- ask + update' a (AddRole uid role) +execCommand (User (UCRemoveRole uid role)) = + do a <- ask + update' a (RemoveRole uid role) +execCommand Help = + do lift $ putStrLn $ showHelp + return () + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/clckwrks-cli.cabal b/clckwrks-cli.cabal new file mode 100644 --- /dev/null +++ b/clckwrks-cli.cabal @@ -0,0 +1,26 @@ +Name: clckwrks-cli +Version: 0.2.0 +Synopsis: a command-line interface for adminstrating some aspects of clckwrks +Description: This tool permits browsing of users, changing their roles, and other features. +Homepage: http://www.clckwrks.com/ +License: BSD3 +License-file: LICENSE +Author: Jeremy Shaw +Maintainer: jeremy@n-heptane.com +Copyright: 2012 Jeremy Shaw, SeeReason Partners LLC +Category: Clckwrks +Build-type: Custom +Cabal-version: >=1.6 + +Executable clckwrks-cli + Main-is: + Main.hs + + Build-depends: + acid-state >= 0.7 && < 0.9, + base < 5, + clckwrks >= 0.12 && < 0.14, + haskeline == 0.7.*, + mtl >= 2.0 && < 2.2, + network >= 2.3 && < 2.5, + parsec == 3.1.*