Browse Source

Config parsing in two steps

Nicolas Lenz 3 months ago
parent
commit
c49b09fed4
6 changed files with 93 additions and 22 deletions
  1. 3
    0
      command-telegram-bot.cabal
  2. 1
    0
      package.yaml
  3. 10
    3
      src/Command.hs
  4. 29
    11
      src/Config.hs
  5. 35
    0
      src/Config/Raw.hs
  6. 15
    8
      src/Main.hs

+ 3
- 0
command-telegram-bot.cabal View File

@@ -4,7 +4,7 @@ cabal-version: 1.12
4 4
 --
5 5
 -- see: https://github.com/sol/hpack
6 6
 --
7
+-- hash: 15342eee75456f708c6d011d8580ae7296b1d95db41c8ee4db6f9a341715ff02
7 8
 
8 9
 name:           command-telegram-bot
9 10
 version:        0.0.0
@@ -29,12 +29,14 @@ executable command-telegram-bot
29 29
   other-modules:
30 30
       Command
31 31
       Config
32
+      Config.Raw
32 33
       Paths_command_telegram_bot
33 34
   hs-source-dirs:
34 35
       src
35 36
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
36 37
   build-depends:
37 38
       base >=4.7 && <5
39
+    , basement
38 40
     , bytestring
39 41
     , mtl
40 42
     , process

+ 1
- 0
package.yaml View File

@@ -20,6 +20,7 @@ dependencies:
20 20
 - text
21 21
 - bytestring
22 22
 - yaml
23
+- basement
23 24
 - process
24 25
 
25 26
 executables:

+ 10
- 3
src/Command.hs View File

@@ -13,9 +13,16 @@ import System.Exit
13 13
 execute :: Command -> IO Text
14 14
 execute cmd = do
15 15
     (exitCode, out, err) <- readCreateProcessWithExitCode (shell $ T.unpack $ shellCommand cmd) ""
