module Aura.Shell where
import Aura.Types
import RIO
import qualified RIO.ByteString as B
import qualified RIO.Map as M
import qualified RIO.Text as T
import System.Process.Typed (proc, runProcess)
csi :: [Int] -> ByteString -> ByteString
csi :: [Int] -> ByteString -> ByteString
csi [Int]
args ByteString
code = ByteString
"\ESC[" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
";" ((Int -> ByteString) -> [Int] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Int -> Text) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. Display a => a -> Text
textDisplay) [Int]
args) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
code
cursorUpLineCode :: Int -> ByteString
cursorUpLineCode :: Int -> ByteString
cursorUpLineCode Int
n = [Int] -> ByteString -> ByteString
csi [Int
n] ByteString
"F"
getTrueUser :: Environment -> Maybe User
getTrueUser :: Environment -> Maybe User
getTrueUser Environment
env | Environment -> Bool
isTrueRoot Environment
env = User -> Maybe User
forall a. a -> Maybe a
Just (User -> Maybe User) -> User -> Maybe User
forall a b. (a -> b) -> a -> b
$ Text -> User
User Text
"root"
| Environment -> Bool
hasRootPriv Environment
env = Text -> User
User (Text -> User) -> Maybe Text -> Maybe User
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Environment -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"SUDO_USER" Environment
env
| Bool
otherwise = Text -> User
User (Text -> User) -> Maybe Text -> Maybe User
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Environment -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"USER" Environment
env
isTrueRoot :: Environment -> Bool
isTrueRoot :: Environment -> Bool
isTrueRoot Environment
env = Text -> Environment -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"USER" Environment
env Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"root" Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Environment -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Text
"SUDO_USER" Environment
env)
hasRootPriv :: Environment -> Bool
hasRootPriv :: Environment -> Bool
hasRootPriv Environment
env = Text -> Environment -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Text
"SUDO_USER" Environment
env Bool -> Bool -> Bool
|| Environment -> Bool
isTrueRoot Environment
env
getEditor :: Environment -> FilePath
getEditor :: Environment -> FilePath
getEditor = FilePath -> (Text -> FilePath) -> Maybe Text -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"vi" Text -> FilePath
T.unpack (Maybe Text -> FilePath)
-> (Environment -> Maybe Text) -> Environment -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Environment -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"EDITOR"
getLocale :: Environment -> Text
getLocale :: Environment -> Text
getLocale Environment
env = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"C" (Maybe Text -> Text)
-> ([Maybe Text] -> Maybe Text) -> [Maybe Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe Text] -> Maybe Text
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe Text] -> Text) -> [Maybe Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe Text) -> [Text] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Environment -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Environment
env) [Text
"LC_ALL", Text
"LC_MESSAGES", Text
"LANG"]
chown :: MonadIO m => User -> FilePath -> [String] -> m ()
chown :: User -> FilePath -> [FilePath] -> m ()
chown (User Text
usr) FilePath
pth [FilePath]
args = m ExitCode -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ExitCode -> m ())
-> (ProcessConfig () () () -> m ExitCode)
-> ProcessConfig () () ()
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProcessConfig () () () -> m ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ExitCode
runProcess (ProcessConfig () () () -> m ()) -> ProcessConfig () () () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"chown" ([FilePath]
args [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [Text -> FilePath
T.unpack Text
usr, FilePath
pth])
hideCursor :: IO ()
hideCursor :: IO ()
hideCursor = ByteString -> IO ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
B.putStr ByteString
hideCursorCode
showCursor :: IO ()
showCursor :: IO ()
showCursor = ByteString -> IO ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
B.putStr ByteString
showCursorCode
hideCursorCode :: ByteString
hideCursorCode :: ByteString
hideCursorCode = [Int] -> ByteString -> ByteString
csi [] ByteString
"?25l"
showCursorCode :: ByteString
showCursorCode :: ByteString
showCursorCode = [Int] -> ByteString -> ByteString
csi [] ByteString
"?25h"
raiseCursorBy :: Int -> IO ()
raiseCursorBy :: Int -> IO ()
raiseCursorBy = ByteString -> IO ()
forall (m :: * -> *). MonadIO m => ByteString -> m ()
B.putStr (ByteString -> IO ()) -> (Int -> ByteString) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
cursorUpLineCode