OMS/tiedote.md
3
0
Fork 0
Code Issues 14 Pull Requests Projects Releases Wiki Activity

Lisää valitsin webhookpalvelimen portille

Browse Source
This commit is contained in:
Saku Laesvuori 2023-09-12 17:20:35 +03:00
parent 925cee9839
commit 67eb35f7d3
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
1 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Main.hs
View File

@ -15,7 +15,7 @@ import Data.MIME.Charset (defaultCharsets)
import Data.Text.Encoding (encodeUtf8)
import Network.HostName (getHostName)
import Network.Socket (SockAddr(SockAddrUnix))
import Options.Applicative (Parser, ReadM, eitherReader, execParser, strOption, option, hsubparser, command, info, progDesc, long, short, metavar, value, showDefault, help, header, fullDesc, helper, (<**>))
import Options.Applicative (Parser, ReadM, auto, eitherReader, execParser, strOption, option, hsubparser, command, info, progDesc, long, short, metavar, value, showDefault, help, header, fullDesc, helper, (<**>))
import System.Directory (findExecutable)
import System.Exit (exitWith)
import System.Exit.Codes (codeTempFail)
@ -32,12 +32,12 @@ import TiedoteMD.State
import TiedoteMD.Types
import TiedoteMD.Debug
serverMain :: SockAddr -> Mailbox -> FilePath -> FilePath -> IO ()
serverMain socket mail repoPath sendmailPath = do
serverMain :: SockAddr -> Mailbox -> FilePath -> FilePath -> Int -> IO ()
serverMain socket mail repoPath sendmailPath port = do
acid <- openLocalState $ emptyState
_ <- forkIO $ acidServerSockAddr skipAuthenticationCheck socket acid
queueMessages acid
_ <- forkIO $ scotty 3000 $ do
_ <- forkIO $ scotty port $ do
defaultHandler $ liftAndCatchIO . LT.putStrLn -- Don't return exceptions to clients
post "/" $ liftAndCatchIO $ void $ forkIO $ updateMessages acid repoPath
updateMessages acid repoPath
@ -59,7 +59,7 @@ printStateMain socket = do
printState acid
data Config = Config { socketPath :: FilePath, mail :: Mailbox, sendmailCommand :: String, runMode :: RunMode } deriving Show
data RunMode = Server { repoPath :: FilePath } | Recieve | Print deriving Show
data RunMode = Server { repoPath :: FilePath, portNumber :: Int } | Recieve | Print deriving Show
config :: Maybe Mailbox -> Parser Config
config mail = Config
@ -71,7 +71,9 @@ config mail = Config
<> command "state" (info (pure Print) (progDesc "Print the server's current state")))
serverCommand :: Parser RunMode
serverCommand = Server <$> strOption (long "repository" <> short 'r' <> metavar "DIRECTORY" <> value "/var/lib/tiedote.md/git-repo" <> showDefault <> help "Path to git repository")
serverCommand = Server
<$> strOption (long "repository" <> short 'r' <> metavar "DIRECTORY" <> value "/var/lib/tiedote.md/git-repo" <> showDefault <> help "Path to git repository")
<*> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 3000 <> showDefault <> help "TCP port number to listen on for webhook notifications")
readMailbox :: ReadM Mailbox
readMailbox = eitherReader $ parse (mailbox defaultCharsets) . encodeUtf8 . T.pack
@ -88,4 +90,4 @@ main = do
case args of
Config {runMode = Recieve, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath
Config {runMode = Print, ..} -> printStateMain (SockAddrUnix socketPath)
Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath
Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath portNumber