gdritter repos lucien / master src / Main.hs
master

Tree @master (Download .tar.gz)

Main.hs @masterraw · history · blame

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Main where

import           Data.Aeson ((.:), (.=))
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
import qualified Network.HTTP.Types as HTTP
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
import qualified System.Environment as Env
import qualified Text.Read as Read

data WebhookRequest = WebhookRequest
  { wChannelId   :: Text.Text
  , wChannelName :: Text.Text
  , wTeamDomain  :: Text.Text
  , wTeamId      :: Text.Text
  , wPostId      :: Text.Text
  , wText        :: Text.Text
  , wTimestamp   :: Text.Text
  , wToken       :: Text.Text
  , wTriggerWord :: Text.Text
  , wUserId      :: Text.Text
  , wFileIds     :: Text.Text
  } deriving (Eq, Show)

instance Aeson.FromJSON WebhookRequest where
  parseJSON = Aeson.withObject "request" $ \obj -> do
    wChannelId   <- obj .: ""
    wChannelName <- obj .: ""
    wTeamDomain  <- obj .: ""
    wTeamId      <- obj .: ""
    wPostId      <- obj .: ""
    wText        <- obj .: ""
    wTimestamp   <- obj .: ""
    wToken       <- obj .: ""
    wTriggerWord <- obj .: ""
    wUserId      <- obj .: ""
    wFileIds     <- obj .: ""
    pure WebhookRequest { .. }

data WebhookResponse = WebhookResponse
  { rText :: Text.Text
  } deriving (Eq, Show)

instance Aeson.ToJSON WebhookResponse where
  toJSON WebhookResponse { .. } =
    Aeson.object [ "text" .= rText ]


main :: IO ()
main = do
  portVar <- Env.lookupEnv "PORT"
  let port = case portVar of
        Just x | Just p <- Read.readMaybe x -> p
        _ -> 8080
  Warp.run port $ \ r k ->
    case (Wai.requestMethod r, Wai.pathInfo r) of
      ("POST", []) -> body r >>= k
      _ -> k (Wai.responseLBS HTTP.status404 [] "not found")

body :: Wai.Request -> IO Wai.Response
body req = do
  bodyMb <- Aeson.eitherDecode <$> Wai.lazyRequestBody req
  case bodyMb of
    Right val ->
      let resp = WebhookResponse (wText val)
      in pure (Wai.responseLBS HTTP.status200 [] (Aeson.encode resp))
    Left _ ->
      pure (Wai.responseLBS HTTP.status500 [] "unable to parse payload")