{-|
Module      : $Header$
Description : Adapter for communicating with Slack via the webhook based Events API
Copyright   : (c) Justus Adam, 2016
License     : BSD3
Maintainer  : dev@justus.science
Stability   : experimental
Portability : POSIX
-}
{-# LANGUAGE NamedFieldPuns #-}
module Marvin.Adapter.Slack.EventsAPI
    ( SlackAdapter, EventsAPI
    , SlackUserId, SlackChannelId
    , MkSlack
    ) where


import           Control.Concurrent.Async.Lifted
import           Control.Concurrent.Chan.Lifted
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Logger
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Maybe                      (fromMaybe)
import qualified Data.Text                       as T
import qualified Data.Text.Lazy                  as L
import qualified Data.Text.Lazy.Encoding         as L
import           Marvin.Adapter
import           Marvin.Adapter.Slack.Common
import           Marvin.Adapter.Slack.Types
import           Marvin.Interpolate.All
import           Network.HTTP.Types
import           Network.Wai
import           Network.Wai.Handler.Warp
import           Network.Wai.Handler.WarpTLS
import           Network.Wreq


eventAPIeventParser :: Value -> Parser (T.Text, Either L.Text (InternalType a))
eventAPIeventParser = withObject "expected object" $ \o -> do
    token <- o .: "token"
    type_ <- o .: "type"

    (token,) <$> case (type_ :: T.Text) of
        "url_verification" -> Left <$> o .: "challenge"
        "event_callback" -> Right <$> (o .: "event" >>= eventParser)
        _ -> fail "unknown wrapper event type"


runEventReceiver :: Chan (InternalType EventsAPI) -> AdapterM (SlackAdapter EventsAPI) ()
runEventReceiver evChan = do
    useTLS <- fromMaybe True <$> lookupFromAdapterConfig "use-tls"
    server <- if useTLS
        then do
            certfile <- requireFromAdapterConfig "certfile"
            keyfile <- requireFromAdapterConfig "keyfile"
            return $ runTLS $ tlsSettings certfile keyfile
        else return runSettings
    port <- fromMaybe 7000 <$> lookupFromAdapterConfig "port"
    expectedToken <- requireFromAdapterConfig "token"

    let warpSet = setPort port defaultSettings

    logFn <- askLoggerIO

    liftIO $ server warpSet $ \req resp -> flip runLoggingT logFn $
        let
            respond status headers body = liftIO $ resp $ responseLBS status headers body
        in  if requestMethod req == methodPost
                then do
                    bod <- liftIO $ lazyRequestBody req
                    case eitherDecode bod >>= parseEither eventAPIeventParser of
                        Left err -> do
                            logErrorN $(isT "Unreadable JSON event: '#{err}'")
                            respond notAcceptable406 [] ""
                        Right (token,_) | token /= expectedToken -> do
                            logErrorN $(isT "Recieved incorrect token: '#{token}'")
                            respond unauthorized401 [] ""
                        Right (_, Left challenge) -> do
                            logInfoN $(isT "Recieved challenge event: '#{challenge}'")
                            respond ok200 [] (L.encodeUtf8 challenge)
                        Right (_, Right ev) -> do
                            writeChan evChan ev
                            respond ok200 [] ""
                else respond methodNotAllowed405 [] ""


sendMessageLoop :: AdapterM (SlackAdapter EventsAPI) ()
sendMessageLoop = do
    SlackAdapter{outChannel} <- getAdapter
    forever $ do
        (SlackChannelId chan, msg) <- readChan outChannel
        res <- execAPIMethod
            (const $ return ())
            "chat.postMessage"
            [ "channel" := chan
            , "text" := msg
            ]
        case res of
            Left err -> logErrorN $(isT "Sending message failed: #{err}")
            Right () -> return ()


-- | Recieve events as a server via HTTP webhook (not implemented yet)
data EventsAPI


instance MkSlack EventsAPI where
    mkAdapterId = "slack-events"
    initIOConnections inChan = do
        void $ async $ runEventReceiver inChan
        sendMessageLoop