main :: IO ()
main = echo "Let's code some Haskell"

-- Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import           NSQ
import           Protolude
import           Turtle

-- dotenv
import qualified Configuration.Dotenv       as Dotenv
import           Configuration.Dotenv.Types


-- main parser
parser :: Parser (IO ())
parser = parseMainCommand
     <|> parseProcessNsqTopic

-- main command
parseMainCommand :: Parser (IO ())
parseMainCommand = pure mainCommand

mainCommand :: IO ()
mainCommand = echo "Use \"-h\" argument for help"

-- topic subcommand
-- stack exec nsq-message-checker -- topic all
-- stack exec nsq-message-checker -- topic optimization_rule
parseProcessNsqTopic :: Parser (IO ())
parseProcessNsqTopic =
  fmap
    processNsq
    (subcommand
       "topic"
       "Process specified topic"
       (argText "topic_name" "What topic should be processed? (all for all topics)"))

-- main
main :: IO ()
main = do
  _ <- Dotenv.loadFile defaultConfig
  cmd <- options "NSQ Statistic Checker" parser
  cmd

{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}

module Types where

import           Data.Aeson
import           Data.Aeson.Casing (aesonPrefix, snakeCase)
import           Data.Text         as T
import           Protolude

-- cassava
import           Data.Csv          (FromRecord, ToNamedRecord, ToRecord)
import qualified Data.Csv          as Cassava

-- | Client data type.
data Client = Client
  { clientClientId                      :: Text -- ^ Client ID.
  , clientHostname                      :: Text -- ^ Hostname of the client.
  , clientVersion                       :: Text -- ^ Client version.
  , clientRemoteAddress                 :: Text -- ^ Remote address of client.
  , clientState                         :: Int -- ^ State of client.
  , clientReadyCount                    :: Int -- ^ Amount of ready messages.
  , clientInFlightCount                 :: Int -- ^ Amount of flight messages.
  , clientMessageCount                  :: Int -- ^ Amount of messages.
  , clientFinishCount                   :: Int -- ^ Amount of finished messages.
  , clientRequeueCount                  :: Int -- ^ Amount of requeued messages.
  , clientConnectTs                     :: Int
  , clientSampleRate                    :: Int
  , clientDeflate                       :: Bool
  , clientSnappy                        :: Bool
  , clientUserAgent                     :: Text
  , clientTls                           :: Bool
  , clientTlsCipherSuite                :: Text
  , clientTlsVersion                    :: Text
  , clientTlsNegotiatedProtocol         :: Text
  , clientTlsNegotiatedProtocolIsMutual :: Bool
  } deriving (Show, Generic)

instance ToJSON Client where
  toJSON = genericToJSON $ aesonPrefix snakeCase

instance FromJSON Client where
  parseJSON = genericParseJSON $ aesonPrefix snakeCase

-- | Data type for channel.
data Channel = Channel
  { channelChannelName   :: Text -- ^ The name of the channel.
  , channelDepth         :: Int
  , channelBackendDepth  :: Int
  , channelInFlightCount :: Int -- ^ Amount of flight messages.
  , channelDeferredCount :: Int -- ^ Amount of deferred messages.
  , channelMessageCount  :: Int -- ^ Amount of messages.
  , channelRequeueCount  :: Int -- ^ Amount of requeued messages.
  , channelTimeoutCount  :: Int
  , channelClients       :: [Client]
  , channelPaused        :: Bool
  } deriving (Show, Generic)

instance ToJSON Channel where
  toJSON = genericToJSON $ aesonPrefix snakeCase

instance FromJSON Channel where
  parseJSON = genericParseJSON $ aesonPrefix snakeCase

data Topic = Topic
  { topicTopicName    :: Text
  , topicChannels     :: [Channel]
  , topicDepth        :: Int
  , topicBackendDepth :: Int
  , topicMessageCount :: Int
  , topicPaused       :: Bool
  } deriving (Show, Generic)

instance ToJSON Topic where
  toJSON = genericToJSON $ aesonPrefix snakeCase

instance FromJSON Topic where
  parseJSON = genericParseJSON $ aesonPrefix snakeCase

data Statistic = Statistic
  { statisticVersion   :: Text
  , statisticHealth    :: Text
  , statisticTopics    :: [Topic]
  , statisticStartTime :: Int
  } deriving (Show, Generic)

instance ToJSON Statistic where
  toJSON = genericToJSON $ aesonPrefix snakeCase

instance FromJSON Statistic where
  parseJSON = genericParseJSON $ aesonPrefix snakeCase

data Report = Report
  { reportTopicName    :: Text
  , reportMessage      :: Int
  , reportTotalMessage :: Int
  , reportConnection   :: Int
  , reportDate         :: Text
  , reportTime         :: Text
  } deriving (Generic, Show)

instance FromRecord Report

instance ToRecord Report

