Commit 0c559443087bac8b1dfe2da0397b45a4490996f6 - lucien

basic commit of mm webhook Getty Ritter 5 years ago

3 changed file(s) with 116 addition(s) and 0 deletion(s). Collapse all Expand all

+20

-0

.gitignore less more

	1	dist
	2	dist-*
	3	*~
	4	cabal-dev
	5	*.o
	6	*.hi
	7	*.chi
	8	*.chs.h
	9	*.dyn_o
	10	*.dyn_hi
	11	.hpc
	12	.hsenv
	13	.cabal-sandbox/
	14	cabal.sandbox.config
	15	*.prof
	16	*.aux
	17	*.hp
	18	*.eventlog
	19	cabal.project.local
	20	.ghc.environment.*

+24

-0

lucien.cabal less more

	1	name: lucien
	2	version: 0.1.0.0
	3	-- synopsis:
	4	-- description:
	5	license: BSD3
	6	author: Getty Ritter <gettylefou@gmail.com>
	7	maintainer: Getty Ritter <gettylefou@gmail.com>
	8	copyright: @2018 Getty Ritter
	9	-- category:
	10	build-type: Simple
	11	cabal-version: >=1.14
	12
	13	executable lucien
	14	hs-source-dirs: src
	15	main-is: Main.hs
	16	default-language: Haskell2010
	17	default-extensions: ScopedTypeVariables
	18	ghc-options: -Wall
	19	build-depends: base >=4.7 && <5
	20	, wai
	21	, warp
	22	, http-types
	23	, text
	24	, aeson⏎

+72

-0

src/Main.hs less more

	1	{-# LANGUAGE OverloadedStrings #-}
	2	{-# LANGUAGE RecordWildCards #-}
	3
	4	module Main where
	5
	6	import Data.Aeson ((.:), (.=))
	7	import qualified Data.Aeson as Aeson
	8	import qualified Data.Text as Text
	9	import qualified Network.HTTP.Types as HTTP
	10	import qualified Network.Wai as Wai
	11	import qualified Network.Wai.Handler.Warp as Warp
	12	import qualified System.Environment as Env
	13	import qualified Text.Read as Read
	14
	15	data WebhookRequest = WebhookRequest
	16	{ wChannelId :: Text.Text
	17	, wChannelName :: Text.Text
	18	, wTeamDomain :: Text.Text
	19	, wTeamId :: Text.Text
	20	, wPostId :: Text.Text
	21	, wText :: Text.Text
	22	, wTimestamp :: Text.Text
	23	, wToken :: Text.Text
	24	, wTriggerWord :: Text.Text
	25	, wUserId :: Text.Text
	26	, wFileIds :: Text.Text
	27	} deriving (Eq, Show)
	28
	29	instance Aeson.FromJSON WebhookRequest where
	30	parseJSON = Aeson.withObject "request" $ \obj -> do
	31	wChannelId <- obj .: ""
	32	wChannelName <- obj .: ""
	33	wTeamDomain <- obj .: ""
	34	wTeamId <- obj .: ""
	35	wPostId <- obj .: ""
	36	wText <- obj .: ""
	37	wTimestamp <- obj .: ""
	38	wToken <- obj .: ""
	39	wTriggerWord <- obj .: ""
	40	wUserId <- obj .: ""
	41	wFileIds <- obj .: ""
	42	pure WebhookRequest { .. }
	43
	44	data WebhookResponse = WebhookResponse
	45	{ rText :: Text.Text
	46	} deriving (Eq, Show)
	47
	48	instance Aeson.ToJSON WebhookResponse where
	49	toJSON WebhookResponse { .. } =
	50	Aeson.object [ "text" .= rText ]
	51
	52
	53	main :: IO ()
	54	main = do
	55	portVar <- Env.lookupEnv "PORT"
	56	let port = case portVar of
	57	Just x \| Just p <- Read.readMaybe x -> p
	58	_ -> 8080
	59	Warp.run port $ \ r k ->
	60	case (Wai.requestMethod r, Wai.pathInfo r) of
	61	("POST", []) -> body r >>= k
	62	_ -> k (Wai.responseLBS HTTP.status404 [] "not found")
	63
	64	body :: Wai.Request -> IO Wai.Response
	65	body req = do
	66	bodyMb <- Aeson.eitherDecode <$> Wai.lazyRequestBody req
	67	case bodyMb of
	68	Right val ->
	69	let resp = WebhookResponse (wText val)
	70	in pure (Wai.responseLBS HTTP.status200 [] (Aeson.encode resp))
	71	Left _ ->
	72	pure (Wai.responseLBS HTTP.status500 [] "unable to parse payload")