From 4e0bc448fdf67b2fe2836710bb0a6a8cf9c5925b Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Tue, 8 May 2018 17:28:59 +0900 Subject: [PATCH 1/7] Use options.applicative for parsing --- log-classifier.cabal | 1 + src/CLI.hs | 47 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 48 insertions(+) create mode 100644 src/CLI.hs diff --git a/log-classifier.cabal b/log-classifier.cabal index 27ba9f5..5e9ce6c 100644 --- a/log-classifier.cabal +++ b/log-classifier.cabal @@ -34,6 +34,7 @@ library , containers , http-conduit , mtl + , optparse-applicative , reflection , regex-tdfa , text diff --git a/src/CLI.hs b/src/CLI.hs new file mode 100644 index 0000000..f0eff21 --- /dev/null +++ b/src/CLI.hs @@ -0,0 +1,47 @@ +module CLI + ( getCliArgument + ) where + +import Data.Semigroup ((<>)) +import Options.Applicative +import Paths_log_classifier (version) + + +data CLI + = CollectEmails + | ProcessTicket Int + | ProcessTickets + | ShowStatistics + deriving (Eq, Show) + +cmdProcessTicket :: Parser CLI +cmdProcessTicket = ProcessTicket <$> + argument auto (metavar "TICKET_ID" + <> help "Specify ticket id to analyze") + +cli :: Parser CLI +cli = subparser + ( + command "collectEmails" (info (pure CollectEmails) + (progDesc "Collect emails requested by single user")) + <> command "processTickets" (info (pure ProcessTickets) + (progDesc "Process all the tickets i.e add comments, tags.")) + <> command "processTicket" (info cmdProcessTicket + (progDesc "Process Zendesk ticket of an given ")) + <> command "showStats" (info (pure ShowStatistics) + (progDesc "Print list of ticket Ids that agent has been assigned")) + ) + +getCliArgs :: IO CLI +getCliArgs = execParser opts + where + opts = info (cli <**> helper <**> versionHelper) + ( fullDesc + <> header "Log classifier" + <> progDesc "Client for peforming analysis on Zendesk" + ) + versionHelper = + infoOption + ("Log classifier version" <> show version) + (long "version" <> help "Show version") + \ No newline at end of file From c32a1b77a3387a32e7bfa84c9f14bae67ed1f776 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Wed, 9 May 2018 09:47:59 +0900 Subject: [PATCH 2/7] Use Options.Applicative to parse command line arguments --- log-classifier.cabal | 1 + src/CLI.hs | 37 ++++++---- src/Zendesk.hs | 165 ++++++++++++++++++++----------------------- 3 files changed, 101 insertions(+), 102 deletions(-) diff --git a/log-classifier.cabal b/log-classifier.cabal index 5e9ce6c..42ef0ae 100644 --- a/log-classifier.cabal +++ b/log-classifier.cabal @@ -16,6 +16,7 @@ cabal-version: >= 1.10 library hs-source-dirs: src exposed-modules: Classify + CLI Lib LogAnalysis.Classifier LogAnalysis.KnowledgeCSVParser diff --git a/src/CLI.hs b/src/CLI.hs index f0eff21..698916c 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -1,36 +1,47 @@ module CLI - ( getCliArgument + ( CLI(..) + , getCliArgs ) where import Data.Semigroup ((<>)) -import Options.Applicative +import Options.Applicative (Parser, argument, auto, command, execParser, fullDesc, header, + help, helper, info, infoOption, long, metavar, progDesc, + strOption, subparser, (<**>)) import Paths_log_classifier (version) - data CLI = CollectEmails | ProcessTicket Int | ProcessTickets + | RawRequest String | ShowStatistics deriving (Eq, Show) +-- How do I dispaly helper.. cmdProcessTicket :: Parser CLI -cmdProcessTicket = ProcessTicket <$> - argument auto (metavar "TICKET_ID" - <> help "Specify ticket id to analyze") +cmdProcessTicket = ProcessTicket <$> argument auto + ( metavar "TICKET_ID" + <> help "Specify ticket id to analyze") + +cmdRawRequest :: Parser CLI +cmdRawRequest = RawRequest <$> strOption + ( metavar "URL" + <> help "Specify url to request") cli :: Parser CLI -cli = subparser - ( +cli = subparser $ mconcat + [ command "collectEmails" (info (pure CollectEmails) (progDesc "Collect emails requested by single user")) - <> command "processTickets" (info (pure ProcessTickets) + , command "processTickets" (info (pure ProcessTickets) (progDesc "Process all the tickets i.e add comments, tags.")) - <> command "processTicket" (info cmdProcessTicket + , command "processTicket" (info cmdProcessTicket (progDesc "Process Zendesk ticket of an given ")) - <> command "showStats" (info (pure ShowStatistics) + , command "rawRequest" (info cmdRawRequest + (progDesc "Raw request to the given url")) + , command "showStats" (info (pure ShowStatistics) (progDesc "Print list of ticket Ids that agent has been assigned")) - ) + ] getCliArgs :: IO CLI getCliArgs = execParser opts @@ -44,4 +55,4 @@ getCliArgs = execParser opts infoOption ("Log classifier version" <> show version) (long "version" <> help "Show version") - \ No newline at end of file + diff --git a/src/Zendesk.hs b/src/Zendesk.hs index 1d117d1..eb9a47d 100644 --- a/src/Zendesk.hs +++ b/src/Zendesk.hs @@ -26,8 +26,8 @@ import qualified Data.Text.Lazy.IO as LT import Network.HTTP.Simple (Request, addRequestHeader, getResponseBody, httpJSON, httpLBS, parseRequest_, setRequestBasicAuth, setRequestBodyJSON, setRequestMethod, setRequestPath) -import System.Environment (getArgs) +import CLI (CLI (..), getCliArgs) import LogAnalysis.Classifier (extractErrorCodes, extractIssuesFromLogs, prettyFormatAnalysis) import LogAnalysis.KnowledgeCSVParser (parseKnowLedgeBase) @@ -78,6 +78,7 @@ assignToPath = "./tmp-secrets/assign_to" runZendeskMain :: IO () runZendeskMain = do + args <- getCliArgs putStrLn "Welcome to Zendesk classifier!" token <- B8.readFile tokenPath -- Zendesk token assignto <- B8.readFile assignToPath -- Select assignee @@ -88,52 +89,41 @@ runZendeskMain = do } agentId <- runApp getAgentId cfg' let cfg = cfg' { cfgAgentId = agentId } - args <- getArgs case args of - -- Process all the tikects that are requested by agent - [ "extractEmailAddress" ] -> do - T.putStrLn $ "Classifier is going to extract emails requested by: " <> cfgEmail cfg - tickets <- runApp (listTickets Requested) cfg - putStrLn $ "There are " <> show (length tickets) <> " tickets requested by this user." - let ticketIds = foldr (\TicketInfo{..} acc -> ticketId : acc) [] tickets - mapM_ (\tid -> runApp (extractEmailAddress tid) cfg) ticketIds - -- Process given ticket - [ "processTicket", ticketId ] -> do - putStrLn "Processing single ticket" - runApp (processTicketAndId $ read ticketId) cfg - putStrLn "Process finished, please see the following url" - putStrLn $ "https://iohk.zendesk.com/agent/tickets/" <> ticketId - -- Process all the tickets (WARNING: This is really long process) - [ "processTickets" ] -> do - T.putStrLn $ "Classifier is going to process tickets assign to: " <> cfgEmail cfg - printWarning - tickets <- runApp (listTickets Assigned) cfg - let filteredTicketIds = filterAnalyzedTickets tickets - putStrLn $ "There are " <> show (length filteredTicketIds) <> " unanalyzed tickets." - putStrLn "Processing tickets, this may take hours to finish." - mapM_ (\tid -> runApp (processTicketAndId tid) cfg) filteredTicketIds - putStrLn "All the tickets has been processed." - -- Return raw request - [ "raw_request", url ] -> do - let - req = apiRequest cfg (T.pack url) - res <- apiCall (pure . encodeToLazyText) req - LT.putStrLn res - -- Count assigned tickets - [ "showStats" ] -> do - T.putStrLn $ "Classifier is going to gather ticket information assigned to: " <> cfgEmail cfg - printWarning - tickets <- runApp (listTickets Assigned) cfg - printTicketCountMessage tickets (cfgEmail cfg) - _ -> do - let cmdItem = [ "extractEmailAddress : Collect emails requested by single user" - , "processTicket : Process single ticket of id" - , "processTickets : Process all the tickets i.e add comments, tags. WARNING:" <> - "This is really long process, please use with care" - , "raw_request : Request raw request to the given url" - , "showStats : Print list of ticket Ids that agent has been assigned"] - putStrLn "Invalid argument, please add following argument to run the command:" - mapM_ putStrLn cmdItem + -- Process all the tikects that are requested by agent + CollectEmails -> do + T.putStrLn $ "Classifier is going to extract emails requested by: " <> cfgEmail cfg + tickets <- runApp (listTickets Requested) cfg + putStrLn $ "There are " <> show (length tickets) <> " tickets requested by this user." + let ticketIds = foldr (\TicketInfo{..} acc -> ticketId : acc) [] tickets + mapM_ (\tid -> runApp (extractEmailAddress tid) cfg) ticketIds + -- Process given ticket + (ProcessTicket ticketId) -> do + putStrLn "Processing single ticket" + runApp (processTicketAndId ticketId) cfg + putStrLn "Process finished, please see the following url" + putStrLn $ "https://iohk.zendesk.com/agent/tickets/" <> show ticketId + -- Process all the tickets (WARNING: This is really long process) + ProcessTickets -> do + T.putStrLn $ "Classifier is going to process tickets assign to: " <> cfgEmail cfg + printWarning + tickets <- runApp (listTickets Assigned) cfg + let filteredTicketIds = filterAnalyzedTickets tickets + putStrLn $ "There are " <> show (length filteredTicketIds) <> " unanalyzed tickets." + putStrLn "Processing tickets, this may take hours to finish." + mapM_ (\tid -> runApp (processTicketAndId tid) cfg) filteredTicketIds + putStrLn "All the tickets has been processed." + -- Return raw request + (RawRequest url) -> do + let req = apiRequest cfg (T.pack url) + res <- apiCall (pure . encodeToLazyText) req + LT.putStrLn res + -- Collect statistics + ShowStatistics -> do + T.putStrLn $ "Classifier is going to gather ticket information assigned to: " <> cfgEmail cfg + printWarning + tickets <- runApp (listTickets Assigned) cfg + printTicketCountMessage tickets (cfgEmail cfg) -- | Warning printWarning :: IO () @@ -157,8 +147,8 @@ printTicketCountMessage tickets email = do sortTickets :: [TicketInfo] -> [(Text, Int)] sortTickets tickets = let extractedTags = foldr (\TicketInfo{..} acc -> ticketTags <> acc) [] tickets -- Extract tags from tickets - filteredTags = filter (`notElem` ["s3", "s2", "cannot-sync", "closed-by-merge", - "web_widget", "analyzed-by-script"]) extractedTags -- Filter tags + tags2Filter = ["s3", "s2", "cannot-sync", "closed-by-merge", "web_widget", "analyzed-by-script"] + filteredTags = filter (`notElem` tags2Filter) extractedTags -- Filter tags groupByTags :: [ Text ] -> [(Text, Int)] groupByTags ts = map (\l@(x:_) -> (x, length l)) (group $ sort ts) -- Group them in groupByTags filteredTags @@ -200,13 +190,9 @@ processTicketAndId ticketId = do -- | Inspect attachment then post comment to the ticket inspectAttachmentAndPostComment :: TicketId -> Attachment -> App () -inspectAttachmentAndPostComment ticketId att = do - Config{..} <- ask +inspectAttachmentAndPostComment ticketId attachment = do liftIO $ putStrLn $ "Analyzing ticket id: " <> show ticketId - (comment, tags, isPublicComment) <- liftIO $ inspectAttachment - cfgNumOfLogsToAnalyze - cfgKnowledgebase - att + (comment, tags, isPublicComment) <- inspectAttachment attachment postTicketComment ticketId comment tags isPublicComment -- | Given number of file of inspect, knowledgebase and attachment, @@ -215,26 +201,27 @@ inspectAttachmentAndPostComment ticketId att = do -- The results are following: -- -- __(comment, tags, bool of whether is should be public comment)__ -inspectAttachment :: Int -> [Knowledge] -> Attachment -> IO (Text, [Text], Bool) -inspectAttachment num ks att = do - rawlog <- getAttachment att -- Get attachment - let results = extractLogsFromZip num rawlog +inspectAttachment :: Attachment -> App (Text, [Text], Bool) +inspectAttachment att = do + Config{..} <- ask + rawlog <- liftIO $ getAttachment att -- Get attachment + let results = extractLogsFromZip cfgNumOfLogsToAnalyze rawlog case results of - Left err -> do - putStrLn $ "Error parsing zip:" <> err - return (toComment SentLogCorrupted , [toTag SentLogCorrupted], False) - Right result -> do - let analysisEnv = setupAnalysis ks - eitherAnalysisResult = extractIssuesFromLogs result analysisEnv - case eitherAnalysisResult of - Right analysisResult -> do -- do something! - let errorCodes = extractErrorCodes analysisResult - let commentRes = prettyFormatAnalysis analysisResult - mapM_ T.putStrLn errorCodes - return (LT.toStrict commentRes, errorCodes, False) - Left noResult -> do - putStrLn noResult - return (LT.toStrict (LT.pack noResult), [tshow NoKnownIssue], False) + Left err -> do + liftIO $ putStrLn $ "Error parsing zip:" <> err + return (toComment SentLogCorrupted , [toTag SentLogCorrupted], False) + Right result -> do + let analysisEnv = setupAnalysis cfgKnowledgebase + eitherAnalysisResult = extractIssuesFromLogs result analysisEnv + case eitherAnalysisResult of + Right analysisResult -> do -- do something! + let errorCodes = extractErrorCodes analysisResult + let commentRes = prettyFormatAnalysis analysisResult + liftIO $ mapM_ T.putStrLn errorCodes + return (LT.toStrict commentRes, errorCodes, False) + Left noResult -> do + liftIO $ putStrLn noResult + return (LT.toStrict (LT.pack noResult), [tshow NoKnownIssue], False) -- | Filter analyzed tickets filterAnalyzedTickets :: [TicketInfo] -> [TicketId] @@ -260,28 +247,28 @@ listTickets request = do let req' = apiRequestAbsolute cfg nextPage' (TicketList pagen nextPagen) <- apiCall parseTickets req' case nextPagen of - Just nextUrl -> go (list <> pagen) nextUrl - Nothing -> pure (list <> pagen) + Just nextUrl -> go (list <> pagen) nextUrl + Nothing -> pure (list <> pagen) (TicketList page0 nextPage) <- liftIO $ apiCall parseTickets req case nextPage of - Just nextUrl -> liftIO $ go page0 nextUrl - Nothing -> pure page0 + Just nextUrl -> liftIO $ go page0 nextUrl + Nothing -> pure page0 -- | Send API request to post comment postTicketComment :: TicketId -> Text -> [Text] -> Bool -> App () postTicketComment tid body tags public = do cfg <- ask - let - req1 = apiRequest cfg ("tickets/" <> tshow tid <> ".json") - req2 = addJsonBody - (Ticket - (Comment ("**Log classifier**\n\n" <> body) [] public (cfgAgentId cfg)) - (cfgAssignTo cfg) - (tshow AnalyzedByScript:tags) - ) - req1 + let req1 = apiRequest cfg ("tickets/" <> tshow tid <> ".json") + req2 = addJsonBody + (Ticket + (Comment ("**Log classifier**\n\n" <> body) [] public (cfgAgentId cfg)) + (cfgAssignTo cfg) + (tshow AnalyzedByScript:tags) + ) + req1 void $ liftIO $ apiCall (pure . encodeToLazyText) req2 + pure () -- | Get agent id that has been set on Config getAgentId :: App Integer @@ -311,9 +298,9 @@ apiCall :: FromJSON a => (Value -> Parser a) -> Request -> IO a apiCall parser req = do v <- getResponseBody <$> httpJSON req case parseEither parser v of - Right o -> pure o - Left e -> error $ "couldn't parse response " - <> e <> "\n" <> (T.unpack $ T.decodeUtf8 $ BL.toStrict $ encode v) + Right o -> pure o + Left e -> error $ "couldn't parse response " + <> e <> "\n" <> (T.unpack $ T.decodeUtf8 $ BL.toStrict $ encode v) -- | General api request function apiRequest :: Config -> Text -> Request From 8af407492b54d52fc83b4d626d8cd573c3e0f857 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Wed, 9 May 2018 10:21:14 +0900 Subject: [PATCH 3/7] Add comments --- src/CLI.hs | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/src/CLI.hs b/src/CLI.hs index 698916c..e2070b2 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -10,24 +10,26 @@ import Options.Applicative (Parser, argument, auto, command, execParse import Paths_log_classifier (version) data CLI - = CollectEmails - | ProcessTicket Int - | ProcessTickets - | RawRequest String - | ShowStatistics - deriving (Eq, Show) + = CollectEmails -- ^ Collect email addresses + | ProcessTicket Int -- ^ Process ticket of an given ticket id + | ProcessTickets -- ^ Procss all the tickets in the Zendesk + | RawRequest String -- ^ Raw requestto the given url + | ShowStatistics -- ^ Show statistics + deriving (Show) --- How do I dispaly helper.. +-- | Parser for ProcessTicket cmdProcessTicket :: Parser CLI cmdProcessTicket = ProcessTicket <$> argument auto ( metavar "TICKET_ID" <> help "Specify ticket id to analyze") +-- | Parser for RawRequest cmdRawRequest :: Parser CLI cmdRawRequest = RawRequest <$> strOption ( metavar "URL" <> help "Specify url to request") +-- | Parser for CLI commands cli :: Parser CLI cli = subparser $ mconcat [ From 3fea8e39f1cc14f243bd108a12f3ac72ec0c35c7 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Wed, 9 May 2018 10:56:44 +0900 Subject: [PATCH 4/7] Update default.nix --- default.nix | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/default.nix b/default.nix index 4e8e0d6..ec9adef 100644 --- a/default.nix +++ b/default.nix @@ -1,7 +1,8 @@ with import {}; let - ghc = haskellPackages.ghcWithPackages (ps: with ps; [ zip-archive regex-tdfa reflection aeson http-conduit attoparsec ]); + ghc = haskellPackages.ghcWithPackages (ps: with ps; [aeson array attoparsec bytestring containers http-conduit + mtl optparse-applicative regex-tdfa reflection zip-archive]); in runCommand "log-classifier" { buildInputs = [ ghc haskellPackages.ghcid ]; } '' cp -r ${builtins.fetchGit ./.} src chmod -R +w src From ec2b06ee67221309fccacbc1db8c39a1e955b7a6 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Wed, 9 May 2018 12:36:28 +0900 Subject: [PATCH 5/7] Fix typo --- src/CLI.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/CLI.hs b/src/CLI.hs index e2070b2..1d057f6 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -13,7 +13,7 @@ data CLI = CollectEmails -- ^ Collect email addresses | ProcessTicket Int -- ^ Process ticket of an given ticket id | ProcessTickets -- ^ Procss all the tickets in the Zendesk - | RawRequest String -- ^ Raw requestto the given url + | RawRequest String -- ^ Raw request to the given url | ShowStatistics -- ^ Show statistics deriving (Show) From 6b83383fcfcc464b30789798f0ce202ebf1e6d46 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Wed, 9 May 2018 12:55:39 +0900 Subject: [PATCH 6/7] Display helper message on sub commands --- src/CLI.hs | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/src/CLI.hs b/src/CLI.hs index 1d057f6..b68530f 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -5,8 +5,8 @@ module CLI import Data.Semigroup ((<>)) import Options.Applicative (Parser, argument, auto, command, execParser, fullDesc, header, - help, helper, info, infoOption, long, metavar, progDesc, - strOption, subparser, (<**>)) + help, helper, hsubparser, info, infoOption, long, metavar, + progDesc, strOption, (<**>)) import Paths_log_classifier (version) data CLI @@ -21,24 +21,24 @@ data CLI cmdProcessTicket :: Parser CLI cmdProcessTicket = ProcessTicket <$> argument auto ( metavar "TICKET_ID" - <> help "Specify ticket id to analyze") + <> help "Ticket id to analyze") -- | Parser for RawRequest cmdRawRequest :: Parser CLI cmdRawRequest = RawRequest <$> strOption ( metavar "URL" - <> help "Specify url to request") + <> help "Url to request") -- | Parser for CLI commands cli :: Parser CLI -cli = subparser $ mconcat +cli = hsubparser $ mconcat [ command "collectEmails" (info (pure CollectEmails) (progDesc "Collect emails requested by single user")) , command "processTickets" (info (pure ProcessTickets) (progDesc "Process all the tickets i.e add comments, tags.")) , command "processTicket" (info cmdProcessTicket - (progDesc "Process Zendesk ticket of an given ")) + (progDesc "Process Zendesk ticket of an given ticket id")) , command "rawRequest" (info cmdRawRequest (progDesc "Raw request to the given url")) , command "showStats" (info (pure ShowStatistics) @@ -53,8 +53,6 @@ getCliArgs = execParser opts <> header "Log classifier" <> progDesc "Client for peforming analysis on Zendesk" ) - versionHelper = - infoOption - ("Log classifier version" <> show version) - (long "version" <> help "Show version") - + versionHelper = infoOption + ("Log classifier version" <> show version) + (long "version" <> help "Show version") From f5b7a4c9118b08acc2104f84fa5df6d105a537a5 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Mon, 14 May 2018 08:53:03 +0900 Subject: [PATCH 7/7] Use kebab-case instead --- src/CLI.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/CLI.hs b/src/CLI.hs index b68530f..18f5bea 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -33,15 +33,15 @@ cmdRawRequest = RawRequest <$> strOption cli :: Parser CLI cli = hsubparser $ mconcat [ - command "collectEmails" (info (pure CollectEmails) + command "collect-emails" (info (pure CollectEmails) (progDesc "Collect emails requested by single user")) - , command "processTickets" (info (pure ProcessTickets) + , command "process-tickets" (info (pure ProcessTickets) (progDesc "Process all the tickets i.e add comments, tags.")) - , command "processTicket" (info cmdProcessTicket + , command "process-ticket" (info cmdProcessTicket (progDesc "Process Zendesk ticket of an given ticket id")) - , command "rawRequest" (info cmdRawRequest + , command "raw-request" (info cmdRawRequest (progDesc "Raw request to the given url")) - , command "showStats" (info (pure ShowStatistics) + , command "show-stats" (info (pure ShowStatistics) (progDesc "Print list of ticket Ids that agent has been assigned")) ]