{-# 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
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 <userid> - show profile data for <userid>"
, "user add-role <userid> <role> - add a role (such as Administrator)"
, "user remove-role <userid> <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 "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 (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
}