instance ToNamedRecord Report where
  toNamedRecord Report {..} =
    Cassava.namedRecord
      [ "Topic Name" Cassava..= reportTopicName
      , "Message" Cassava..= reportMessage
      , "Total Message" Cassava..= reportTotalMessage
      , "Connection" Cassava..= reportConnection
      , "Date" Cassava..= reportDate
      , "Time" Cassava..= reportTime
      ]

-- NSQ.hs

-- | Process NSQ `Topic`.
processNsq :: Text -> IO ()
processNsq topicName = do
  nsqStatisticURL <- SE.getEnv "NSQ_STAT_URL"
  let statisticURL topic channel =
        nsqStatisticURL
          ++ "?format=json&topic="
          ++ topic
          ++ "&channel="
          ++ channel
  -- we hardcode the channel name for now (which is "job"), but we can also
  -- send it together with topic name as an argument
  jsonString <- lookupNsqStatistic $ statisticURL (unpack topicName) "job"
  let statistic = eitherDecode jsonString :: Either String Statistic
  case statistic of
    Left  err  -> putStrLn err
    Right stat -> processTopicStatistic stat topicName
  sendSlackNotification

-- NSQ.hs

-- | Lookup `Topic`'s `Statistic`.
lookupNsqStatistic :: String -> IO BSL.ByteString
lookupNsqStatistic url = simpleHttp url

-- NSQ.hs

-- | Process `Topic`'s `Statistic` and generate `Report` file.
processTopicStatistic :: Statistic -> Text -> IO ()
processTopicStatistic statistic topicName = do
  topicReports <- breakdownTopicReport (statisticTopics statistic) topicName
  reportToCSV $ L.foldl' (++) [] topicReports

-- NSQ.hs

-- | Map over `Topic` and return list of `Report`s.
breakdownTopicReport :: [Topic] -> Text -> IO [[Report]]
breakdownTopicReport topics topicName
  | topicName == "all" = do
    mapM (iterateTopicName topics) topicNames
  | otherwise = do
    mapM (iterateTopicName topics) [topicName]

-- NSQ.hs

-- | Populate `Report` for specified `Topic`.
iterateTopicName :: [Topic] -> Text -> IO [Report]
iterateTopicName topics topicName = do
  let topic    = filterTopicName topics topicName
      channels = case topic of
        Just t  -> topicChannels t :: [Channel]
        Nothing -> []
  reports <- populateReport topic channels
  return reports

-- | Get `Topic` from array of `Topic`.
filterTopicName :: [Topic] -> Text -> Maybe Topic
filterTopicName topics topicName =
  case L.filter (\x -> topicTopicName x == topicName) topics of
    t : _ -> Just t
    _     -> Nothing

-- | Map over the `Channel`s to get the `Report`s.
populateReport :: Maybe Topic -> [Channel] -> IO [Report]
populateReport Nothing      _     = return []
populateReport (Just topic) chans = mapM (populRep topic) chans
 where
  populRep t channel = do
    formattedDate <- getFormattedDate
    formattedTime <- getFormattedTime
    return $ Report (topicTopicName t)
                    (channelDepth channel)
                    (channelMessageCount channel)
                    (L.length $ channelClients channel)
                    formattedDate
                    formattedTime

-- | Get date which has been formatted into string.
getFormattedDate :: IO Text
getFormattedDate = do
  currentLocalTime <- getZonedTime
  return $ T.pack $ formatTime defaultTimeLocale "%Y-%m-%d" currentLocalTime

-- | Get time which has been formatted into string.
getFormattedTime :: IO Text
getFormattedTime = do
  currentLocalTime <- getZonedTime
  return $ T.pack $ formatTime defaultTimeLocale "%H:%M" currentLocalTime

-- NSQ.hs

-- | Put `Report`s into csv file.
reportToCSV :: [Report] -> IO ()
reportToCSV reports = do
  csvFile <- SE.getEnv "CSV_FILE"
  BSL.appendFile csvFile $ Cassava.encodeByName reportHeader reports

-- | List of header to be used in `Report`.
reportHeader :: Header
reportHeader = Vector.fromList
  ["Topic Name", "Message", "Total Message", "Connection", "Date", "Time"]

-- NSQ.hs

-- | Send notification to slack channel using web hook.
sendSlackNotification :: IO ()
sendSlackNotification = do
  manager <- newManager tlsManagerSettings
  let requestObject = object
        [ "name" .= ("NSQ Statistic Checker" :: String)
        , "text" .= ("NSQ Statistic Report has been compiled" :: String)
        ]

  slackURL       <- SE.getEnv "SLACK_URL"
  initialRequest <- parseRequest slackURL

  let request = initialRequest
        { method         = "POST"
        , requestHeaders = [("Content-Type", "application/json")]
        , requestBody    = RequestBodyLBS $ encode requestObject
        }
  response <- httpLbs request manager
  putStrLn $ responseBody response