76 lines
1.7 KiB
Haskell
76 lines
1.7 KiB
Haskell
|
module Telegram where
|
||
|
|
|
||
|
|
import Network
|
||
|
|
import System.IO
|
||
|
|
import System.Process
|
||
|
|
import System.Process.Internals
|
||
|
|
import System.Posix.Signals (signalProcess, sigKILL)
|
||
|
|
import Data.List.Utils (replace)
|
||
|
|
import Control.Monad (when, replicateM_)
|
||
|
|
import Control.Retry
|
||
|
|
|
||
|
|
-- Parameters
|
||
|
|
user = "Oglaf"
|
||
|
|
program = "telegram-cli"
|
||
|
|
args = ["-d", "-P", show port]
|
||
|
|
(host, port) = ("localhost", 2391)
|
||
|
|
|
||
|
|
|
||
|
|
telegramProcess :: IO ProcessHandle
|
||
|
|
telegramProcess = do
|
||
|
|
(_,_,_, handle) <- createProcess (proc program args)
|
||
|
|
return handle
|
||
|
|
|
||
|
|
|
||
|
|
telegramSocket :: IO Handle
|
||
|
|
telegramSocket = recoverAll timeout connect
|
||
|
|
where connect = connectTo host (PortNumber port)
|
||
|
|
timeout = fibonacciBackoff 100000 <> limitRetries 5
|
||
|
|
|
||
|
|
|
||
|
|
closeTelegram :: Handle -> ProcessHandle -> IO ()
|
||
|
|
closeTelegram socket handle =
|
||
|
|
hClose socket >> getPid handle >>= signalProcess sigKILL
|
||
|
|
where
|
||
|
|
go (OpenHandle h) = h
|
||
|
|
getPid h = withProcessHandle h (return . go)
|
||
|
|
|
||
|
|
|
||
|
|
send :: Handle -> String -> IO ()
|
||
|
|
send handle command = do
|
||
|
|
hPutStrLn handle command
|
||
|
|
putStr (command ++ " -> ")
|
||
|
|
|
||
|
|
-- wait for a reply
|
||
|
|
reply <- hWaitForInput handle 10000
|
||
|
|
when (not reply) (fail "No reply from telegram")
|
||
|
|
|
||
|
|
-- read the whole response
|
||
|
|
size <- read . last . words <$> hGetLine handle
|
||
|
|
replicateM_ (size+1) (hGetChar handle)
|
||
|
|
putStrLn "ok"
|
||
|
|
|
||
|
|
|
||
|
|
-- Commands
|
||
|
|
type Name = String
|
||
|
|
type Arg = String
|
||
|
|
type Command = String
|
||
|
|
|
||
|
|
|
||
|
|
mkCommand :: Name -> Arg -> Arg -> Command
|
||
|
|
mkCommand name a b =
|
||
|
|
name ++ " " ++ escape a ++ " '" ++ escape b ++ "'"
|
||
|
|
where escape = replace "\'" "\\\'"
|
||
|
|
|
||
|
|
|
||
|
|
connect :: Command
|
||
|
|
connect = "dialog_list"
|
||
|
|
|
||
|
|
sendFile :: Arg -> Arg -> Command
|
||
|
|
sendFile = mkCommand "send_file"
|
||
|
|
|
||
|
|
message :: Arg -> Arg -> Command
|
||
|
|
message = mkCommand "msg"
|
||
|
|
|
||
|
|
nothing :: Command
|
||
|
|
nothing = "help"
|