16
-    let header = T.concat ["<b>Command:</b> <code>", shellCommand cmd, "</code>\n", exitCodeToEmoji exitCode]
17
-    let out' = T.replace "<" "&lt;" . T.replace ">" "&gt;" . T.replace "\"" "&quot;" . T.replace "&" "&amp;" $ T.pack out
18
-    return $ crop $ T.unlines [header, "", out']
16
+    let headerCmd = if showCommand cmd
17
+        then T.concat ["<b>Command:</b> <code>", shellCommand cmd, "</code>"]
18
+        else ""
19
+    let headerExit = if showExitCode cmd
20
+        then exitCodeToEmoji exitCode
21
+        else ""
22
+    let out' = if showOutput cmd
23
+        then T.replace "<" "&lt;" . T.replace ">" "&gt;" . T.replace "\"" "&quot;" . T.replace "&" "&amp;" $ T.pack out
24
+        else ""
25
+    return $ crop $ T.unlines [headerCmd, headerExit, "", out']
19 26
 
20 27
 exitCodeToEmoji :: ExitCode -> Text
21 28
 exitCodeToEmoji ExitSuccess = "Successful ✅"

+ 29
- 11
src/Config.hs View File

@@ -1,26 +1,44 @@
1
-{-# LANGUAGE DeriveGeneric #-}
2
-
3
-module Config where
1
+module Config (Config (..), Command (..)) where
4 2
 
3
+import Config.Raw
5 4
 import Data.Text (Text)
6 5
 import Data.Yaml
7
-import GHC.Generics
6
+import Data.Either
7
+import Data.Maybe
8
+import Basement.Compat.Base (Int32)
8 9
 
9 10
 
10 11
 -- |Type for a config containing a list of command specifications.
11 12
 data Config = Config {
12 13
     token :: Text,
13 14
     commands :: [Command]
14
-} deriving (Show, Generic)
15
+} deriving Show
15 16
 
16 17
 -- |Type for a command specification.
17 18
 data Command = Command {
18 19
     commandName :: Text,  -- ^The command name used to call it in Telegram.
19 20
     shellCommand :: Text,  -- ^The shell command to be executed.
20
-    authorizedUsers :: [Int]  -- ^A list of Telegram user ids specifying the users allowed to call the command.
21
-} deriving (Show, Generic)
21
+    authorizedUsers :: Maybe [Int32],  -- ^A list of Telegram user ids specifying the users allowed to call the command. Nothing if no auth check is to be done.
22
+    showCommand :: Bool,  -- ^Whether the command should be shown in the report message.
23
+    showExitCode :: Bool,  -- ^Whether the exit code should be shown in the report message.
24
+    showOutput :: Bool  -- ^Whether the output should be shown in the report message.
25
+} deriving Show
26
+
27
+instance FromJSON Config where
28
+    parseJSON = fmap unrawConfig . parseJSON
29
+
30
+unrawConfig :: ConfigRaw -> Config
31
+unrawConfig (ConfigRaw token commands) = Config token (map unrawCommand commands)
22 32
 
23
-instance FromJSON Command
24
-instance ToJSON Command
25
-instance FromJSON Config
26
-instance ToJSON Config
33
+unrawCommand :: CommandRaw -> Command
34
+unrawCommand (CommandRaw commandName shellCommand authorizedUsers allowAll showCommand showExitCode showOutput)
35
+    = Command commandName shellCommand authorizedUsers'
36
+    (fromMaybe True showCommand) (fromMaybe True showExitCode) (fromMaybe True showOutput) where
37
+        authorizedUsers' = case authorizedUsers of
38
+            Nothing -> case allowAll of
39
+                Just True -> Nothing
40
+                _ -> Just []
41
+            Just [] -> case allowAll of
42
+                Just True -> Nothing
43
+                _ -> Just []
44
+            Just users -> Just users

+ 35
- 0
src/Config/Raw.hs View File

@@ -0,0 +1,35 @@
1
+{-# LANGUAGE DeriveGeneric #-}
2
+
3
+module Config.Raw (ConfigRaw (ConfigRaw), CommandRaw (CommandRaw)) where
4
+
5
+import GHC.Generics
6
+import Data.Text (Text)
7
+import Data.Yaml (FromJSON, ToJSON)
8
+import Basement.Compat.Base (Int32)
9
+
10
+
11
+-- |Type for a config containing a list of command specifications.
12
+data ConfigRaw = ConfigRaw {
13
+    token :: Text,
14
+    commands :: [CommandRaw]
15
+} deriving (Show, Generic)
16
+
17
+-- |Type for a command specification.
18
+data CommandRaw = CommandRaw {
19
+    commandName :: Text,  -- ^The command name used to call it in Telegram.
20
+    shellCommand :: Text,  -- ^The shell command to be executed.
21
+    authorizedUsers :: Maybe [Int32],  -- ^Optional list of Telegram user ids specifying the users allowed to call the command.
22
+    allowAll :: Maybe Bool,  -- ^If this is true and authorizedUsers is unspecified or empty, all users can use the command.
23
+    showCommand :: Maybe Bool,
24
+    showExitCode :: Maybe Bool,
25
+    showOutput :: Maybe Bool
26
+} deriving (Show, Generic)
27
+
28
+data All = All deriving (Show, Generic)
29
+
30
+instance FromJSON CommandRaw
31
+instance ToJSON CommandRaw
32
+instance FromJSON ConfigRaw
33
+instance ToJSON ConfigRaw
34
+instance FromJSON All
35
+instance ToJSON All

+ 15
- 8
src/Main.hs View File

@@ -49,6 +49,13 @@ main = do
49 49
             Telegram.defaultTelegramClientEnv (Telegram.Token token) >>= startBot_ (traceBotDefault $ bot config) where
50 50
         Left exception -> putStrLn $ prettyPrintParseException exception
51 51
 
52
+isAuthorized :: UserId -> Command -> Bool
53
+isAuthorized uid cmd = case authorizedUsers cmd of
54
+    Nothing -> True
55
+    Just [] -> False
56
+    Just authList -> uid `elem` authorized || null authorized where
57
+        authorized = UserId <$> authList
58
+
52 59
 -- | How to handle Actions.
53 60
 handleAction :: Action -> Model -> Eff Action Model
54 61
 handleAction action model = case action of
@@ -85,10 +92,10 @@ handleUpdate (Model config) update = handleMessage <|> handleCallback where
85 92
             [cmd] -> do
86 93
                 user <- Telegram.messageFrom message
87 94
                 let uid = Telegram.userId user
88
-                let authorized = map (Telegram.UserId . fromIntegral) (authorizedUsers cmd)
89
-                case uid `elem` authorized of
90
-                    True -> return $ Execute cmd
91
-                    False -> fail "Not authorized"
95
+                if isAuthorized uid cmd then
96
+                    return $ Execute cmd
97
+                else
98
+                    fail "Not authorized"
92 99
             _ -> fail "Command not unique"
93 100
     handleCallback = do
94 101
         let cmds = commands config
@@ -101,10 +108,10 @@ handleUpdate (Model config) update = handleMessage <|> handleCallback where
101 108
                 let user = callbackQueryFrom callbackQuery
102 109
                 let uid = Telegram.userId user
103 110
                 callbackMessage <- callbackQueryMessage callbackQuery
104
-                let authorized = map (Telegram.UserId . fromIntegral) (authorizedUsers cmd)
105
-                case uid `elem` authorized of
106
-                    True -> return $ ExecuteReplace cmd
107
-                    False -> fail "Not authorized"
111
+                if isAuthorized uid cmd then
112
+                    return $ ExecuteReplace cmd
113
+                else
114
+                    fail "Not authorized"
108 115
             _ -> fail "Command not unique"
109 116
 
110 117
 

Loading…
Cancel
Save