From a9c5d87dde1bf5fb76d06d8515a32fa4f507906d Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Mon, 11 Jun 2018 19:17:21 +0900 Subject: [PATCH 01/15] Add test cases --- test/Spec.hs | 83 ++++++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 74 insertions(+), 9 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 68bf93d..c617140 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -2,13 +2,15 @@ module Main where import Universum -import Test.Hspec (Spec, hspec, describe, it, pending) +import Test.Hspec (Spec, describe, hspec, it, pending) import Test.Hspec.QuickCheck (modifyMaxSuccess) -import Test.QuickCheck (arbitrary, forAll, listOf1) -import Test.QuickCheck.Monadic (monadicIO, pre, run, assert) +import Test.QuickCheck (Gen, arbitrary, forAll, listOf1) +import Test.QuickCheck.Monadic (assert, monadicIO, pre, run) -import Zendesk -import Lib +import Lib (processTicket, listAndSortTickets) +import Zendesk (App, Comment (..), Config (..), IOLayer (..), TicketInfo (..), + ZendeskLayer (..), ZendeskResponse (..), basicIOLayer, defaultConfig, + emptyZendeskLayer, runApp) -- TODO(ks): What we are really missing is a realistic @Gen ZendeskLayer m@. @@ -120,10 +122,10 @@ processTicketSpec = -- Check we have some comments. assert $ length zendeskComments == 0 - it "processes ticket, with comments" $ do + it "processes ticket, with comments" $ forAll arbitrary $ \(ticketInfo :: TicketInfo) -> - forAll (listOf1 arbitrary) $ \(listTickets) -> do - forAll (listOf1 arbitrary) $ \(comments) -> do + forAll (listOf1 arbitrary) $ \(listTickets) -> + forAll (listOf1 arbitrary) $ \(comments) -> monadicIO $ do @@ -150,7 +152,70 @@ processTicketSpec = zendeskResponses <- run appExecution -- Check we have some comments. - assert $ length zendeskResponses > 0 + assert $ not (null zendeskResponses) + + it "process ticket, with no attachments" $ + forAll (listOf1 genCommentWithNoAttachment) $ \(commentsWithoutAttachment :: [Comment]) -> + forAll arbitrary $ \ticketInfo -> + monadicIO $ do + + let stubbedZendeskLayer :: ZendeskLayer App + stubbedZendeskLayer = + emptyZendeskLayer + { zlGetTicketComments = \_ -> pure commentsWithoutAttachment + , zlGetTicketInfo = \_ -> pure ticketInfo + , zlPostTicketComment = \_ -> pure () + } + + let stubbedConfig :: Config + stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer + + let appExecution :: IO [ZendeskResponse] + appExecution = runApp (processTicket . ticketId $ ticketInfo) stubbedConfig + + zendeskResponses <- run appExecution + + assert $ length zendeskResponses > 0 && isTaggedWithNoLogs zendeskResponses + + it "process ticket, with attachments" $ + forAll (listOf1 genCommentWithAttachment) $ \(commentsWithAttachment :: [Comment]) -> + forAll arbitrary $ \ticketInfo -> + monadicIO $ do + + let stubbedZendeskLayer :: ZendeskLayer App + stubbedZendeskLayer = + emptyZendeskLayer + { zlGetTicketComments = \_ -> pure commentsWithAttachment + , zlGetTicketInfo = \_ -> pure ticketInfo + , zlPostTicketComment = \_ -> pure () + , zlGetAttachment = \_ -> pure mempty + } + + let stubbedConfig :: Config + stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer + + let appExecution :: IO [ZendeskResponse] + appExecution = runApp (processTicket . ticketId $ ticketInfo) stubbedConfig + + zendeskResponses <- run appExecution + assert $ not (null zendeskResponses) && not (isTaggedWithNoLogs zendeskResponses) + +isTaggedWithNoLogs :: [ZendeskResponse] -> Bool +isTaggedWithNoLogs = all (\response -> "no-log-files" `elem` zrTags response) + +genCommentWithNoAttachment :: Gen Comment +genCommentWithNoAttachment = Comment + <$> arbitrary + <*> return mempty + <*> arbitrary + <*> arbitrary + +genCommentWithAttachment :: Gen Comment +genCommentWithAttachment = Comment + <$> arbitrary + <*> listOf1 arbitrary + <*> arbitrary + <*> arbitrary processTicketsSpec :: Spec processTicketsSpec = From 93157b4463c4a7257a2122c6168877a17d74a563 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Tue, 12 Jun 2018 10:42:12 +0900 Subject: [PATCH 02/15] Send the message in to all requesters with no log in the ticket --- src/Lib.hs | 44 ++++++++++++++++++++++---------------------- src/Zendesk/Types.hs | 2 ++ 2 files changed, 24 insertions(+), 22 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 408e975..1759d8a 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -9,7 +9,6 @@ module Lib , processTickets , fetchTickets , showStatistics - , listAndSortTickets ) where @@ -75,7 +74,7 @@ collectEmails = do processTicket :: TicketId -> App [ZendeskResponse] -processTicket ticketId = do +processTicket tid = do -- We first fetch the function from the configuration getTicketInfo <- asksZendeskLayer zlGetTicketInfo @@ -83,16 +82,21 @@ processTicket ticketId = do printText "Processing single ticket" - ticketInfo <- getTicketInfo ticketId - attachments <- getTicketAttachments ticketInfo - - zendeskResponse <- mapM (inspectAttachment ticketInfo) attachments + ticketInfo <- getTicketInfo tid + getTicketComments <- asksZendeskLayer zlGetTicketComments + comments <- getTicketComments tid + let attachments = getAttachmentsFromComment comments + zendeskResponse <- if not (null attachments) + then mapM (inspectAttachment ticketInfo) attachments + else if not (null comments) + then pure <$> responseNoLogs ticketInfo + else pure [] postTicketComment <- asksZendeskLayer zlPostTicketComment - _ <- mapM postTicketComment zendeskResponse + mapM_ postTicketComment zendeskResponse printText "Process finished, please see the following url" - printText $ "https://iohk.zendesk.com/agent/tickets/" <> show ticketId + printText $ "https://iohk.zendesk.com/agent/tickets/" <> show tid pure zendeskResponse @@ -195,20 +199,6 @@ extractEmailAddress ticketId = do liftIO $ appendFile "emailAddress.txt" (emailAddress <> "\n") liftIO $ putTextLn emailAddress - --- | Process specifig ticket id (can be used for testing) only inspects the one's with logs --- TODO(ks): Switch to `(MonadReader Config m)`, pure function? -getTicketAttachments :: TicketInfo -> App [Attachment] -getTicketAttachments TicketInfo{..} = do - - -- Get the function from the configuration - getTicketComments <- asksZendeskLayer zlGetTicketComments - comments <- getTicketComments ticketId - - -- However, if we want this to be more composable... - pure $ getAttachmentsFromComment comments - - -- | A pure function for fetching @Attachment@ from @Comment@. getAttachmentsFromComment :: [Comment] -> [Attachment] getAttachmentsFromComment comments = do @@ -291,6 +281,16 @@ inspectAttachment ticketInfo@TicketInfo{..} att = do , zrIsPublic = cfgIsCommentPublic } +responseNoLogs :: TicketInfo -> App ZendeskResponse +responseNoLogs TicketInfo{..} = do + Config {..} <- ask + pure ZendeskResponse + { zrTicketId = ticketId + -- TODO(hs): Need response template + , zrComment = "Log file not attached, please resubmit with logs if you have any issues" + , zrTags = [renderTicketStatus NoLogAttached] + , zrIsPublic = cfgIsCommentPublic + } -- | Filter analyzed tickets filterAnalyzedTickets :: [TicketInfo] -> [TicketInfo] filterAnalyzedTickets ticketsInfo = diff --git a/src/Zendesk/Types.hs b/src/Zendesk/Types.hs index 138119b..77cb5bf 100644 --- a/src/Zendesk/Types.hs +++ b/src/Zendesk/Types.hs @@ -258,12 +258,14 @@ data TicketTag = AnalyzedByScript -- ^ Ticket has been analyzed | AnalyzedByScriptV1_0 -- ^ Ticket has been analyzed by the version 1.0 | NoKnownIssue -- ^ Ticket had no known issue + | NoLogAttached -- ^ Ticket has no log file attached -- | Defining it's own show instance to use it as tags renderTicketStatus :: TicketTag -> Text renderTicketStatus AnalyzedByScript = "analyzed-by-script" renderTicketStatus AnalyzedByScriptV1_0 = "analyzed-by-script-v1.0" renderTicketStatus NoKnownIssue = "no-known-issues" +renderTicketStatus NoLogAttached = "no-log-files" -- | JSON Parsing instance FromJSON Comment where From dcb7526d06cce26fbf726142474345d07238baba Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Tue, 12 Jun 2018 11:34:30 +0900 Subject: [PATCH 03/15] Fix test cases --- test/Spec.hs | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index c617140..70b22be 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -154,7 +154,7 @@ processTicketSpec = -- Check we have some comments. assert $ not (null zendeskResponses) - it "process ticket, with no attachments" $ + it "processes ticket, with no attachments" $ forAll (listOf1 genCommentWithNoAttachment) $ \(commentsWithoutAttachment :: [Comment]) -> forAll arbitrary $ \ticketInfo -> monadicIO $ do @@ -175,17 +175,19 @@ processTicketSpec = zendeskResponses <- run appExecution - assert $ length zendeskResponses > 0 && isTaggedWithNoLogs zendeskResponses + assert $ not (null zendeskResponses) && isTaggedWithNoLogs zendeskResponses - it "process ticket, with attachments" $ - forAll (listOf1 genCommentWithAttachment) $ \(commentsWithAttachment :: [Comment]) -> + it "processes ticket, with attachments" $ + forAll (listOf1 arbitrary) $ \(comments:: [Comment]) -> forAll arbitrary $ \ticketInfo -> monadicIO $ do + pre $ any (not . null . cAttachments) comments + let stubbedZendeskLayer :: ZendeskLayer App stubbedZendeskLayer = emptyZendeskLayer - { zlGetTicketComments = \_ -> pure commentsWithAttachment + { zlGetTicketComments = \_ -> pure comments , zlGetTicketInfo = \_ -> pure ticketInfo , zlPostTicketComment = \_ -> pure () , zlGetAttachment = \_ -> pure mempty @@ -210,13 +212,6 @@ genCommentWithNoAttachment = Comment <*> arbitrary <*> arbitrary -genCommentWithAttachment :: Gen Comment -genCommentWithAttachment = Comment - <$> arbitrary - <*> listOf1 arbitrary - <*> arbitrary - <*> arbitrary - processTicketsSpec :: Spec processTicketsSpec = describe "processTickets" $ do From 9cc94e7ffbf4bf13513e7f01209e647c9b55b2ae Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Tue, 12 Jun 2018 13:36:15 +0900 Subject: [PATCH 04/15] Create getZendeskResponses function to decompose processTicket --- src/Lib.hs | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 1759d8a..55fcddf 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -5,6 +5,7 @@ module Lib ( runZendeskMain , collectEmails + , getZendeskResponses , processTicket , processTickets , fetchTickets @@ -86,12 +87,7 @@ processTicket tid = do getTicketComments <- asksZendeskLayer zlGetTicketComments comments <- getTicketComments tid let attachments = getAttachmentsFromComment comments - zendeskResponse <- if not (null attachments) - then mapM (inspectAttachment ticketInfo) attachments - else if not (null comments) - then pure <$> responseNoLogs ticketInfo - else pure [] - + zendeskResponse <- getZendeskResponses comments attachments ticketInfo postTicketComment <- asksZendeskLayer zlPostTicketComment mapM_ postTicketComment zendeskResponse @@ -221,6 +217,12 @@ getAttachmentsFromComment comments = do isAttachmentZip :: Attachment -> Bool isAttachmentZip attachment = "application/zip" == aContentType attachment +-- | Get zendesk responses +getZendeskResponses :: [Comment] -> [Attachment] -> TicketInfo -> App [ZendeskResponse] +getZendeskResponses comments attachments ticketInfo + | not (null attachments) = mapM (inspectAttachment ticketInfo) attachments + | not (null comments) = pure <$> responseNoLogs ticketInfo + | otherwise = pure [] -- | Given number of file of inspect, knowledgebase and attachment, -- analyze the logs and return the results. From eba2a39cfdf6a461e4e350acbcc4cb7d26e66058 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Wed, 13 Jun 2018 15:56:51 +0900 Subject: [PATCH 05/15] Filter goguen testnet tickets --- src/Lib.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 55fcddf..34cca55 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -299,8 +299,12 @@ filterAnalyzedTickets ticketsInfo = filter ticketsFilter ticketsInfo where ticketsFilter :: TicketInfo -> Bool - ticketsFilter ticketInfo = - isTicketAnalyzed ticketInfo && isTicketOpen ticketInfo && isTicketBlacklisted ticketInfo + ticketsFilter ticketInfo = + all (\predicate -> predicate ticketInfo) [ isTicketAnalyzed + , isTicketOpen + , isTicketBlacklisted + , isGoguenTestnetTicket + ] isTicketAnalyzed :: TicketInfo -> Bool isTicketAnalyzed TicketInfo{..} = (renderTicketStatus AnalyzedByScriptV1_0) `notElem` ticketTags @@ -312,3 +316,6 @@ filterAnalyzedTickets ticketsInfo = isTicketBlacklisted :: TicketInfo -> Bool isTicketBlacklisted TicketInfo{..} = ticketId `notElem` [9377,10815] + isGoguenTestnetTicket :: TicketInfo -> Bool + isGoguenTestnetTicket TicketInfo{..} = "goguen_testnets" `notElem` ticketTags + From f739b155ec1ada69e2fd4804576844f6d36c1d49 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Wed, 13 Jun 2018 16:20:49 +0900 Subject: [PATCH 06/15] Add response message --- src/Lib.hs | 6 ++--- src/LogAnalysis/Classifier.hs | 41 ++++++++++++++++++++++++++++++++++- 2 files changed, 43 insertions(+), 4 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 34cca55..957521d 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -21,7 +21,7 @@ import Data.Text (isInfixOf, stripEnd) import CLI (CLI (..), getCliArgs) import LogAnalysis.Classifier (extractErrorCodes, extractIssuesFromLogs, prettyFormatAnalysis, prettyFormatLogReadError, - prettyFormatNoIssues) + prettyFormatNoIssues, prettyFormatNoLogs) import LogAnalysis.KnowledgeCSVParser (parseKnowLedgeBase) import LogAnalysis.Types (ErrorCode (..), Knowledge, renderErrorCode, setupAnalysis) import Util (extractLogsFromZip) @@ -288,11 +288,11 @@ responseNoLogs TicketInfo{..} = do Config {..} <- ask pure ZendeskResponse { zrTicketId = ticketId - -- TODO(hs): Need response template - , zrComment = "Log file not attached, please resubmit with logs if you have any issues" + , zrComment = prettyFormatNoLogs , zrTags = [renderTicketStatus NoLogAttached] , zrIsPublic = cfgIsCommentPublic } + -- | Filter analyzed tickets filterAnalyzedTickets :: [TicketInfo] -> [TicketInfo] filterAnalyzedTickets ticketsInfo = diff --git a/src/LogAnalysis/Classifier.hs b/src/LogAnalysis/Classifier.hs index 25b44c6..ed6bd1c 100644 --- a/src/LogAnalysis/Classifier.hs +++ b/src/LogAnalysis/Classifier.hs @@ -6,8 +6,9 @@ module LogAnalysis.Classifier ( extractErrorCodes , extractIssuesFromLogs , prettyFormatAnalysis - , prettyFormatNoIssues , prettyFormatLogReadError + , prettyFormatNoIssues + , prettyFormatNoLogs ) where import Universum @@ -104,3 +105,41 @@ prettyFormatLogReadError ticketInfo = "We tried to analyze the log that you submitted and it appears that your log cannot be processed. Please try sending the log file once again. Please go to https://daedaluswallet.io/faq/ and see Issue 200 for instructions. Please reply to this email with when you respond." <> prettyFooter ticketInfo +prettyFormatNoLogs :: Text +prettyFormatNoLogs = + "Dear user," <> "\n\n" <> + "Thank you for contacting the IOHK Technical Support Desk. We apologize for the delay in responding to you." <> "\n\n" <> + "Most of the tickets we get are related to technical issues. If you have a Technical problem with Daedalus wallet please read on. If your request is NOT related to getting technical support you can IGNORE this email." <> "\n\n" <> + "We have recently (May 29th) had a major update to the Daedalus software. You can see more details here https://daedaluswallet.io/release-notes/. If you are experiencing any technical difficulties please make sure you have upgraded to the latest version before submitting a request for support or submitting new logs (more on logs below)." <> "\n\n" <> + "We scan our tickets to check for known issues before responding in person. If you have a technical issue but did not submit a log file we suggest that you reply to this message and attach your log file. Log files are required for helping with the majority of technical issues." <> "\n\n" <> + + "Please provide more information so that we can diagnose your issue:" <> "\n\n" <> + + "1. What is the Manufacturer and the Model number of your computer?" <> "\n" <> + "2. What is the Type and Version of the Operation System (OS) are you using?" <> "\n" <> + "3. Describe the issue you are experiencing in detail and attach screenshots if needed. Please tell us what you were doing when the error occurred." <> "\n" <> + "4. When did this issue occur (Date)?" <> "\n" <> + "5. Do you have any ideas how this happened?" <> "\n" <> + "Please compress and attach your pub folder, it contains technical logs. There is NO sensitive data in your logs:" <> "\n\n" <> + + "Windows" <> "\n\n" <> + + "1. Go to" <> "\n" <> + "C:\\Users'username\\AppData\\Roaming\\Daedalus\\Logs" <> "\n" <> + "You can access them by typing %appdata% into Windows Explorer search bar." <> "\n" <> + "2. Compress the pub folder into a Zip file." <> "\n" <> + "3. Attach the compressed pub folder to your reply." <> "\n\n" <> + + "Mac" <> "\n\n" <> + + "1. Open Finder" <> "\n" <> + "2. Go to the Menu Bar and select the 'Go' menu" <> "\n" <> + "3. Select 'Go to Folder...'" <> "\n" <> + "4. Enter the following path (this is only correct if you did not change the standard installation):" <> "\n" <> + "~/Library/Application Support/Daedalus/Logs" <> "\n" <> + "5. Right-click the pub folder and select Compress 'pub' in the shortcut menu." <> "\n" <> + "6. Attach the compressed pub folder to your reply." <> "\n\n" <> + + "Thanks," <> "\n" <> + "The IOHK Technical Support Desk Team" + \ No newline at end of file From 0fd05abb8f6b6c02c39ce70bb2d31f6b3992930a Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 14 Jun 2018 09:01:58 +0900 Subject: [PATCH 07/15] Minor fixes --- src/Lib.hs | 22 ++++++++++------------ test/Spec.hs | 10 ++++++---- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 957521d..6dcbc15 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -75,7 +74,7 @@ collectEmails = do processTicket :: TicketId -> App [ZendeskResponse] -processTicket tid = do +processTicket tId = do -- We first fetch the function from the configuration getTicketInfo <- asksZendeskLayer zlGetTicketInfo @@ -83,16 +82,16 @@ processTicket tid = do printText "Processing single ticket" - ticketInfo <- getTicketInfo tid + ticketInfo <- getTicketInfo tId getTicketComments <- asksZendeskLayer zlGetTicketComments - comments <- getTicketComments tid + comments <- getTicketComments tId let attachments = getAttachmentsFromComment comments zendeskResponse <- getZendeskResponses comments attachments ticketInfo postTicketComment <- asksZendeskLayer zlPostTicketComment mapM_ postTicketComment zendeskResponse printText "Process finished, please see the following url" - printText $ "https://iohk.zendesk.com/agent/tickets/" <> show tid + printText $ "https://iohk.zendesk.com/agent/tickets/" <> show tId pure zendeskResponse @@ -300,11 +299,10 @@ filterAnalyzedTickets ticketsInfo = where ticketsFilter :: TicketInfo -> Bool ticketsFilter ticketInfo = - all (\predicate -> predicate ticketInfo) [ isTicketAnalyzed - , isTicketOpen - , isTicketBlacklisted - , isGoguenTestnetTicket - ] + isTicketAnalyzed ticketInfo + && isTicketOpen ticketInfo + && isTicketBlacklisted ticketInfo + && isTicketInGoguenTestnet ticketInfo isTicketAnalyzed :: TicketInfo -> Bool isTicketAnalyzed TicketInfo{..} = (renderTicketStatus AnalyzedByScriptV1_0) `notElem` ticketTags @@ -316,6 +314,6 @@ filterAnalyzedTickets ticketsInfo = isTicketBlacklisted :: TicketInfo -> Bool isTicketBlacklisted TicketInfo{..} = ticketId `notElem` [9377,10815] - isGoguenTestnetTicket :: TicketInfo -> Bool - isGoguenTestnetTicket TicketInfo{..} = "goguen_testnets" `notElem` ticketTags + isTicketInGoguenTestnet :: TicketInfo -> Bool + isTicketInGoguenTestnet TicketInfo{..} = "goguen_testnets" `notElem` ticketTags diff --git a/test/Spec.hs b/test/Spec.hs index 70b22be..5ce2fe5 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -175,7 +175,7 @@ processTicketSpec = zendeskResponses <- run appExecution - assert $ not (null zendeskResponses) && isTaggedWithNoLogs zendeskResponses + assert $ not (null zendeskResponses) && areResponsesTaggedWithNoLogs zendeskResponses it "processes ticket, with attachments" $ forAll (listOf1 arbitrary) $ \(comments:: [Comment]) -> @@ -200,10 +200,12 @@ processTicketSpec = appExecution = runApp (processTicket . ticketId $ ticketInfo) stubbedConfig zendeskResponses <- run appExecution - assert $ not (null zendeskResponses) && not (isTaggedWithNoLogs zendeskResponses) + + assert $ not (null zendeskResponses) && not (areResponsesTaggedWithNoLogs zendeskResponses) -isTaggedWithNoLogs :: [ZendeskResponse] -> Bool -isTaggedWithNoLogs = all (\response -> "no-log-files" `elem` zrTags response) +areResponsesTaggedWithNoLogs :: [ZendeskResponse] -> Bool +areResponsesTaggedWithNoLogs zendeskResponses = + all (\response -> "no-log-files" `elem` zrTags response) zendeskResponses genCommentWithNoAttachment :: Gen Comment genCommentWithNoAttachment = Comment From 16a7cb680627b53a2bd1ac11b94acc197d7c6b58 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 14 Jun 2018 12:38:56 +0900 Subject: [PATCH 08/15] Return single ZendeskResponse instead of list of responses --- src/Lib.hs | 17 +++++++++++------ test/Spec.hs | 38 ++++++++++++++++++-------------------- 2 files changed, 29 insertions(+), 26 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 6dcbc15..e7c046d 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -73,7 +73,7 @@ collectEmails = do mapM_ extractEmailAddress ticketIds -processTicket :: TicketId -> App [ZendeskResponse] +processTicket :: TicketId -> App (Maybe ZendeskResponse) processTicket tId = do -- We first fetch the function from the configuration @@ -88,7 +88,7 @@ processTicket tId = do let attachments = getAttachmentsFromComment comments zendeskResponse <- getZendeskResponses comments attachments ticketInfo postTicketComment <- asksZendeskLayer zlPostTicketComment - mapM_ postTicketComment zendeskResponse + whenJust zendeskResponse postTicketComment printText "Process finished, please see the following url" printText $ "https://iohk.zendesk.com/agent/tickets/" <> show tId @@ -217,11 +217,16 @@ getAttachmentsFromComment comments = do isAttachmentZip attachment = "application/zip" == aContentType attachment -- | Get zendesk responses -getZendeskResponses :: [Comment] -> [Attachment] -> TicketInfo -> App [ZendeskResponse] +-- | Returns with maybe because it could return no response +getZendeskResponses :: [Comment] -> [Attachment] -> TicketInfo -> App (Maybe ZendeskResponse) getZendeskResponses comments attachments ticketInfo - | not (null attachments) = mapM (inspectAttachment ticketInfo) attachments - | not (null comments) = pure <$> responseNoLogs ticketInfo - | otherwise = pure [] + | not (null attachments) = do + zendeskResponses <- mapM (inspectAttachment ticketInfo) attachments + -- Last element should be the latest attachment + let latestResponse = last <$> nonEmpty zendeskResponses + return latestResponse + | not (null comments) = Just <$> responseNoLogs ticketInfo + | otherwise = return Nothing -- | Given number of file of inspect, knowledgebase and attachment, -- analyze the logs and return the results. diff --git a/test/Spec.hs b/test/Spec.hs index 5ce2fe5..229bdc9 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -96,9 +96,9 @@ listAndSortTicketsSpec = processTicketSpec :: Spec processTicketSpec = describe "processTicket" $ modifyMaxSuccess (const 200) $ do - it "processes ticket, no comments" $ do + it "processes ticket, no comments" $ forAll arbitrary $ \(ticketInfo :: TicketInfo) -> - forAll (listOf1 arbitrary) $ \(listTickets) -> do + forAll (listOf1 arbitrary) $ \(listTickets) -> monadicIO $ do @@ -114,25 +114,21 @@ processTicketSpec = let stubbedConfig :: Config stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer - let appExecution :: IO [ZendeskResponse] + let appExecution :: IO (Maybe ZendeskResponse) appExecution = runApp (processTicket . ticketId $ ticketInfo) stubbedConfig zendeskComments <- run appExecution -- Check we have some comments. - assert $ length zendeskComments == 0 + assert $ isNothing zendeskComments it "processes ticket, with comments" $ forAll arbitrary $ \(ticketInfo :: TicketInfo) -> forAll (listOf1 arbitrary) $ \(listTickets) -> forAll (listOf1 arbitrary) $ \(comments) -> - monadicIO $ do - -- A simple precondition. - pre $ any (\comment -> length (cAttachments comment) > 0) comments - let stubbedZendeskLayer :: ZendeskLayer App stubbedZendeskLayer = emptyZendeskLayer @@ -146,13 +142,13 @@ processTicketSpec = let stubbedConfig :: Config stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer - let appExecution :: IO [ZendeskResponse] + let appExecution :: IO (Maybe ZendeskResponse) appExecution = runApp (processTicket . ticketId $ ticketInfo) stubbedConfig - zendeskResponses <- run appExecution + zendeskResponse <- run appExecution -- Check we have some comments. - assert $ not (null zendeskResponses) + assert $ isJust zendeskResponse it "processes ticket, with no attachments" $ forAll (listOf1 genCommentWithNoAttachment) $ \(commentsWithoutAttachment :: [Comment]) -> @@ -170,12 +166,13 @@ processTicketSpec = let stubbedConfig :: Config stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer - let appExecution :: IO [ZendeskResponse] + let appExecution :: IO (Maybe ZendeskResponse) appExecution = runApp (processTicket . ticketId $ ticketInfo) stubbedConfig - zendeskResponses <- run appExecution + zendeskResponse <- run appExecution - assert $ not (null zendeskResponses) && areResponsesTaggedWithNoLogs zendeskResponses + assert $ isJust zendeskResponse + assert $ isResponseTaggedWithNoLogs zendeskResponse it "processes ticket, with attachments" $ forAll (listOf1 arbitrary) $ \(comments:: [Comment]) -> @@ -196,16 +193,17 @@ processTicketSpec = let stubbedConfig :: Config stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer - let appExecution :: IO [ZendeskResponse] + let appExecution :: IO (Maybe ZendeskResponse) appExecution = runApp (processTicket . ticketId $ ticketInfo) stubbedConfig - zendeskResponses <- run appExecution + zendeskResponse <- run appExecution - assert $ not (null zendeskResponses) && not (areResponsesTaggedWithNoLogs zendeskResponses) + assert $ isJust zendeskResponse + assert $ not (isResponseTaggedWithNoLogs zendeskResponse) -areResponsesTaggedWithNoLogs :: [ZendeskResponse] -> Bool -areResponsesTaggedWithNoLogs zendeskResponses = - all (\response -> "no-log-files" `elem` zrTags response) zendeskResponses +isResponseTaggedWithNoLogs :: Maybe ZendeskResponse -> Bool +isResponseTaggedWithNoLogs (Just response) = "no-log-files" `elem` zrTags response +isResponseTaggedWithNoLogs Nothing = False genCommentWithNoAttachment :: Gen Comment genCommentWithNoAttachment = Comment From 42d81b5d343e357e1fb7fcc735a88440c443fcfc Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 14 Jun 2018 13:55:35 +0900 Subject: [PATCH 09/15] Inspect only latest attachment --- src/Lib.hs | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index e7c046d..2e1ce5d 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Lib ( runZendeskMain @@ -23,13 +23,13 @@ import LogAnalysis.Classifier (extractErrorCodes, extractIssuesFromLog prettyFormatNoIssues, prettyFormatNoLogs) import LogAnalysis.KnowledgeCSVParser (parseKnowLedgeBase) import LogAnalysis.Types (ErrorCode (..), Knowledge, renderErrorCode, setupAnalysis) +import Prelude (last) import Util (extractLogsFromZip) import Zendesk (App, Attachment (..), Comment (..), Config (..), IOLayer (..), RequestType (..), TicketId, TicketInfo (..), TicketTag (..), ZendeskLayer (..), ZendeskResponse (..), asksIOLayer, asksZendeskLayer, assignToPath, defaultConfig, knowledgebasePath, renderTicketStatus, runApp, tokenPath) - ------------------------------------------------------------ -- Functions ------------------------------------------------------------ @@ -220,14 +220,16 @@ getAttachmentsFromComment comments = do -- | Returns with maybe because it could return no response getZendeskResponses :: [Comment] -> [Attachment] -> TicketInfo -> App (Maybe ZendeskResponse) getZendeskResponses comments attachments ticketInfo - | not (null attachments) = do - zendeskResponses <- mapM (inspectAttachment ticketInfo) attachments - -- Last element should be the latest attachment - let latestResponse = last <$> nonEmpty zendeskResponses - return latestResponse + | not (null attachments) = Just <$> inspectAttachments ticketInfo attachments | not (null comments) = Just <$> responseNoLogs ticketInfo | otherwise = return Nothing +-- | Inspect only the latest attchment +inspectAttachments :: TicketInfo -> [Attachment] -> App ZendeskResponse +inspectAttachments ticketInfo attachments = do + let latestAttachment = Prelude.last attachments + inspectAttachment ticketInfo latestAttachment + -- | Given number of file of inspect, knowledgebase and attachment, -- analyze the logs and return the results. -- @@ -303,9 +305,9 @@ filterAnalyzedTickets ticketsInfo = filter ticketsFilter ticketsInfo where ticketsFilter :: TicketInfo -> Bool - ticketsFilter ticketInfo = - isTicketAnalyzed ticketInfo - && isTicketOpen ticketInfo + ticketsFilter ticketInfo = + isTicketAnalyzed ticketInfo + && isTicketOpen ticketInfo && isTicketBlacklisted ticketInfo && isTicketInGoguenTestnet ticketInfo From 494cfb38463743a46fb194b58a422130f0ce2066 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 14 Jun 2018 15:48:59 +0900 Subject: [PATCH 10/15] Sort comment by id, inspect last element of the attachments --- src/Lib.hs | 18 ++++++++++-------- src/Zendesk/Functions.hs | 10 +++++----- src/Zendesk/Types.hs | 29 +++++++++++++++++++++++++---- test/Spec.hs | 1 + 4 files changed, 41 insertions(+), 17 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 2e1ce5d..231c1a2 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -23,7 +23,6 @@ import LogAnalysis.Classifier (extractErrorCodes, extractIssuesFromLog prettyFormatNoIssues, prettyFormatNoLogs) import LogAnalysis.KnowledgeCSVParser (parseKnowLedgeBase) import LogAnalysis.Types (ErrorCode (..), Knowledge, renderErrorCode, setupAnalysis) -import Prelude (last) import Util (extractLogsFromZip) import Zendesk (App, Attachment (..), Comment (..), Config (..), IOLayer (..), RequestType (..), TicketId, TicketInfo (..), TicketTag (..), @@ -84,9 +83,9 @@ processTicket tId = do ticketInfo <- getTicketInfo tId getTicketComments <- asksZendeskLayer zlGetTicketComments - comments <- getTicketComments tId - let attachments = getAttachmentsFromComment comments - zendeskResponse <- getZendeskResponses comments attachments ticketInfo + sortedComments <- sortBy compare <$> getTicketComments tId + let attachments = getAttachmentsFromComment sortedComments + zendeskResponse <- getZendeskResponses sortedComments attachments ticketInfo postTicketComment <- asksZendeskLayer zlPostTicketComment whenJust zendeskResponse postTicketComment @@ -220,15 +219,18 @@ getAttachmentsFromComment comments = do -- | Returns with maybe because it could return no response getZendeskResponses :: [Comment] -> [Attachment] -> TicketInfo -> App (Maybe ZendeskResponse) getZendeskResponses comments attachments ticketInfo - | not (null attachments) = Just <$> inspectAttachments ticketInfo attachments + | not (null attachments) = inspectAttachments ticketInfo attachments | not (null comments) = Just <$> responseNoLogs ticketInfo | otherwise = return Nothing -- | Inspect only the latest attchment -inspectAttachments :: TicketInfo -> [Attachment] -> App ZendeskResponse +inspectAttachments :: TicketInfo -> [Attachment] -> App (Maybe ZendeskResponse) inspectAttachments ticketInfo attachments = do - let latestAttachment = Prelude.last attachments - inspectAttachment ticketInfo latestAttachment + -- Inspecting the last element since it'll be the latest attachment + let latestAttachment = last <$> nonEmpty attachments + case latestAttachment of + Just att -> return <$> inspectAttachment ticketInfo att + Nothing -> return Nothing -- | Given number of file of inspect, knowledgebase and attachment, -- analyze the logs and return the results. diff --git a/src/Zendesk/Functions.hs b/src/Zendesk/Functions.hs index fa40a1c..cd6bbce 100644 --- a/src/Zendesk/Functions.hs +++ b/src/Zendesk/Functions.hs @@ -11,7 +11,7 @@ module Zendesk.Functions import Universum import Control.Monad.Reader (ask) -import Data.Aeson (FromJSON, ToJSON, Value, encode, parseJSON) +import Data.Aeson (FromJSON, ToJSON, Value, encode) import Data.Aeson.Text (encodeToLazyText) import Data.Aeson.Types (Parser, parseEither) import Network.HTTP.Simple (Request, addRequestHeader, getResponseBody, httpJSON, httpLBS, @@ -21,7 +21,7 @@ import Network.HTTP.Simple (Request, addRequestHeader, getResponseBody import Zendesk.Types (Attachment (..), Comment (..), Config (..), IOLayer (..), RequestType (..), Ticket (..), TicketId, TicketInfo (..), TicketList (..), TicketTag (..), ZendeskLayer (..), - ZendeskResponse (..), parseAgentId, parseComments, parseTickets, + ZendeskResponse (..), parseAgentId, parseComments, parseTickets, parseTicket, renderTicketStatus) @@ -36,7 +36,7 @@ defaultConfig = , cfgAssignTo = 0 , cfgKnowledgebase = [] , cfgNumOfLogsToAnalyze = 5 - , cfgIsCommentPublic = True -- TODO(ks): For now, we need this in CLI. + , cfgIsCommentPublic = False -- TODO(ks): For now, we need this in CLI. , cfgZendeskLayer = basicZendeskLayer , cfgIOLayer = basicIOLayer } @@ -80,7 +80,7 @@ getTicketInfo ticketId = do cfg <- ask let req = apiRequest cfg ("tickets/" <> show ticketId <> ".json") - liftIO $ apiCall parseJSON req + liftIO $ apiCall parseTicket req -- | Return list of ticketIds that has been requested by config user (not used) listTickets @@ -120,7 +120,7 @@ postTicketComment ZendeskResponse{..} = do let req1 = apiRequest cfg ("tickets/" <> show zrTicketId <> ".json") let req2 = addJsonBody (Ticket - (Comment ("**Log classifier**\n\n" <> zrComment) [] zrIsPublic (cfgAgentId cfg)) + (Comment Nothing ("**Log classifier**\n\n" <> zrComment) [] zrIsPublic (cfgAgentId cfg)) (cfgAssignTo cfg) (renderTicketStatus AnalyzedByScriptV1_0:zrTags) ) diff --git a/src/Zendesk/Types.hs b/src/Zendesk/Types.hs index 77cb5bf..1e2fa82 100644 --- a/src/Zendesk/Types.hs +++ b/src/Zendesk/Types.hs @@ -18,6 +18,7 @@ module Zendesk.Types , TicketTag (..) , parseAgentId , parseComments + , parseTicket , parseTickets , renderTicketStatus -- * General configuration @@ -169,7 +170,9 @@ data ZendeskResponse = ZendeskResponse -- | Comments data Comment = Comment - { cBody :: !Text + { cId :: Maybe Integer + -- ^ Comment Id + , cBody :: !Text -- ^ Body of comment , cAttachments :: ![Attachment] -- ^ Attachment @@ -179,6 +182,8 @@ data Comment = Comment -- ^ Auther of comment } deriving (Eq, Show) +instance Ord Comment where + compare c1 c2 = compare (cId c1) (cId c2) instance Arbitrary Comment where arbitrary = Comment @@ -186,6 +191,7 @@ instance Arbitrary Comment where <*> arbitrary <*> arbitrary <*> arbitrary + <*> arbitrary -- | Outer comment ?? @@ -269,11 +275,23 @@ renderTicketStatus NoLogAttached = "no-log-files" -- | JSON Parsing instance FromJSON Comment where - parseJSON = withObject "comment" $ \o -> - Comment <$> o .: "body" <*> o .: "attachments" <*> o .: "public" <*> o .: "author_id" + parseJSON = withObject "comment" $ \o -> do + cId <- o .: "id" + cBody <- o .: "body" + cAttachments <- o .: "attachments" + cPublic <- o .: "public" + cAuthor <- o .: "author_id" + + pure Comment + { cId = cId + , cBody = cBody + , cAttachments = cAttachments + , cPublic = cPublic + , cAuthor = cAuthor + } instance ToJSON Comment where - toJSON (Comment b as public author) + toJSON (Comment _ b as public author) = object [ "body" .= b, "attachments" .= as, "public" .= public, "author_id" .= author] @@ -306,6 +324,9 @@ instance FromJSON TicketInfo where instance FromJSON TicketList where parseJSON = withObject "ticketList" $ \o -> TicketList <$> o .: "tickets" <*> o .: "next_page" +parseTicket :: Value -> Parser TicketInfo +parseTicket = withObject "ticket" $ \o -> o .: "ticket" + -- | Parse tickets parseTickets :: Value -> Parser TicketList parseTickets = withObject "tickets" $ \o -> TicketList <$> o .: "tickets" <*> o .: "next_page" diff --git a/test/Spec.hs b/test/Spec.hs index 229bdc9..36e503d 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -208,6 +208,7 @@ isResponseTaggedWithNoLogs Nothing = False genCommentWithNoAttachment :: Gen Comment genCommentWithNoAttachment = Comment <$> arbitrary + <*> arbitrary <*> return mempty <*> arbitrary <*> arbitrary From 3706e4f7c9b7567057403e3ce508df8c1e82a77d Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 14 Jun 2018 16:55:06 +0900 Subject: [PATCH 11/15] Fix flag --- src/DataSource/Http.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/DataSource/Http.hs b/src/DataSource/Http.hs index bb3f771..c3e7b48 100644 --- a/src/DataSource/Http.hs +++ b/src/DataSource/Http.hs @@ -37,7 +37,7 @@ defaultConfig = , cfgAssignTo = 0 , cfgKnowledgebase = [] , cfgNumOfLogsToAnalyze = 5 - , cfgIsCommentPublic = False -- TODO(ks): For now, we need this in CLI. + , cfgIsCommentPublic = True -- TODO(ks): For now, we need this in CLI. , cfgZendeskLayer = basicZendeskLayer , cfgIOLayer = basicIOLayer } From f2512940564894fc9a3cce1d38b3f6686988eaa8 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 14 Jun 2018 19:43:29 +0900 Subject: [PATCH 12/15] Minor fixes --- src/DataSource/Types.hs | 3 +++ src/Lib.hs | 17 ++++++++--------- 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/DataSource/Types.hs b/src/DataSource/Types.hs index dc35f9f..420befa 100644 --- a/src/DataSource/Types.hs +++ b/src/DataSource/Types.hs @@ -168,6 +168,9 @@ data Attachment = Attachment -- ^ Attachment size } deriving (Eq, Show) +instance Ord Attachment where + compare a1 a2 = compare (aId a1) (aId a2) + instance Arbitrary Attachment where arbitrary = Attachment <$> arbitrary diff --git a/src/Lib.hs b/src/Lib.hs index abfdb7d..da50d08 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -86,12 +86,12 @@ processTicket tId = do printText "Processing single ticket" - mTicketInfo <- getTicketInfo tId + mTicketInfo <- getTicketInfo tId getTicketComments <- asksZendeskLayer zlGetTicketComments - sortedComments <- sortBy compare <$> getTicketComments tId - let attachments = getAttachmentsFromComment sortedComments + comments <- getTicketComments tId + let attachments = getAttachmentsFromComment comments let ticketInfo = fromMaybe (error "No ticket info") mTicketInfo - zendeskResponse <- getZendeskResponses sortedComments attachments ticketInfo + zendeskResponse <- getZendeskResponses comments attachments ticketInfo postTicketComment <- asksZendeskLayer zlPostTicketComment whenJust zendeskResponse postTicketComment @@ -211,11 +211,10 @@ getZendeskResponses comments attachments ticketInfo -- | Inspect only the latest attchment inspectAttachments :: TicketInfo -> [Attachment] -> App (Maybe ZendeskResponse) inspectAttachments ticketInfo attachments = do - -- Inspecting the last element since it'll be the latest attachment - let latestAttachment = last <$> nonEmpty attachments - case latestAttachment of - Just att -> return <$> inspectAttachment ticketInfo att - Nothing -> return Nothing + let lastAttachment :: Maybe Attachment + lastAttachment = safeHead . reverse . sort $ attachments + + inspectAttachment ticketInfo =<< lastAttachment -- | Given number of file of inspect, knowledgebase and attachment, -- analyze the logs and return the results. From 1530f3ca3a25ed662e8580ae818b2b5da579c7d0 Mon Sep 17 00:00:00 2001 From: ksaric Date: Thu, 14 Jun 2018 13:21:36 +0200 Subject: [PATCH 13/15] [TSD-40] The impure version. --- src/Lib.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Lib.hs b/src/Lib.hs index da50d08..5c4c329 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -211,10 +211,11 @@ getZendeskResponses comments attachments ticketInfo -- | Inspect only the latest attchment inspectAttachments :: TicketInfo -> [Attachment] -> App (Maybe ZendeskResponse) inspectAttachments ticketInfo attachments = do + let lastAttachment :: Maybe Attachment lastAttachment = safeHead . reverse . sort $ attachments - inspectAttachment ticketInfo =<< lastAttachment + sequence $ liftM2 inspectAttachment (Just ticketInfo) lastAttachment -- | Given number of file of inspect, knowledgebase and attachment, -- analyze the logs and return the results. From 9e5864bcd5135c545b5241ddd3577e7e30dba8d3 Mon Sep 17 00:00:00 2001 From: ksaric Date: Thu, 14 Jun 2018 14:50:56 +0200 Subject: [PATCH 14/15] [TSD-40] The version with the pure function. Either is an option here. --- src/Lib.hs | 48 +++++++++++++++++++----------------------------- 1 file changed, 19 insertions(+), 29 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 5c4c329..df96812 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -208,40 +208,36 @@ getZendeskResponses comments attachments ticketInfo | not (null comments) = Just <$> responseNoLogs ticketInfo | otherwise = return Nothing --- | Inspect only the latest attchment +-- | Inspect only the latest attachment. We could propagate this +-- @Maybe@ upwards or use an @Either@ which will go hand in hand +-- with the idea that we need to improve our exception handling. inspectAttachments :: TicketInfo -> [Attachment] -> App (Maybe ZendeskResponse) -inspectAttachments ticketInfo attachments = do +inspectAttachments ticketInfo attachments = runMaybeT $ do - let lastAttachment :: Maybe Attachment - lastAttachment = safeHead . reverse . sort $ attachments + config <- ask + getAttachment <- asksZendeskLayer zlGetAttachment - sequence $ liftM2 inspectAttachment (Just ticketInfo) lastAttachment + let lastAttach :: Maybe Attachment + lastAttach = safeHead . reverse . sort $ attachments --- | Given number of file of inspect, knowledgebase and attachment, --- analyze the logs and return the results. --- --- The results are following: --- --- __(comment, tags, bool of whether is should be public comment)__ -inspectAttachment :: TicketInfo -> Attachment -> App ZendeskResponse -inspectAttachment ticketInfo@TicketInfo{..} att = do + lastAttachment <- MaybeT . pure $ lastAttach + att <- MaybeT $ getAttachment lastAttachment - Config{..} <- ask + pure $ inspectAttachment config ticketInfo att - getAttachment <- asksZendeskLayer zlGetAttachment - printText <- asksIOLayer iolPrintText - attachment <- fromMaybe (error "Missing Attachment content!") <$> getAttachment att +-- | Given number of file of inspect, knowledgebase and attachment, +-- analyze the logs and return the results. +inspectAttachment :: Config -> TicketInfo -> AttachmentContent -> ZendeskResponse +inspectAttachment Config{..} ticketInfo@TicketInfo{..} attContent = do - let rawLog = getAttachmentContent attachment + let rawLog = getAttachmentContent attContent let results = extractLogsFromZip cfgNumOfLogsToAnalyze rawLog case results of Left _ -> do - printText . renderErrorCode $ SentLogCorrupted - - pure ZendeskResponse + ZendeskResponse { zrTicketId = tiId , zrComment = prettyFormatLogReadError ticketInfo , zrTags = [renderErrorCode SentLogCorrupted] @@ -256,11 +252,7 @@ inspectAttachment ticketInfo@TicketInfo{..} att = do let errorCodes = extractErrorCodes analysisResult let commentRes = prettyFormatAnalysis analysisResult ticketInfo - let fErrorCode = foldr (\errorCode acc -> errorCode <> ";" <> acc) "" errorCodes - - printText fErrorCode - - pure ZendeskResponse + ZendeskResponse { zrTicketId = tiId , zrComment = commentRes , zrTags = errorCodes @@ -269,9 +261,7 @@ inspectAttachment ticketInfo@TicketInfo{..} att = do Left _ -> do - printText . renderTicketStatus $ NoKnownIssue - - pure ZendeskResponse + ZendeskResponse { zrTicketId = tiId , zrComment = prettyFormatNoIssues ticketInfo , zrTags = [renderTicketStatus NoKnownIssue] From 4559edfa8d5d3e4ea2fbbaebcd8d0b879f6e9c83 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Fri, 15 Jun 2018 16:51:08 +0900 Subject: [PATCH 15/15] Couple of minor fixes - Unwrap newtype so the request api will be valid - Make assignee_id field to be maybe since ticket could be unassigned in that case classifier will not be able to parse the json --- src/DataSource/Http.hs | 12 ++++++------ src/DataSource/Types.hs | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/DataSource/Http.hs b/src/DataSource/Http.hs index c3e7b48..51a4dc6 100644 --- a/src/DataSource/Http.hs +++ b/src/DataSource/Http.hs @@ -20,8 +20,8 @@ import Network.HTTP.Simple (Request, addRequestHeader, getResponseBody import DataSource.Types (Attachment (..), AttachmentContent (..), Comment (..), CommentBody (..), CommentId (..), Config (..), IOLayer (..), - Ticket (..), TicketId, TicketInfo (..), TicketList (..), - TicketTag (..), User, UserId, ZendeskLayer (..), + Ticket (..), TicketId(..), TicketInfo (..), TicketList (..), + TicketTag (..), User, UserId(..), ZendeskLayer (..), ZendeskResponse (..), parseComments, parseTickets, parseTicket, renderTicketStatus) @@ -80,7 +80,7 @@ getTicketInfo getTicketInfo ticketId = do cfg <- ask - let req = apiRequest cfg ("tickets/" <> show ticketId <> ".json") + let req = apiRequest cfg ("tickets/" <> show (getTicketId ticketId) <> ".json") liftIO $ Just <$> apiCall parseTicket req @@ -92,7 +92,7 @@ listRequestedTickets listRequestedTickets userId = do cfg <- ask - let url = "/users/" <> show userId <> "/tickets/requested.json" + let url = "/users/" <> show (getUserId userId) <> "/tickets/requested.json" let req = apiRequest cfg url iterateTicketPages req @@ -105,7 +105,7 @@ listAssignedTickets listAssignedTickets userId = do cfg <- ask - let url = "/users/" <> show userId <> "/tickets/assigned.json" + let url = "/users/" <> show (getUserId userId) <> "/tickets/assigned.json" let req = apiRequest cfg url iterateTicketPages req @@ -175,7 +175,7 @@ getTicketComments -> m [Comment] getTicketComments tId = do cfg <- ask - let req = apiRequest cfg ("tickets/" <> show tId <> "/comments.json") + let req = apiRequest cfg ("tickets/" <> show (getTicketId tId) <> "/comments.json") liftIO $ apiCall parseComments req ------------------------------------------------------------ diff --git a/src/DataSource/Types.hs b/src/DataSource/Types.hs index 420befa..d8f03b7 100644 --- a/src/DataSource/Types.hs +++ b/src/DataSource/Types.hs @@ -281,7 +281,7 @@ newtype TicketStatus = TicketStatus data TicketInfo = TicketInfo { tiId :: !TicketId -- ^ Id of an ticket , tiRequesterId :: !UserId -- ^ Id of the requester - , tiAssigneeId :: !UserId -- ^ Id of the asignee + , tiAssigneeId :: Maybe UserId -- ^ Id of the asignee , tiUrl :: !TicketURL -- ^ The ticket URL , tiTags :: !TicketTags -- ^ Tags associated with ticket , tiStatus :: !TicketStatus -- ^ The status of the ticket