diff --git a/src/DataSource/Http.hs b/src/DataSource/Http.hs index 8b73086..51a4dc6 100644 --- a/src/DataSource/Http.hs +++ b/src/DataSource/Http.hs @@ -20,9 +20,9 @@ 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 (..), - ZendeskResponse (..), parseComments, parseTickets, + Ticket (..), TicketId(..), TicketInfo (..), TicketList (..), + TicketTag (..), User, UserId(..), ZendeskLayer (..), + ZendeskResponse (..), parseComments, parseTickets, parseTicket, renderTicketStatus) @@ -80,8 +80,8 @@ getTicketInfo getTicketInfo ticketId = do cfg <- ask - let req = apiRequest cfg ("tickets/" <> show ticketId <> ".json") - liftIO $ apiCall parseJSON req + let req = apiRequest cfg ("tickets/" <> show (getTicketId ticketId) <> ".json") + liftIO $ Just <$> apiCall parseTicket req -- | Return list of ticketIds that has been requested by config user. @@ -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 221136e..d8f03b7 100644 --- a/src/DataSource/Types.hs +++ b/src/DataSource/Types.hs @@ -29,6 +29,7 @@ module DataSource.Types , UserName (..) , UserEmail (..) , parseComments + , parseTicket , parseTickets , renderTicketStatus -- * General configuration @@ -167,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 @@ -217,6 +221,8 @@ data Comment = Comment -- ^ Author of comment } deriving (Eq, Show) +instance Ord Comment where + compare c1 c2 = compare (cId c1) (cId c2) instance Arbitrary Comment where arbitrary = Comment @@ -275,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 @@ -369,12 +375,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 -- ^ Log file not 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 @@ -463,6 +471,9 @@ instance ToJSON CommentOuter where ] +parseTicket :: Value -> Parser TicketInfo +parseTicket = withObject "ticket" $ \o -> o .: "ticket" + -- | Parse tickets parseTickets :: Value -> Parser TicketList parseTickets = withObject "tickets" $ \o -> diff --git a/src/Lib.hs b/src/Lib.hs index 3e470f3..df96812 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,15 +1,14 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Lib ( runZendeskMain , collectEmails + , getZendeskResponses , processTicket , processTickets , fetchTickets , showStatistics - , listAndSortTickets ) where @@ -27,11 +26,10 @@ import DataSource (App, Attachment (..), AttachmentContent (..), Comme renderTicketStatus, runApp, tokenPath) import LogAnalysis.Classifier (extractErrorCodes, extractIssuesFromLogs, prettyFormatAnalysis, prettyFormatLogReadError, - prettyFormatNoIssues) + prettyFormatNoIssues, prettyFormatNoLogs) import LogAnalysis.KnowledgeCSVParser (parseKnowLedgeBase) import LogAnalysis.Types (ErrorCode (..), Knowledge, renderErrorCode, setupAnalysis) import Util (extractLogsFromZip) - ------------------------------------------------------------ -- Functions ------------------------------------------------------------ @@ -79,8 +77,8 @@ collectEmails = do mapM_ extractEmailAddress ticketIds -processTicket :: TicketId -> App [ZendeskResponse] -processTicket ticketId = do +processTicket :: TicketId -> App (Maybe ZendeskResponse) +processTicket tId = do -- We first fetch the function from the configuration getTicketInfo <- asksZendeskLayer zlGetTicketInfo @@ -88,20 +86,17 @@ processTicket ticketId = do printText "Processing single ticket" - ticketInfoM <- getTicketInfo ticketId - - -- TODO(ks): Better exception handling. - let ticketInfo = fromMaybe (error "Missing ticket info!") ticketInfoM - - attachments <- getTicketAttachments ticketInfo - - zendeskResponse <- mapM (inspectAttachment ticketInfo) attachments - + mTicketInfo <- getTicketInfo tId + getTicketComments <- asksZendeskLayer zlGetTicketComments + comments <- getTicketComments tId + let attachments = getAttachmentsFromComment comments + let ticketInfo = fromMaybe (error "No ticket info") mTicketInfo + 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 ticketId + printText $ "https://iohk.zendesk.com/agent/tickets/" <> show tId pure zendeskResponse @@ -183,20 +178,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 tiId - - -- 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 @@ -219,32 +200,44 @@ getAttachmentsFromComment comments = do isAttachmentZip :: Attachment -> Bool isAttachmentZip attachment = "application/zip" == aContentType attachment +-- | Get zendesk responses +-- | Returns with maybe because it could return no response +getZendeskResponses :: [Comment] -> [Attachment] -> TicketInfo -> App (Maybe ZendeskResponse) +getZendeskResponses comments attachments ticketInfo + | not (null attachments) = inspectAttachments ticketInfo attachments + | not (null comments) = Just <$> responseNoLogs ticketInfo + | otherwise = return Nothing + +-- | 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 = runMaybeT $ do + + config <- ask + getAttachment <- asksZendeskLayer zlGetAttachment --- | 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 + let lastAttach :: Maybe Attachment + lastAttach = safeHead . reverse . sort $ attachments - Config{..} <- ask + lastAttachment <- MaybeT . pure $ lastAttach + att <- MaybeT $ getAttachment lastAttachment - getAttachment <- asksZendeskLayer zlGetAttachment - printText <- asksIOLayer iolPrintText + pure $ inspectAttachment config ticketInfo att - attachment <- fromMaybe (error "Missing Attachment content!") <$> getAttachment att - let rawLog = getAttachmentContent attachment +-- | 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 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] @@ -259,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 @@ -272,15 +261,23 @@ inspectAttachment ticketInfo@TicketInfo{..} att = do Left _ -> do - printText . renderTicketStatus $ NoKnownIssue - - pure ZendeskResponse + ZendeskResponse { zrTicketId = tiId , zrComment = prettyFormatNoIssues ticketInfo , zrTags = [renderTicketStatus NoKnownIssue] , zrIsPublic = cfgIsCommentPublic } +responseNoLogs :: TicketInfo -> App ZendeskResponse +responseNoLogs TicketInfo{..} = do + Config {..} <- ask + pure ZendeskResponse + { zrTicketId = tiId + , zrComment = prettyFormatNoLogs + , zrTags = [renderTicketStatus NoLogAttached] + , zrIsPublic = cfgIsCommentPublic + } + -- | Filter analyzed tickets filterAnalyzedTickets :: [TicketInfo] -> [TicketInfo] filterAnalyzedTickets ticketsInfo = @@ -288,7 +285,10 @@ filterAnalyzedTickets ticketsInfo = where ticketsFilter :: TicketInfo -> Bool ticketsFilter ticketInfo = - isTicketAnalyzed ticketInfo && isTicketOpen ticketInfo && isTicketBlacklisted ticketInfo + isTicketAnalyzed ticketInfo + && isTicketOpen ticketInfo + && isTicketBlacklisted ticketInfo + && isTicketInGoguenTestnet ticketInfo isTicketAnalyzed :: TicketInfo -> Bool isTicketAnalyzed TicketInfo{..} = (renderTicketStatus AnalyzedByScriptV1_0) `notElem` (getTicketTags tiTags) @@ -301,3 +301,6 @@ filterAnalyzedTickets ticketsInfo = isTicketBlacklisted :: TicketInfo -> Bool isTicketBlacklisted TicketInfo{..} = tiId `notElem` [TicketId 9377,TicketId 10815] + isTicketInGoguenTestnet :: TicketInfo -> Bool + isTicketInGoguenTestnet TicketInfo{..} = "goguen_testnets" `notElem` getTicketTags tiTags + diff --git a/src/LogAnalysis/Classifier.hs b/src/LogAnalysis/Classifier.hs index a153f60..d5df2d1 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 diff --git a/test/Spec.hs b/test/Spec.hs index 9a43153..585f391 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 DataSource -import Lib +import DataSource (App, Comment (..), Config (..), IOLayer (..), TicketInfo (..), + ZendeskLayer (..), ZendeskResponse (..), basicIOLayer, defaultConfig, + emptyZendeskLayer, runApp) +import Lib (listAndSortTickets, processTicket) -- TODO(ks): What we are really missing is a realistic @Gen ZendeskLayer m@. @@ -94,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 @@ -112,25 +114,21 @@ processTicketSpec = let stubbedConfig :: Config stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer - let appExecution :: IO [ZendeskResponse] + let appExecution :: IO (Maybe ZendeskResponse) appExecution = runApp (processTicket . tiId $ ticketInfo) stubbedConfig zendeskComments <- run appExecution -- Check we have some comments. - assert $ length zendeskComments == 0 + assert $ isNothing zendeskComments - 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 - -- A simple precondition. - pre $ any (\comment -> length (cAttachments comment) > 0) comments - let stubbedZendeskLayer :: ZendeskLayer App stubbedZendeskLayer = emptyZendeskLayer @@ -144,13 +142,76 @@ processTicketSpec = let stubbedConfig :: Config stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer - let appExecution :: IO [ZendeskResponse] + let appExecution :: IO (Maybe ZendeskResponse) appExecution = runApp (processTicket . tiId $ ticketInfo) stubbedConfig - zendeskResponses <- run appExecution + zendeskResponse <- run appExecution -- Check we have some comments. - assert $ length zendeskResponses > 0 + assert $ isJust zendeskResponse + + it "processes ticket, with no attachments" $ + forAll (listOf1 genCommentWithNoAttachment) $ \(commentsWithoutAttachment :: [Comment]) -> + forAll arbitrary $ \(ticketInfo :: TicketInfo) -> + monadicIO $ do + + let stubbedZendeskLayer :: ZendeskLayer App + stubbedZendeskLayer = + emptyZendeskLayer + { zlGetTicketComments = \_ -> pure commentsWithoutAttachment + , zlGetTicketInfo = \_ -> pure $ Just ticketInfo + , zlPostTicketComment = \_ -> pure () + } + + let stubbedConfig :: Config + stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer + + let appExecution :: IO (Maybe ZendeskResponse) + appExecution = runApp (processTicket . tiId $ ticketInfo) stubbedConfig + + zendeskResponse <- run appExecution + + assert $ isJust zendeskResponse + assert $ isResponseTaggedWithNoLogs zendeskResponse + + it "processes ticket, with attachments" $ + forAll (listOf1 arbitrary) $ \(comments :: [Comment]) -> + forAll arbitrary $ \(ticketInfo :: TicketInfo) -> + monadicIO $ do + + pre $ any (not . null . cAttachments) comments + + let stubbedZendeskLayer :: ZendeskLayer App + stubbedZendeskLayer = + emptyZendeskLayer + { zlGetTicketComments = \_ -> pure comments + , zlGetTicketInfo = \_ -> pure $ Just ticketInfo + , zlPostTicketComment = \_ -> pure () + , zlGetAttachment = \_ -> pure $ Just mempty + } + + let stubbedConfig :: Config + stubbedConfig = withStubbedIOAndZendeskLayer stubbedZendeskLayer + + let appExecution :: IO (Maybe ZendeskResponse) + appExecution = runApp (processTicket . tiId $ ticketInfo) stubbedConfig + + zendeskResponse <- run appExecution + + assert $ isJust zendeskResponse + assert $ not (isResponseTaggedWithNoLogs zendeskResponse) + +isResponseTaggedWithNoLogs :: Maybe ZendeskResponse -> Bool +isResponseTaggedWithNoLogs (Just response) = "no-log-files" `elem` zrTags response +isResponseTaggedWithNoLogs Nothing = False + +genCommentWithNoAttachment :: Gen Comment +genCommentWithNoAttachment = Comment + <$> arbitrary + <*> arbitrary + <*> return mempty + <*> arbitrary + <*> arbitrary processTicketsSpec :: Spec processTicketsSpec =