diff --git a/src/DataSource/Http.hs b/src/DataSource/Http.hs index 1f20886..e3ddb58 100644 --- a/src/DataSource/Http.hs +++ b/src/DataSource/Http.hs @@ -212,8 +212,11 @@ postTicketComment ticketInfo zendeskResponse = do createResponseTicket :: Integer -> TicketInfo -> ZendeskResponse -> Ticket createResponseTicket agentId TicketInfo{..} ZendeskResponse{..} = let analyzedTag = renderTicketStatus AnalyzedByScriptV1_3 - -- Nub so it won't post duplicate tags - mergedTags = TicketTags . nub $ [analyzedTag] <> getTicketTags tiTags <> getTicketTags zrTags + -- Nub so it won't post duplicate tags + allTags = nub $ [analyzedTag] <> getTicketTags tiTags <> getTicketTags zrTags + -- We remove the @ToBeAnalyzed@ tag. + mergedTags = TicketTags . filter (/= renderTicketStatus ToBeAnalyzed) $ allTags + in (Ticket (Comment (CommentId 0) (CommentBody zrComment) diff --git a/src/DataSource/Types.hs b/src/DataSource/Types.hs index 0691ced..9f86561 100644 --- a/src/DataSource/Types.hs +++ b/src/DataSource/Types.hs @@ -71,7 +71,7 @@ import Network.HTTP.Simple (Request) import LogAnalysis.Types (Knowledge) -import Test.QuickCheck (Arbitrary (..), elements, listOf1, vectorOf) +import Test.QuickCheck (Arbitrary (..), sublistOf, elements, listOf1) ------------------------------------------------------------ -- Configuration @@ -420,7 +420,7 @@ newtype TicketURL = TicketURL newtype TicketTags = TicketTags { getTicketTags :: [Text] -- TODO(ks): We need to fix the @TicketTag@ / @TicketTags@ story. - } deriving (Eq, Show, Ord, Generic, FromJSON, ToJSON) + } deriving (Eq, Show, Ord, Generic, Semigroup, FromJSON, ToJSON) newtype TicketStatus = TicketStatus { getTicketStatus :: Text @@ -535,8 +535,108 @@ instance Arbitrary TicketStatus where instance Arbitrary TicketTags where arbitrary = do - numberOfTag <- arbitrary - tagsList <- map fromString <$> vectorOf numberOfTag arbitrary + -- curl https://iohk.zendesk.com/api/v2/tags.json -v -u $EMAIL/token:$TOKEN | jq '.tags | .[] | .name' + -- Without `analyzed-by-script` and `goguen_testnets` + let possibleTags :: [Text] + possibleTags = + [ "english" + , "sev_3" + , "daedalus_0.10.1_cardano_1.2.1" + , "windows_10" + , "daedalus_wallet" + , "s3" + , "wallet_application" + , "connection" + , "no-log-files" + , "generic" + , "cannot_sync_blocks" + , "japanese" + , "cannot_connect" + , "delayed_reply" + , "reply_resolved" + , "install_latest_release" + , "syncing" + , "no-known-issues" + , "web_widget" + , "network-error" + , "miscellaneous" + , "connection-refused" + , "cannot-connect" + , "closed_by_merge" + , "ask_for_info" + , "time-out-of-sync" + , "directory-not-found" + , "db-corrupted" + , "iohks-28" + , "unknown" + , "stale-lock-file" + , "resource-vanished" + , "error" + , "global-time" + , "sent-log-corrupted" + , "pass_to_dev" + , "cannot_connect_to_wallet_using_network" + , "to_be_analysed" + , "lite_wallet" + , "operation" + , "restore" + , "traffic_censored" + , "lost_recovery_prase" + , "chinese" + , "lost_password" + , "already_exists" + , "cannot_see_transaction" + , "support" + , "lost_ada" + , "macos_10.13" + , "user-name-error" + , "windows_7" + , "daniel_categorization" + , "installation" + , "short-storage" + , "transaction" + , "go_to_cardano_hub" + , "issue_with_using_the_wallet" + , "balance" + , "login_feature" + , "daedalus" + , "spam" + , "backup" + , "app_cannot_sync_to_network" + , "incorrect-balance" + , "software_release" + , "windows_8" + , "wallet-backup" + , "reply" + , "coin_redemption" + , "cannot-sync" + , "how_to_buy_ada" + , "missing_field_config_file" + , "balance_mismatch" + , "macos_10.11" + , "wallet_balance_zero" + , "iohks-44" + , "where_is_cert" + , "other" + , "testnet_goguen_v1.0" + , "scam" + , "port_in_use" + , "open.lock_file" + , "cannot-download" + , "testnet_goguen" + , "staking" + , "macos_10.12" + , "security" + , "no_disk_space" + , "cannot-restore" + , "can-not-sync" + , "linux" + , "problem_solved_by_release" + , "sev3" + , "linux_beta" + , "russian" + ] + tagsList <- sublistOf possibleTags pure . TicketTags $ tagsList instance Arbitrary TicketURL where diff --git a/src/Lib.hs b/src/Lib.hs index 553e9bc..939dbb1 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -395,8 +395,8 @@ listAndSortTickets = do Config{..} <- ask - listAgents <- asksDataLayer zlListAdminAgents - agents <- listAgents + listAgents <- asksDataLayer zlListAdminAgents + agents <- listAgents let agentIds :: [UserId] agentIds = map uId agents @@ -406,7 +406,7 @@ listAndSortTickets = do printText "Classifier is going to process tickets assigned to agents" - ticketInfos <- map concat $ traverse listTickets agentIds + ticketInfos <- map concat $ traverse listTickets agentIds let filteredTicketIds = filterAnalyzedTickets ticketInfos let sortedTicketIds = sortBy compare filteredTicketIds diff --git a/test/Spec.hs b/test/Spec.hs index a97423d..405e926 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -2,17 +2,21 @@ module Main where import Universum +import Data.List (nub) + import Test.Hspec (Spec, describe, hspec, it, pending, shouldBe) import Test.Hspec.QuickCheck (modifyMaxSuccess) -import Test.QuickCheck (Gen, arbitrary, elements, forAll, listOf, listOf1, property) +import Test.QuickCheck (Gen, arbitrary, elements, forAll, listOf, listOf1, property, + (===)) import Test.QuickCheck.Monadic (assert, monadicIO, pre, run) -import Configuration (defaultConfig, basicIOLayer) -import DataSource (App, Attachment (..), Comment (..), Config (..), DeletedTicket (..), - ExportFromTime (..), IOLayer (..), Ticket (..), TicketId (..), - TicketInfo (..), TicketStatus (..), TicketTags (..), User, UserId (..), - ZendeskAPIUrl (..), DataLayer (..), ZendeskResponse (..), - createResponseTicket , runApp, showURL, emptyDBLayer, emptyDataLayer) +import Configuration (basicIOLayer, defaultConfig) +import DataSource (App, Attachment (..), Comment (..), Config (..), DataLayer (..), + DeletedTicket (..), ExportFromTime (..), IOLayer (..), Ticket (..), + TicketId (..), TicketInfo (..), TicketStatus (..), TicketTag (..), + TicketTags (..), User, UserId (..), ZendeskAPIUrl (..), + ZendeskResponse (..), createResponseTicket, emptyDBLayer, + emptyDataLayer, renderTicketStatus, runApp, showURL) import Exceptions (ProcessTicketExceptions (..)) import Lib (exportZendeskDataToLocalDB, filterAnalyzedTickets, listAndSortTickets, @@ -494,11 +498,11 @@ createResponseTicketSpec = it "should preserve tags from ticketinfo and zendeskresponse" $ property $ \agentId ticketInfo zendeskResponse -> let responseTicket = createResponseTicket agentId ticketInfo zendeskResponse - ticketInfoTags = getTicketTags (tiTags ticketInfo) - zendeskResponseTags = getTicketTags (zrTags zendeskResponse) - mergedTags = ticketInfoTags <> zendeskResponseTags + mergedTags = getTicketTags $ tiTags ticketInfo <> zrTags zendeskResponse responseTags = getTicketTags $ tTag responseTicket - in all (`elem` responseTags) mergedTags + -- in summary, the response tags have the debuggers `analyzed-by-script-version` tag AND + -- they remove the `to_be_analysed` tag AND they are unique. + in (filter (/= renderTicketStatus ToBeAnalyzed) . nub $ renderTicketStatus AnalyzedByScriptV1_3 : mergedTags) === responseTags exportZendeskDataToLocalDBSpec :: Spec