gdritter repos lucien / master
basic commit of mm webhook Getty Ritter 6 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")