{-# LANGUAGE OverloadedStrings #-}

module Main where

import Network
import Network.HTTP

import System.IO (hSetBuffering, hGetLine, hPutStrLn, BufferMode(..), Handle)
import Control.Concurrent (forkIO)

portN :: Int
portN = 8843

main :: IO ()
main = do
  let port = fromIntegral (portN :: Int)
  sock <- listenOn $ PortNumber port
  putStrLn $ "listening on " ++ show port
  sockAccept sock

sockAccept :: Socket -> IO ()
sockAccept = \sock -> do
    (handle, _hostname, _portNumber) <- accept sock
    hSetBuffering handle NoBuffering

    putStrLn $ "Accepted a new connection ;p"
    _ <- forkIO $ commandDispatcher handle

    sockAccept sock

-------------------------
-- command dispatching --
-------------------------
type Command = Handle -> [String] -> IO ()

commandDispatcher :: Handle -> IO ()
commandDispatcher handle = do
  cmd <- hGetLine handle >>= return . words

  case head cmd of
    "echo" -> echoCommand handle cmd
    "POST" -> callWebHook handle cmd
    _ -> hPutStrLn handle "Unknown command"

  commandDispatcher handle

echoCommand :: Command
echoCommand handle cmd = hPutStrLn handle $ unwords cmd

callWebHook :: Command
callWebHook handle cmd = do
  let ("POST" : url : _) = cmd
  let body = "{\"channel\":\"@milhouse\",\"username\":\"toninho-do-deploy\",\"text\": \"this was sent from Haskell\"}"
  let request = postRequestWithBody url "application/json" body

  result <- simpleHTTP request
  case result of
    Left _ -> hPutStrLn handle "something went wrong!"
    Right _ -> hPutStrLn handle "done!"
