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 Data.Text.Encoding (encodeUtf8)
import Network.HostName (getHostName) import Network.HostName (getHostName)
import Network.Socket (SockAddr(SockAddrUnix)) 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.Directory (findExecutable)
import System.Exit (exitWith) import System.Exit (exitWith)
import System.Exit.Codes (codeTempFail) import System.Exit.Codes (codeTempFail)
@ -32,12 +32,12 @@ import TiedoteMD.State
import TiedoteMD.Types import TiedoteMD.Types
import TiedoteMD.Debug import TiedoteMD.Debug
serverMain :: SockAddr -> Mailbox -> FilePath -> FilePath -> IO () serverMain :: SockAddr -> Mailbox -> FilePath -> FilePath -> Int -> IO ()
serverMain socket mail repoPath sendmailPath = do serverMain socket mail repoPath sendmailPath port = do
acid <- openLocalState $ emptyState acid <- openLocalState $ emptyState
_ <- forkIO $ acidServerSockAddr skipAuthenticationCheck socket acid _ <- forkIO $ acidServerSockAddr skipAuthenticationCheck socket acid
queueMessages acid queueMessages acid
_ <- forkIO $ scotty 3000 $ do _ <- forkIO $ scotty port $ do
defaultHandler $ liftAndCatchIO . LT.putStrLn -- Don't return exceptions to clients defaultHandler $ liftAndCatchIO . LT.putStrLn -- Don't return exceptions to clients
post "/" $ liftAndCatchIO $ void $ forkIO $ updateMessages acid repoPath post "/" $ liftAndCatchIO $ void $ forkIO $ updateMessages acid repoPath
updateMessages acid repoPath updateMessages acid repoPath
@ -59,7 +59,7 @@ printStateMain socket = do
printState acid printState acid
data Config = Config { socketPath :: FilePath, mail :: Mailbox, sendmailCommand :: String, runMode :: RunMode } deriving Show 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 :: Maybe Mailbox -> Parser Config
config mail = Config config mail = Config
@ -71,7 +71,9 @@ config mail = Config
<> command "state" (info (pure Print) (progDesc "Print the server's current state"))) <> command "state" (info (pure Print) (progDesc "Print the server's current state")))
serverCommand :: Parser RunMode 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 :: ReadM Mailbox
readMailbox = eitherReader $ parse (mailbox defaultCharsets) . encodeUtf8 . T.pack readMailbox = eitherReader $ parse (mailbox defaultCharsets) . encodeUtf8 . T.pack
@ -88,4 +90,4 @@ main = do
case args of case args of
Config {runMode = Recieve, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath Config {runMode = Recieve, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath
Config {runMode = Print, ..} -> printStateMain (SockAddrUnix socketPath) 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