|
| 1 | +{-# LANGUAGE GeneralizedNewtypeDeriving #-} |
| 2 | +{-# LANGUAGE OverloadedStrings #-} |
| 3 | +{-# LANGUAGE RecordWildCards #-} |
| 4 | + |
1 | 5 | module Lib |
2 | | - ( someFunc |
3 | | - ) where |
| 6 | + ( runZendeskMain |
| 7 | + , collectEmails |
| 8 | + , processTicket |
| 9 | + , processTickets |
| 10 | + , fetchTickets |
| 11 | + , showStatistics |
| 12 | + ) where |
4 | 13 |
|
5 | 14 | import Universum |
6 | | --- TODO(ks): Here we want to import the functionality we require in cardano-report-server. |
7 | | -someFunc :: IO () |
8 | | -someFunc = putTextLn "someFunc" |
| 15 | + |
| 16 | +import Data.Attoparsec.Text.Lazy (eitherResult, parse) |
| 17 | +import Data.Text (isInfixOf, stripEnd) |
| 18 | + |
| 19 | +import CLI (CLI (..), getCliArgs) |
| 20 | +import LogAnalysis.Classifier (extractErrorCodes, extractIssuesFromLogs, |
| 21 | + prettyFormatAnalysis, prettyFormatLogReadError, |
| 22 | + prettyFormatNoIssues) |
| 23 | +import LogAnalysis.KnowledgeCSVParser (parseKnowLedgeBase) |
| 24 | +import LogAnalysis.Types (ErrorCode (..), Knowledge, renderErrorCode, setupAnalysis) |
| 25 | +import Util (extractLogsFromZip) |
| 26 | +import Zendesk (App, Attachment (..), Comment (..), Config (..), RequestType (..), |
| 27 | + TicketId, TicketInfo (..), TicketTag (..), ZendeskLayer (..), |
| 28 | + ZendeskResponse (..), asksZendeskLayer, assignToPath, defaultConfig, |
| 29 | + knowledgebasePath, renderTicketStatus, runApp, tokenPath) |
| 30 | + |
| 31 | +------------------------------------------------------------ |
| 32 | +-- Functions |
| 33 | +------------------------------------------------------------ |
| 34 | + |
| 35 | +runZendeskMain :: IO () |
| 36 | +runZendeskMain = do |
| 37 | + args <- getCliArgs |
| 38 | + putTextLn "Welcome to Zendesk classifier!" |
| 39 | + token <- readFile tokenPath -- Zendesk token |
| 40 | + assignFile <- readFile assignToPath -- Select assignee |
| 41 | + knowledges <- setupKnowledgebaseEnv knowledgebasePath |
| 42 | + assignTo <- case readEither assignFile of |
| 43 | + Right agentid -> return agentid |
| 44 | + Left err -> error err |
| 45 | + let cfg' = defaultConfig |
| 46 | + { cfgToken = stripEnd token |
| 47 | + , cfgAssignTo = assignTo |
| 48 | + , cfgKnowledgebase = knowledges |
| 49 | + } |
| 50 | + let getAgentId = zlGetAgentId . cfgZendeskLayer $ cfg' |
| 51 | + agentId <- runApp getAgentId cfg' |
| 52 | + let cfg = cfg' { cfgAgentId = agentId } |
| 53 | + -- At this point, the configuration is set up and there is no point in using a pure IO. |
| 54 | + case args of |
| 55 | + CollectEmails -> runApp collectEmails cfg |
| 56 | + (ProcessTicket ticketId) -> runApp (processTicket ticketId) cfg |
| 57 | + ProcessTickets -> runApp processTickets cfg |
| 58 | + FetchTickets -> runApp fetchTickets cfg |
| 59 | + ShowStatistics -> runApp showStatistics cfg |
| 60 | + |
| 61 | + |
| 62 | +collectEmails :: App () |
| 63 | +collectEmails = do |
| 64 | + cfg <- ask |
| 65 | + -- We first fetch the function from the configuration |
| 66 | + listTickets <- asksZendeskLayer zlListTickets |
| 67 | + putTextLn $ "Classifier is going to extract emails requested by: " <> cfgEmail cfg |
| 68 | + tickets <- listTickets Requested |
| 69 | + putTextLn $ "There are " <> show (length tickets) <> " tickets requested by this user." |
| 70 | + let ticketIds = foldr (\TicketInfo{..} acc -> ticketId : acc) [] tickets |
| 71 | + mapM_ extractEmailAddress ticketIds |
| 72 | + |
| 73 | +processTicket :: TicketId -> App () |
| 74 | +processTicket ticketId = do |
| 75 | + -- We first fetch the function from the configuration |
| 76 | + getTicketInfo <- asksZendeskLayer zlGetTicketInfo |
| 77 | + putTextLn "Processing single ticket" |
| 78 | + ticketInfo <- getTicketInfo ticketId |
| 79 | + processTicketAndId ticketInfo |
| 80 | + putTextLn "Process finished, please see the following url" |
| 81 | + putTextLn $ "https://iohk.zendesk.com/agent/tickets/" <> show ticketId |
| 82 | + |
| 83 | +processTickets :: App () |
| 84 | +processTickets = do |
| 85 | + cfg <- ask |
| 86 | + sortedTicketIds <- processBatchTickets cfg |
| 87 | + mapM_ processTicketAndId sortedTicketIds |
| 88 | + putTextLn "All the tickets has been processed." |
| 89 | + |
| 90 | +fetchTickets :: App () |
| 91 | +fetchTickets = do |
| 92 | + cfg <- ask |
| 93 | + sortedTicketIds <- processBatchTickets cfg |
| 94 | + mapM_ (putTextLn . show) sortedTicketIds |
| 95 | + putTextLn "All the tickets has been processed." |
| 96 | + |
| 97 | +showStatistics :: App () |
| 98 | +showStatistics = do |
| 99 | + cfg <- ask |
| 100 | + -- We first fetch the function from the configuration |
| 101 | + listTickets <- asksZendeskLayer zlListTickets |
| 102 | + |
| 103 | + putTextLn $ "Classifier is going to gather ticket information assigned to: " <> cfgEmail cfg |
| 104 | + liftIO printWarning |
| 105 | + tickets <- listTickets Assigned |
| 106 | + liftIO $ printTicketCountMessage tickets (cfgEmail cfg) |
| 107 | + |
| 108 | + |
| 109 | +processBatchTickets :: Config -> App [TicketInfo] |
| 110 | +processBatchTickets cfg = do |
| 111 | + |
| 112 | + -- We first fetch the function from the configuration |
| 113 | + listTickets <- asksZendeskLayer zlListTickets |
| 114 | + |
| 115 | + putTextLn $ "Classifier is going to process tickets assign to: " <> cfgEmail cfg |
| 116 | + liftIO printWarning |
| 117 | + tickets <- listTickets Assigned |
| 118 | + |
| 119 | + let filteredTicketIds = filterAnalyzedTickets tickets |
| 120 | + let sortedTicketIds = sortBy compare filteredTicketIds |
| 121 | + |
| 122 | + putTextLn $ "There are " <> show (length sortedTicketIds) <> " unanalyzed tickets." |
| 123 | + putTextLn "Processing tickets, this may take hours to finish." |
| 124 | + |
| 125 | + pure sortedTicketIds |
| 126 | + |
| 127 | + |
| 128 | +-- | Warning |
| 129 | +printWarning :: IO () |
| 130 | +printWarning = putTextLn "Note that this process may take a while. Please do not kill the process" |
| 131 | + |
| 132 | +-- | Print how many tickets are assinged, analyzed, and unanalyzed |
| 133 | +printTicketCountMessage :: [TicketInfo] -> Text -> IO () |
| 134 | +printTicketCountMessage tickets email = do |
| 135 | + let ticketCount = length tickets |
| 136 | + putTextLn "Done!" |
| 137 | + putTextLn $ "There are currently " <> show ticketCount |
| 138 | + <> " tickets in the system assigned to " <> email |
| 139 | + let filteredTicketCount = length $ filterAnalyzedTickets tickets |
| 140 | + putTextLn $ show (ticketCount - filteredTicketCount) |
| 141 | + <> " tickets has been analyzed by the classifier." |
| 142 | + putTextLn $ show filteredTicketCount <> " tickets are not analyzed." |
| 143 | + putTextLn "Below are statistics:" |
| 144 | + let tagGroups = sortTickets tickets |
| 145 | + mapM_ (\(tag, count) -> putTextLn $ tag <> ": " <> show count) tagGroups |
| 146 | + |
| 147 | +-- | Sort the ticket so we can see the statistics |
| 148 | +sortTickets :: [TicketInfo] -> [(Text, Int)] |
| 149 | +sortTickets tickets = |
| 150 | + let extractedTags = foldr (\TicketInfo{..} acc -> ticketTags <> acc) [] tickets -- Extract tags from tickets |
| 151 | + tags2Filter = ["s3", "s2", "cannot-sync", "closed-by-merge" |
| 152 | + , "web_widget", "analyzed-by-script"] |
| 153 | + filteredTags = filter (`notElem` tags2Filter) extractedTags -- Filter tags |
| 154 | + groupByTags :: [ Text ] -> [(Text, Int)] |
| 155 | + groupByTags ts = map (\l@(x:_) -> (x, length l)) (group $ sort ts) -- Group them |
| 156 | + in groupByTags filteredTags |
| 157 | + |
| 158 | +-- | Read CSV file and setup knowledge base |
| 159 | +setupKnowledgebaseEnv :: FilePath -> IO [Knowledge] |
| 160 | +setupKnowledgebaseEnv path = do |
| 161 | + kfile <- toLText <$> readFile path |
| 162 | + let kb = parse parseKnowLedgeBase kfile |
| 163 | + case eitherResult kb of |
| 164 | + Left e -> error $ toText e |
| 165 | + Right ks -> return ks |
| 166 | + |
| 167 | +-- | Collect email |
| 168 | +extractEmailAddress :: TicketId -> App () |
| 169 | +extractEmailAddress ticketId = do |
| 170 | + -- Fetch the function from the configuration. |
| 171 | + getTicketComments <- asksZendeskLayer zlGetTicketComments |
| 172 | + |
| 173 | + comments <- getTicketComments ticketId |
| 174 | + let commentWithEmail = cBody $ fromMaybe (error "No comment") (safeHead comments) |
| 175 | + let emailAddress = fromMaybe (error "No email") (safeHead $ lines commentWithEmail) |
| 176 | + liftIO $ guard ("@" `isInfixOf` emailAddress) |
| 177 | + liftIO $ appendFile "emailAddress.txt" (emailAddress <> "\n") |
| 178 | + liftIO $ putTextLn emailAddress |
| 179 | + |
| 180 | +-- | Process specifig ticket id (can be used for testing) only inspects the one's with logs |
| 181 | +processTicketAndId :: TicketInfo -> App () |
| 182 | +processTicketAndId ticketInfo@TicketInfo{..} = do |
| 183 | + |
| 184 | + getTicketComments <- asksZendeskLayer zlGetTicketComments |
| 185 | + |
| 186 | + comments <- getTicketComments ticketId |
| 187 | + |
| 188 | + -- Filter tickets without logs |
| 189 | + -- Could analyze the comments but I don't see it useful.. |
| 190 | + let commentsWithAttachments :: [Comment] |
| 191 | + commentsWithAttachments = filter (\x -> length (cAttachments x) > 0) comments |
| 192 | + |
| 193 | + -- Filter out ticket without logs |
| 194 | + let attachments :: [Attachment] |
| 195 | + attachments = concatMap cAttachments commentsWithAttachments |
| 196 | + |
| 197 | + let justLogs :: [Attachment] |
| 198 | + justLogs = filter (\x -> "application/zip" == aContentType x) attachments |
| 199 | + |
| 200 | + mapM_ (inspectAttachmentAndPostComment ticketInfo) justLogs |
| 201 | + |
| 202 | +-- | Inspect attachment then post comment to the ticket |
| 203 | +inspectAttachmentAndPostComment :: TicketInfo -> Attachment -> App () |
| 204 | +inspectAttachmentAndPostComment ticketInfo attachment = do |
| 205 | + liftIO $ putTextLn $ "Analyzing ticket: " <> show ticketInfo |
| 206 | + zendeskResponse <- inspectAttachment ticketInfo attachment |
| 207 | + |
| 208 | + postTicketComment <- asksZendeskLayer zlPostTicketComment |
| 209 | + postTicketComment zendeskResponse |
| 210 | + |
| 211 | +-- | Given number of file of inspect, knowledgebase and attachment, |
| 212 | +-- analyze the logs and return the results. |
| 213 | +-- |
| 214 | +-- The results are following: |
| 215 | +-- |
| 216 | +-- __(comment, tags, bool of whether is should be public comment)__ |
| 217 | +inspectAttachment :: TicketInfo -> Attachment -> App ZendeskResponse |
| 218 | +inspectAttachment ticketInfo@TicketInfo{..} att = do |
| 219 | + |
| 220 | + Config{..} <- ask |
| 221 | + |
| 222 | + getAttachment <- asksZendeskLayer zlGetAttachment |
| 223 | + |
| 224 | + rawlog <- getAttachment att -- Get attachment |
| 225 | + let results = extractLogsFromZip cfgNumOfLogsToAnalyze rawlog |
| 226 | + |
| 227 | + case results of |
| 228 | + Left _ -> do |
| 229 | + |
| 230 | + liftIO . putStrLn . renderErrorCode $ SentLogCorrupted |
| 231 | + |
| 232 | + pure ZendeskResponse |
| 233 | + { zrTicketId = ticketId |
| 234 | + , zrComment = prettyFormatLogReadError ticketInfo |
| 235 | + , zrTags = [renderErrorCode SentLogCorrupted] |
| 236 | + , zrIsPublic = cfgIsCommentPublic |
| 237 | + } |
| 238 | + Right result -> do |
| 239 | + let analysisEnv = setupAnalysis cfgKnowledgebase |
| 240 | + let eitherAnalysisResult = extractIssuesFromLogs result analysisEnv |
| 241 | + |
| 242 | + case eitherAnalysisResult of |
| 243 | + Right analysisResult -> do |
| 244 | + let errorCodes = extractErrorCodes analysisResult |
| 245 | + let commentRes = prettyFormatAnalysis analysisResult ticketInfo |
| 246 | + |
| 247 | + let fErrorCode = foldr (\errorCode acc -> errorCode <> ";" <> acc) "" errorCodes |
| 248 | + |
| 249 | + liftIO . putTextLn $ fErrorCode |
| 250 | + |
| 251 | + pure ZendeskResponse |
| 252 | + { zrTicketId = ticketId |
| 253 | + , zrComment = commentRes |
| 254 | + , zrTags = errorCodes |
| 255 | + , zrIsPublic = cfgIsCommentPublic |
| 256 | + } |
| 257 | + |
| 258 | + Left _ -> do |
| 259 | + |
| 260 | + liftIO . putStrLn . renderTicketStatus $ NoKnownIssue |
| 261 | + |
| 262 | + pure ZendeskResponse |
| 263 | + { zrTicketId = ticketId |
| 264 | + , zrComment = prettyFormatNoIssues ticketInfo |
| 265 | + , zrTags = [renderTicketStatus NoKnownIssue] |
| 266 | + , zrIsPublic = cfgIsCommentPublic |
| 267 | + } |
| 268 | + |
| 269 | +-- | Filter analyzed tickets |
| 270 | +filterAnalyzedTickets :: [TicketInfo] -> [TicketInfo] |
| 271 | +filterAnalyzedTickets ticketsInfo = |
| 272 | + filter ticketsFilter ticketsInfo |
| 273 | + where |
| 274 | + ticketsFilter :: TicketInfo -> Bool |
| 275 | + ticketsFilter ticketInfo = |
| 276 | + isTicketAnalyzed ticketInfo && isTicketOpen ticketInfo && isTicketBlacklisted ticketInfo |
| 277 | + |
| 278 | + isTicketAnalyzed :: TicketInfo -> Bool |
| 279 | + isTicketAnalyzed TicketInfo{..} = (renderTicketStatus AnalyzedByScriptV1_0) `notElem` ticketTags |
| 280 | + |
| 281 | + isTicketOpen :: TicketInfo -> Bool |
| 282 | + isTicketOpen TicketInfo{..} = ticketStatus == "open" -- || ticketStatus == "new" |
| 283 | + |
| 284 | + -- | If we have a ticket we are having issues with... |
| 285 | + isTicketBlacklisted :: TicketInfo -> Bool |
| 286 | + isTicketBlacklisted TicketInfo{..} = ticketId `notElem` [9377,10815] |
| 287 | + |
0 commit comments