{-# language CPP #-} module Clckwrks.CLI.ProfileData where import Control.Applicative ((<$>), (<*>), (*>), pure) import Clckwrks (UserId(..)) import Clckwrks.CLI.Core (CLIHandler(..)) import Clckwrks.ProfileData.Acid (ProfileDataState(..), GetProfileData(..), AddRole(..), RemoveRole(..)) import Clckwrks.ProfileData.Types (Role(..)) import Control.Monad.Reader import Data.Acid (AcidState) import Data.Acid.Advanced (query', update') #if MIN_VERSION_network(3,0,0) import Network.Socket (SockAddr(..)) import Data.Acid.Remote (openRemoteStateSockAddr, skipAuthenticationPerform) #else import Network (PortID(UnixSocket)) import Data.Acid.Remote (openRemoteState, skipAuthenticationPerform) #endif import System.Environment import System.FilePath (()) 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 skipAuthenticationPerform "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 = UCShow UserId | UCAddRole UserId Role | UCRemoveRole UserId Role deriving (Eq, Ord, Read, Show) showUserHelp :: [String] showUserHelp = [ "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" ] 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) execUserCommand :: UserCmd -> ReaderT (AcidState ProfileDataState) IO () {- execUserCommand UCList = do a <- ask all <- query' a GetUserIdUsernames lift $ print all return () -} execUserCommand (UCShow uid) = do a <- ask pd <- query' a (GetProfileData uid) lift $ print pd execUserCommand (UCAddRole uid role) = do a <- ask update' a (AddRole uid role) execUserCommand (UCRemoveRole uid role) = do a <- ask update' a (RemoveRole uid role) initUserCommand :: FilePath -> IO (UserCmd -> IO ()) initUserCommand basePath = #if MIN_VERSION_network(3,0,0) do profileData <- openRemoteStateSockAddr skipAuthenticationPerform (SockAddrUnix ((basePath "profileData_socket"))) #else do profileData <- openRemoteState skipAuthenticationPerform "localhost" (UnixSocket ((basePath "profileData_socket"))) #endif pure $ \c -> runReaderT (execUserCommand c) profileData userCLIHandler :: FilePath -> IO CLIHandler userCLIHandler basePath = do exec <- initUserCommand basePath pure $ CLIHandler { cliPrefix = "user" , cliExec = exec , cliParser = pUserCmd , cliHelp = showUserHelp }