From 63601961304b1f553788caf5c09b3c32c3cd9827 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 10 May 2018 10:10:06 +0900 Subject: [PATCH 01/13] Add universum library --- default.nix | 2 +- log-classifier.cabal | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/default.nix b/default.nix index ec9adef..c2c62fe 100644 --- a/default.nix +++ b/default.nix @@ -2,7 +2,7 @@ with import {}; let ghc = haskellPackages.ghcWithPackages (ps: with ps; [aeson array attoparsec bytestring containers http-conduit - mtl optparse-applicative regex-tdfa reflection zip-archive]); + mtl optparse-applicative regex-tdfa reflection universum zip-archive]); in runCommand "log-classifier" { buildInputs = [ ghc haskellPackages.ghcid ]; } '' cp -r ${builtins.fetchGit ./.} src chmod -R +w src diff --git a/log-classifier.cabal b/log-classifier.cabal index 42ef0ae..29787f5 100644 --- a/log-classifier.cabal +++ b/log-classifier.cabal @@ -36,15 +36,18 @@ library , http-conduit , mtl , optparse-applicative + , safe-exceptions , reflection , regex-tdfa , text + , universum , zip-archive default-language: Haskell2010 default-extensions: TypeOperators DataKinds DefaultSignatures + NoImplicitPrelude MultiParamTypeClasses OverloadedStrings ScopedTypeVariables @@ -67,12 +70,14 @@ executable log-classifier-exe -Wall build-depends: base >=4.7 && <5 , log-classifier + , universum other-modules: Paths_log_classifier default-language: Haskell2010 default-extensions: TypeOperators DataKinds DefaultSignatures + NoImplicitPrelude MultiParamTypeClasses OverloadedStrings ScopedTypeVariables @@ -106,12 +111,14 @@ test-suite log-classifier-test , reflection , regex-tdfa , text + , universum , zip-archive default-language: Haskell2010 default-extensions: TypeOperators DataKinds DefaultSignatures + NoImplicitPrelude MultiParamTypeClasses OverloadedStrings ScopedTypeVariables From 1118a2fc9ad9b21335113c5dcbedc2ab684d4a41 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 10 May 2018 10:12:23 +0900 Subject: [PATCH 02/13] Import universum, this commit is for the ones where importing was simple --- app/Main.hs | 4 +++- src/CLI.hs | 2 ++ src/Lib.hs | 4 ++-- src/LogAnalysis/Classifier.hs | 7 ++++--- src/LogAnalysis/KnowledgeCSVParser.hs | 9 ++++----- src/Regex.hs | 1 + src/Util.hs | 8 +++++--- 7 files changed, 21 insertions(+), 14 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 27d70c7..bcbead0 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,8 @@ module Main where -import Zendesk (runZendeskMain) +import Universum + +import Zendesk (runZendeskMain) main :: IO () main = runZendeskMain diff --git a/src/CLI.hs b/src/CLI.hs index b68530f..0c82d65 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -3,6 +3,8 @@ module CLI , getCliArgs ) where +import Universum + import Data.Semigroup ((<>)) import Options.Applicative (Parser, argument, auto, command, execParser, fullDesc, header, help, helper, hsubparser, info, infoOption, long, metavar, diff --git a/src/Lib.hs b/src/Lib.hs index 2b221f8..de21fde 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -2,7 +2,7 @@ module Lib ( someFunc ) where - +import Universum -- TODO(ks): Here we want to import the functionality we require in cardano-report-server. someFunc :: IO () -someFunc = putStrLn "someFunc" +someFunc = putTextLn "someFunc" diff --git a/src/LogAnalysis/Classifier.hs b/src/LogAnalysis/Classifier.hs index 042e174..3f5b564 100644 --- a/src/LogAnalysis/Classifier.hs +++ b/src/LogAnalysis/Classifier.hs @@ -8,8 +8,9 @@ module LogAnalysis.Classifier , prettyFormatAnalysis ) where +import Universum + import qualified Data.ByteString.Lazy as LBS -import Data.List (foldl') import qualified Data.Map.Strict as Map import Data.Semigroup ((<>)) import Data.Text (Text) @@ -24,7 +25,7 @@ numberOfErrorText :: Int numberOfErrorText = 3 -- | Analyze each log file based on the knowlodgebases' data. -extractIssuesFromLogs :: [LBS.ByteString] -> Analysis -> Either String Analysis +extractIssuesFromLogs :: [LBS.ByteString] -> Analysis -> Either Text Analysis extractIssuesFromLogs files analysis = filterAnalysis $ foldl' runClassifiers analysis files -- | Run analysis on given file @@ -45,7 +46,7 @@ compareWithKnowledge str Knowledge{..} xs = else xs -- | Filter out any records that are empty (i.e couldn't catch any string related) -filterAnalysis :: Analysis -> Either String Analysis +filterAnalysis :: Analysis -> Either Text Analysis filterAnalysis as = do let filteredAnalysis = Map.filter (/=[]) as if null filteredAnalysis diff --git a/src/LogAnalysis/KnowledgeCSVParser.hs b/src/LogAnalysis/KnowledgeCSVParser.hs index c52db08..5c7470d 100644 --- a/src/LogAnalysis/KnowledgeCSVParser.hs +++ b/src/LogAnalysis/KnowledgeCSVParser.hs @@ -4,18 +4,17 @@ module LogAnalysis.KnowledgeCSVParser ( parseKnowLedgeBase ) where -import Control.Applicative -import Data.Attoparsec.Text.Lazy +import Universum + +import Data.Attoparsec.Text.Lazy as ALT import qualified Data.Text.Lazy as LT import LogAnalysis.Types (ErrorCode (..), Knowledge (..)) -import Prelude hiding (takeWhile) - -- |Take any string that is inside quotes insideQuotes :: Parser LT.Text insideQuotes = - LT.append <$> (LT.fromStrict <$> takeWhile (/= '"')) + LT.append <$> (LT.fromStrict <$> ALT.takeWhile (/= '"')) <*> (LT.concat <$> many (LT.cons <$> dquotes <*> insideQuotes)) "inside of double quotes" where diff --git a/src/Regex.hs b/src/Regex.hs index c4960d8..fef7bd5 100644 --- a/src/Regex.hs +++ b/src/Regex.hs @@ -12,6 +12,7 @@ module Regex ) where -- Not used, but want to use it in the future. +import Universum import qualified Data.Array as Array diff --git a/src/Util.hs b/src/Util.hs index d47eeb6..b378ff2 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -4,6 +4,8 @@ module Util , readZip ) where +import Universum + import qualified Codec.Archive.Zip as Zip import qualified Data.ByteString.Lazy as LBS import Data.Map.Strict (Map) @@ -15,7 +17,7 @@ tshow :: Show a => a -> Text tshow = T.pack . show -- | Extract log file from given zip file -extractLogsFromZip :: Int -> LBS.ByteString -> Either String [LBS.ByteString] +extractLogsFromZip :: Int -> LBS.ByteString -> Either Text [LBS.ByteString] extractLogsFromZip numberOfFiles file = do zipMap <- readZip file -- Read File let extractedLogs = Map.elems $ mTake numberOfFiles zipMap -- Extract selected logs @@ -23,9 +25,9 @@ extractLogsFromZip numberOfFiles file = do where mTake n = Map.fromDistinctAscList . take n . Map.toAscList -readZip :: LBS.ByteString -> Either String (Map FilePath LBS.ByteString) +readZip :: LBS.ByteString -> Either Text (Map FilePath LBS.ByteString) readZip rawzip = case Zip.toArchiveOrFail rawzip of - Left err -> Left err + Left err -> Left (toText err) Right archive -> Right $ finishProcessing archive where finishProcessing :: Zip.Archive -> Map FilePath LBS.ByteString From becb939f1f611208786b47f53d172c3277e7710b Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 10 May 2018 11:35:20 +0900 Subject: [PATCH 03/13] Remove any autoderive that is not used, create render function for any datatype that has different show instance than base one --- src/LogAnalysis/Classifier.hs | 5 +++-- src/LogAnalysis/Types.hs | 36 ++++++++++++++++++----------------- src/Types.hs | 25 ++++++++++++------------ 3 files changed, 35 insertions(+), 31 deletions(-) diff --git a/src/LogAnalysis/Classifier.hs b/src/LogAnalysis/Classifier.hs index 3f5b564..eb41ae2 100644 --- a/src/LogAnalysis/Classifier.hs +++ b/src/LogAnalysis/Classifier.hs @@ -18,7 +18,7 @@ import Data.Text.Encoding.Error (ignore) import qualified Data.Text.Lazy as LT import qualified Data.Text.Lazy.Encoding as LT -import LogAnalysis.Types (Analysis, Knowledge (..), toTag) +import LogAnalysis.Types (Analysis, Knowledge (..), renderErrorCode) -- | Number of error texts it should show numberOfErrorText :: Int @@ -54,8 +54,9 @@ filterAnalysis as = do else return $ Map.map (take numberOfErrorText) filteredAnalysis extractErrorCodes :: Analysis -> [ Text ] -extractErrorCodes as = map (\(Knowledge{..}, _) -> toTag kErrorCode) $ Map.toList as +extractErrorCodes as = map (\(Knowledge{..}, _) -> renderErrorCode kErrorCode) $ Map.toList as +-- | TODO: Format the text in better way prettyFormatAnalysis :: Analysis -> LT.Text prettyFormatAnalysis as = let aList = Map.toList as diff --git a/src/LogAnalysis/Types.hs b/src/LogAnalysis/Types.hs index ef18156..13cc6fb 100644 --- a/src/LogAnalysis/Types.hs +++ b/src/LogAnalysis/Types.hs @@ -5,10 +5,12 @@ module LogAnalysis.Types , ErrorCode (..) , Knowledge (..) , setupAnalysis - , toTag + , renderErrorCode , toComment ) where +import Universum + import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Text (Text) @@ -41,22 +43,22 @@ data Knowledge = Knowledge , kSolution :: !LT.Text -- ^ Text describing how to solve the issue } deriving (Show) -toTag :: ErrorCode -> Text -toTag ShortStorage = "short-storage" -toTag UserNameError = "user-name-error" -toTag TimeSync = "time-out-of-sync" -toTag FileNotFound = "directory-not-found" -toTag StaleLockFile = "stale-lock-file" -toTag SentLogCorrupted = "sent-log-corrupted" -toTag DBError = "DB-corrupted" -toTag DBPath = "DB-path-error" -toTag CannotGetDBSize = "cannot-get-db-size" -toTag BalanceError = "incorrect-balance" -toTag NetworkError = "network-error" -toTag ConnectionRefused = "connection-refused" -toTag ResourceVanished = "resource-vanished" -toTag Unknown = "unknown" -toTag Error = "error" +renderErrorCode :: ErrorCode -> Text +renderErrorCode ShortStorage = "short-storage" +renderErrorCode UserNameError = "user-name-error" +renderErrorCode TimeSync = "time-out-of-sync" +renderErrorCode FileNotFound = "directory-not-found" +renderErrorCode StaleLockFile = "stale-lock-file" +renderErrorCode SentLogCorrupted = "sent-log-corrupted" +renderErrorCode DBError = "DB-corrupted" +renderErrorCode DBPath = "DB-path-error" +renderErrorCode CannotGetDBSize = "cannot-get-db-size" +renderErrorCode BalanceError = "incorrect-balance" +renderErrorCode NetworkError = "network-error" +renderErrorCode ConnectionRefused = "connection-refused" +renderErrorCode ResourceVanished = "resource-vanished" +renderErrorCode Unknown = "unknown" +renderErrorCode Error = "error" toComment :: ErrorCode -> Text toComment SentLogCorrupted = "Log file is corrupted" diff --git a/src/Types.hs b/src/Types.hs index 6f06d01..c430e43 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -12,8 +12,11 @@ module Types , parseAgentId , parseComments , parseTickets + , renderTicketStatus ) where +import Universum + import Data.Aeson import Data.Aeson.Types (Parser) import Data.Text (Text) @@ -24,52 +27,50 @@ data Comment = Comment , commentAttachments :: ![Attachment] -- ^ Attachment , commentPublic :: !Bool -- ^ Flag of whether comment should be public , commentAuthor :: !Integer -- ^ Auther of comment - } deriving (Show, Eq) + } -- | Outer comment ?? newtype CommentOuter = CommentOuter { coComment :: Comment - } deriving (Show, Eq) + } -- | Attachment of the ticket data Attachment = Attachment { attachmentURL :: !Text -- ^ URL of the attachment , attachmentContentType :: !Text -- ^ ContentType of the attachment , attachmentSize :: !Int -- ^ Attachment size - } deriving (Show, Eq) + } -- | Zendexk ticket data Ticket = Ticket { ticketComment :: !Comment -- ^ Ticket comment , ticketAssignee :: !Integer -- ^ Assignee of the ticket , ticketTag :: ![Text] -- ^ Tags attached to ticket - } deriving (Show, Eq) + } -- | List of zendesk ticket data TicketList = TicketList { ticketListTickets :: ![TicketInfo] -- ^ Information of tickets , nextPage :: Maybe Text -- ^ Next page - } deriving (Show, Eq) + } type TicketId = Int data TicketInfo = TicketInfo { ticketId :: !Int -- ^ Id of an ticket , ticketTags :: ![Text] -- ^ Tags associated with ticket - } deriving (Eq) - -instance Show TicketInfo where - show (TicketInfo tid _) = show tid + } -- | Ticket status data TicketStatus = AnalyzedByScript -- ^ Ticket has been analyzed | NoKnownIssue -- ^ Ticket had no known issue + deriving Show -- | Defining it's own show instance to use it as tags -instance Show TicketStatus where - show AnalyzedByScript = "analyzed-by-script" - show NoKnownIssue = "no-known-issues" +renderTicketStatus :: TicketStatus -> Text +renderTicketStatus AnalyzedByScript = "analyzed-by-script" +renderTicketStatus NoKnownIssue = "no-known-issues" -- | JSON Parsing instance FromJSON Comment where From abbb4b15228d69e39d202dd6707052a9b868cf1c Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 10 May 2018 13:47:05 +0900 Subject: [PATCH 04/13] Migrate to Universum on Zendesk.hs --- src/Zendesk.hs | 144 ++++++++++++++++++++++++------------------------- 1 file changed, 70 insertions(+), 74 deletions(-) diff --git a/src/Zendesk.hs b/src/Zendesk.hs index eb9a47d..346c255 100644 --- a/src/Zendesk.hs +++ b/src/Zendesk.hs @@ -6,23 +6,14 @@ module Zendesk ( runZendeskMain ) where -import Control.Monad (guard, void) -import Control.Monad.IO.Class (MonadIO, liftIO) +import Universum + import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT) import Data.Aeson (FromJSON, ToJSON, Value, encode) import Data.Aeson.Text (encodeToLazyText) import Data.Aeson.Types (Parser, parseEither) import Data.Attoparsec.Text.Lazy (eitherResult, parse) -import qualified Data.ByteString.Char8 as B8 -import qualified Data.ByteString.Lazy as BL -import Data.List (group, sort) -import Data.Monoid ((<>)) -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.IO as T -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.IO as LT +import Data.Text (stripEnd, isInfixOf) import Network.HTTP.Simple (Request, addRequestHeader, getResponseBody, httpJSON, httpLBS, parseRequest_, setRequestBasicAuth, setRequestBodyJSON, setRequestMethod, setRequestPath) @@ -31,11 +22,13 @@ import CLI (CLI (..), getCliArgs) import LogAnalysis.Classifier (extractErrorCodes, extractIssuesFromLogs, prettyFormatAnalysis) import LogAnalysis.KnowledgeCSVParser (parseKnowLedgeBase) -import LogAnalysis.Types (ErrorCode (..), Knowledge, setupAnalysis, toComment, toTag) +import LogAnalysis.Types (ErrorCode (..), Knowledge, setupAnalysis, toComment, renderErrorCode) import Types (Attachment (..), Comment (..), Ticket (..), TicketId, TicketInfo (..), TicketList (..), TicketStatus (..), parseAgentId, parseComments, - parseTickets) -import Util (extractLogsFromZip, tshow) + parseTickets, renderTicketStatus) +import Util (extractLogsFromZip) + +-- TODO: Better exception handling data Config = Config { cfgAgentId :: !Integer @@ -79,12 +72,15 @@ 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 + putTextLn "Welcome to Zendesk classifier!" + token <- readFile tokenPath -- Zendesk token + assignFile <- readFile assignToPath -- Select assignee knowledges <- setupKnowledgebaseEnv knowledgebasePath - let cfg' = defaultConfig { cfgToken = T.stripEnd $ T.decodeUtf8 token - , cfgAssignTo = read $ T.unpack $ T.decodeUtf8 assignto + assignTo <- case readEither assignFile of + Right aid -> return aid + Left err -> error err + let cfg' = defaultConfig { cfgToken = stripEnd token + , cfgAssignTo = assignTo , cfgKnowledgebase = knowledges } agentId <- runApp getAgentId cfg' @@ -92,56 +88,56 @@ runZendeskMain = do case args of -- Process all the tikects that are requested by agent CollectEmails -> do - T.putStrLn $ "Classifier is going to extract emails requested by: " <> cfgEmail cfg + putTextLn $ "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." + putTextLn $ "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" + putTextLn "Processing single ticket" runApp (processTicketAndId ticketId) cfg - putStrLn "Process finished, please see the following url" - putStrLn $ "https://iohk.zendesk.com/agent/tickets/" <> show ticketId + putTextLn "Process finished, please see the following url" + putTextLn $ "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 + putTextLn $ "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." + putTextLn $ "There are " <> show (length filteredTicketIds) <> " unanalyzed tickets." + putTextLn "Processing tickets, this may take hours to finish." mapM_ (\tid -> runApp (processTicketAndId tid) cfg) filteredTicketIds - putStrLn "All the tickets has been processed." + putTextLn "All the tickets has been processed." -- Return raw request (RawRequest url) -> do - let req = apiRequest cfg (T.pack url) + let req = apiRequest cfg (toText url) res <- apiCall (pure . encodeToLazyText) req - LT.putStrLn res + putTextLn (toText res) -- Collect statistics ShowStatistics -> do - T.putStrLn $ "Classifier is going to gather ticket information assigned to: " <> cfgEmail cfg + putTextLn $ "Classifier is going to gather ticket information assigned to: " <> cfgEmail cfg printWarning tickets <- runApp (listTickets Assigned) cfg printTicketCountMessage tickets (cfgEmail cfg) -- | Warning printWarning :: IO () -printWarning = putStrLn "Note that this process may take a while. Please do not kill the process" +printWarning = putTextLn "Note that this process may take a while. Please do not kill the process" -- | Print how many tickets are assinged, analyzed, and unanalyzed printTicketCountMessage :: [TicketInfo] -> Text -> IO () printTicketCountMessage tickets email = do let ticketCount = length tickets - putStrLn "Done!" - T.putStrLn $ "There are currently " <> tshow ticketCount + putTextLn "Done!" + putTextLn $ "There are currently " <> show ticketCount <> " tickets in the system assigned to " <> email let filteredTicketCount = length $ filterAnalyzedTickets tickets - putStrLn $ show (ticketCount - filteredTicketCount) <> " tickets has been analyzed by the classifier." - putStrLn $ show filteredTicketCount <> " tickets are not analyzed." - putStrLn "Below are statistics:" + putTextLn $ show (ticketCount - filteredTicketCount) <> " tickets has been analyzed by the classifier." + putTextLn $ show filteredTicketCount <> " tickets are not analyzed." + putTextLn "Below are statistics:" let tagGroups = sortTickets tickets - mapM_ (\(tag, count) -> T.putStrLn $ tag <> ": " <> tshow count) tagGroups + mapM_ (\(tag, count) -> putTextLn $ tag <> ": " <> show count) tagGroups -- | Sort the ticket so we can see the statistics sortTickets :: [TicketInfo] -> [(Text, Int)] @@ -156,21 +152,21 @@ sortTickets tickets = -- | Read CSV file and setup knowledge base setupKnowledgebaseEnv :: FilePath -> IO [Knowledge] setupKnowledgebaseEnv path = do - kfile <- LT.readFile path + kfile <- toLText <$> readFile path let kb = parse parseKnowLedgeBase kfile case eitherResult kb of - Left e -> error e + Left e -> error $ toText e Right ks -> return ks -- | Collect email extractEmailAddress :: TicketId -> App () extractEmailAddress ticketId = do comments <- getTicketComments ticketId - let commentWithEmail = commentBody $ head comments - emailAddress = head $ T.lines commentWithEmail - liftIO $ guard ("@" `T.isInfixOf` emailAddress) - liftIO $ T.appendFile "emailAddress.txt" (emailAddress <> "\n") - liftIO $ T.putStrLn emailAddress + let commentWithEmail = commentBody $ fromMaybe (error "No comment") (safeHead comments) + emailAddress = fromMaybe (error "No email") (safeHead $ lines commentWithEmail) + liftIO $ guard ("@" `isInfixOf` emailAddress) + 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 processTicketAndId :: TicketId -> App () @@ -191,7 +187,7 @@ processTicketAndId ticketId = do -- | Inspect attachment then post comment to the ticket inspectAttachmentAndPostComment :: TicketId -> Attachment -> App () inspectAttachmentAndPostComment ticketId attachment = do - liftIO $ putStrLn $ "Analyzing ticket id: " <> show ticketId + liftIO $ putTextLn $ "Analyzing ticket id: " <> show ticketId (comment, tags, isPublicComment) <- inspectAttachment attachment postTicketComment ticketId comment tags isPublicComment @@ -208,8 +204,8 @@ inspectAttachment att = do let results = extractLogsFromZip cfgNumOfLogsToAnalyze rawlog case results of Left err -> do - liftIO $ putStrLn $ "Error parsing zip:" <> err - return (toComment SentLogCorrupted , [toTag SentLogCorrupted], False) + liftIO $ putTextLn $ "Error parsing zip:" <> err + return (toComment SentLogCorrupted , [renderErrorCode SentLogCorrupted], False) Right result -> do let analysisEnv = setupAnalysis cfgKnowledgebase eitherAnalysisResult = extractIssuesFromLogs result analysisEnv @@ -217,11 +213,11 @@ inspectAttachment att = do Right analysisResult -> do -- do something! let errorCodes = extractErrorCodes analysisResult let commentRes = prettyFormatAnalysis analysisResult - liftIO $ mapM_ T.putStrLn errorCodes - return (LT.toStrict commentRes, errorCodes, False) + liftIO $ mapM_ putTextLn errorCodes + return (toText commentRes, errorCodes, False) Left noResult -> do - liftIO $ putStrLn noResult - return (LT.toStrict (LT.pack noResult), [tshow NoKnownIssue], False) + liftIO $ putTextLn noResult + return (noResult, [renderTicketStatus NoKnownIssue], False) -- | Filter analyzed tickets filterAnalyzedTickets :: [TicketInfo] -> [TicketId] @@ -231,7 +227,7 @@ filterAnalyzedTickets = foldr (\TicketInfo{..} acc -> else ticketId : acc ) [] where analyzedIndicatorTag :: Text - analyzedIndicatorTag = tshow AnalyzedByScript + analyzedIndicatorTag = renderTicketStatus AnalyzedByScript -- | Return list of ticketIds that has been requested by config user (not used) listTickets :: RequestType -> App [TicketInfo] @@ -239,16 +235,16 @@ listTickets request = do cfg <- ask let agentId = cfgAgentId cfg url = case request of - Requested -> "/users/" <> tshow agentId <> "/tickets/requested.json" - Assigned -> "/users/" <> tshow agentId <> "/tickets/assigned.json" + Requested -> "/users/" <> show agentId <> "/tickets/requested.json" + Assigned -> "/users/" <> show agentId <> "/tickets/assigned.json" req = apiRequest cfg url go :: [TicketInfo] -> Text -> IO [TicketInfo] - go list nextPage' = do + go tlist nextPage' = 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 (tlist <> pagen) nextUrl + Nothing -> pure (tlist <> pagen) (TicketList page0 nextPage) <- liftIO $ apiCall parseTickets req case nextPage of @@ -259,12 +255,12 @@ listTickets request = do postTicketComment :: TicketId -> Text -> [Text] -> Bool -> App () postTicketComment tid body tags public = do cfg <- ask - let req1 = apiRequest cfg ("tickets/" <> tshow tid <> ".json") + let req1 = apiRequest cfg ("tickets/" <> show tid <> ".json") req2 = addJsonBody (Ticket (Comment ("**Log classifier**\n\n" <> body) [] public (cfgAgentId cfg)) (cfgAssignTo cfg) - (tshow AnalyzedByScript:tags) + (renderTicketStatus AnalyzedByScript:tags) ) req1 void $ liftIO $ apiCall (pure . encodeToLazyText) req2 @@ -278,15 +274,15 @@ getAgentId = do liftIO $ apiCall parseAgentId req -- | Given attachmentUrl, return attachment in bytestring -getAttachment :: Attachment -> IO BL.ByteString +getAttachment :: Attachment -> IO LByteString getAttachment Attachment{..} = getResponseBody <$> httpLBS req - where req = parseRequest_ (T.unpack attachmentURL) + where req = parseRequest_ (toString attachmentURL) -- | Get ticket's comments getTicketComments :: TicketId -> App [Comment] getTicketComments tid = do cfg <- ask - let req = apiRequest cfg ("tickets/" <> tshow tid <> "/comments.json") + let req = apiRequest cfg ("tickets/" <> show tid <> "/comments.json") liftIO $ apiCall parseComments req -- | Request PUT @@ -300,23 +296,23 @@ apiCall parser req = do 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) + <> toText e <> "\n" <> decodeUtf8 (encode v) -- | General api request function apiRequest :: Config -> Text -> Request -apiRequest Config{..} u = setRequestPath (T.encodeUtf8 path) $ +apiRequest Config{..} u = setRequestPath (encodeUtf8 path) $ addRequestHeader "Content-Type" "application/json" $ setRequestBasicAuth - (T.encodeUtf8 cfgEmail <> "/token") - (T.encodeUtf8 cfgToken) $ - parseRequest_ (T.unpack (cfgZendesk <> path)) - where - path ="/api/v2/" <> u + (encodeUtf8 cfgEmail <> "/token") + (encodeUtf8 cfgToken) $ + parseRequest_ (toString (cfgZendesk <> path)) + where + path ="/api/v2/" <> u -- | Api request but use absolute path apiRequestAbsolute :: Config -> Text -> Request apiRequestAbsolute Config{..} u = addRequestHeader "Content-Type" "application/json" $ setRequestBasicAuth - (T.encodeUtf8 cfgEmail <> "/token") - (T.encodeUtf8 cfgToken) $ - parseRequest_ (T.unpack u) + (encodeUtf8 cfgEmail <> "/token") + (encodeUtf8 cfgToken) $ + parseRequest_ (toString u) From 723f99b55a4f2b730dfbdbda26184bbc626e366b Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 10 May 2018 13:50:17 +0900 Subject: [PATCH 05/13] Refactoring --- src/CLI.hs | 1 - src/Classify.hs | 93 ++++++++++++--------------- src/LogAnalysis/Classifier.hs | 27 ++++---- src/LogAnalysis/KnowledgeCSVParser.hs | 4 +- src/LogAnalysis/Types.hs | 10 ++- src/Regex.hs | 31 ++++----- src/Types.hs | 2 - src/Util.hs | 15 ++--- 8 files changed, 75 insertions(+), 108 deletions(-) diff --git a/src/CLI.hs b/src/CLI.hs index 0c82d65..1db88af 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -5,7 +5,6 @@ module CLI import Universum -import Data.Semigroup ((<>)) import Options.Applicative (Parser, argument, auto, command, execParser, fullDesc, header, help, helper, hsubparser, info, infoOption, long, metavar, progDesc, strOption, (<**>)) diff --git a/src/Classify.hs b/src/Classify.hs index 6cf2235..a37808c 100644 --- a/src/Classify.hs +++ b/src/Classify.hs @@ -6,26 +6,17 @@ -- Currenty not used.. module Classify (classifyZip, ErrorCode(..), ErrorName, postProcessError, ConfirmedError(..)) where -import qualified Codec.Archive.Zip as Zip - -import Control.Monad (forM) +import Universum - -import qualified Data.ByteString.Lazy as LBS +import qualified Codec.Archive.Zip as Zip import qualified Data.ByteString.Lazy.Char8 as LBSC - -import Regex (MatchWithCaptures, Regex, RegexCompileError, RegexString, compileRegex, - matchAll, matchTest) - -import Data.Text (Text) -import qualified Data.Text as Text - -import Data.List (foldl') +import qualified Data.List.NonEmpty as N import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Encoding as LT import GHC.Stack (HasCallStack) +import Regex (MatchWithCaptures, Regex, RegexCompileError, RegexString, compileRegex, + matchAll, matchTest) + type ErrorName = Text @@ -33,23 +24,23 @@ data ErrorHandler = ErrorHandler { errorHandlerFileRegex :: !Regex , errorHandlerRegex :: !Regex - , errorHandlerMessage :: LBS.ByteString -> [MatchWithCaptures] -> (Maybe ErrorCode) + , errorHandlerMessage :: LByteString -> [MatchWithCaptures] -> Maybe ErrorCode } data ErrorCode = ConnectionRefused Int - | StateLockFile LT.Text - | FileNotFound [ LBS.ByteString ] - | NetworkError [ LBS.ByteString ] + | StateLockFile LText + | FileNotFound [ LByteString ] + | NetworkError [ LByteString ] deriving Show -data ConfirmedError = - ConfirmedStaleLockFile LT.Text +newtype ConfirmedError = + ConfirmedStaleLockFile LText newtype Behavior = Behavior (Map ErrorName ErrorHandler) -compileBehavior :: [(ErrorName, (RegexString, RegexString, LBS.ByteString -> [MatchWithCaptures] -> (Maybe ErrorCode)))] +compileBehavior :: [(ErrorName, (RegexString, RegexString, LByteString -> [MatchWithCaptures] -> Maybe ErrorCode))] -> Either RegexCompileError Behavior compileBehavior input = do pairs <- forM input $ \(errName, (frx, rx, toErrorCode)) -> do @@ -64,23 +55,23 @@ compileBehavior input = do pure (Behavior (Map.fromList pairs)) runBehavior :: HasCallStack => Behavior - -> Map FilePath LBS.ByteString + -> Map FilePath LByteString -> IO (Map FilePath [(ErrorName, ErrorCode)]) runBehavior (Behavior behavior) files = do let - checkFile :: FilePath -> LBS.ByteString -> IO (Maybe [(ErrorName, ErrorCode)]) + checkFile :: FilePath -> LByteString -> IO (Maybe [(ErrorName, ErrorCode)]) checkFile fp contents = do hits <- Map.traverseMaybeWithKey (checkBehaviorOnFile fp contents) behavior if length hits > 0 then pure $ Just $ Map.toList hits else pure Nothing - checkBehaviorOnFile :: FilePath - -> LBS.ByteString + checkBehaviorOnFile :: FilePath + -> LByteString -> ErrorName -> ErrorHandler -> IO (Maybe ErrorCode) - checkBehaviorOnFile fp contents _ errhandler = do + checkBehaviorOnFile fp contents _ errhandler = if matchTest (errorHandlerFileRegex errhandler) (LBSC.pack fp) then do let matches = matchAll (errorHandlerRegex errhandler) contents @@ -88,45 +79,43 @@ runBehavior (Behavior behavior) files = do pure Nothing else pure $ errorHandlerMessage errhandler contents matches - else do - pure Nothing + else pure Nothing Map.traverseMaybeWithKey checkFile files -readZip :: HasCallStack => LBS.ByteString -> Either String (Map FilePath LBS.ByteString) +readZip :: HasCallStack => LByteString -> Either String (Map FilePath LByteString) readZip rawzip = case Zip.toArchiveOrFail rawzip of Left err -> Left err Right archive -> Right $ finishProcessing archive where - finishProcessing :: Zip.Archive -> Map FilePath LBS.ByteString + finishProcessing :: Zip.Archive -> Map FilePath LByteString finishProcessing = Map.fromList . map handleEntry . Zip.zEntries - handleEntry :: Zip.Entry -> (FilePath, LBS.ByteString) + handleEntry :: Zip.Entry -> (FilePath, LByteString) handleEntry entry = (Zip.eRelativePath entry, Zip.fromEntry entry) -classifyLogs :: HasCallStack +classifyLogs :: HasCallStack => Behavior - -> Map FilePath LBS.ByteString + -> Map FilePath LByteString -> IO (Map FilePath [(ErrorName, ErrorCode)]) -classifyLogs behavior zipmap = do - runBehavior behavior zipmap +classifyLogs = runBehavior -countRefused :: LBS.ByteString -> [ MatchWithCaptures ] -> Maybe ErrorCode +countRefused :: LByteString -> [ MatchWithCaptures ] -> Maybe ErrorCode countRefused _ matches = Just $ ConnectionRefused $ length matches -getMatches :: LBS.ByteString -> [MatchWithCaptures] -> [LBS.ByteString] -getMatches fullBS matches = map (getOneMatch fullBS) matches +getMatches :: LByteString -> [MatchWithCaptures] -> [LByteString] +getMatches fullBS = map (getOneMatch fullBS) -getOneMatch :: LBS.ByteString -> MatchWithCaptures -> LBS.ByteString -getOneMatch bs ((start, len), _) = LBS.take (fromIntegral len) $ LBS.drop (fromIntegral start) bs +getOneMatch :: LByteString -> MatchWithCaptures -> LByteString +getOneMatch bs ((start, len), _) = LBSC.take (fromIntegral len) $ LBSC.drop (fromIntegral start) bs -classifyZip :: HasCallStack - => LBS.ByteString +classifyZip :: HasCallStack + => LByteString -> IO (Either String (Map FilePath [(ErrorName, ErrorCode)])) classifyZip rawzip = do - --zip <- readZip <$> LBS.readFile "logs.zip" + --zip <- readZip <$> LreadFile "logs.zip" let zipmap' = readZip rawzip let - behaviorList :: [ (ErrorName, (RegexString, RegexString, LBS.ByteString -> [MatchWithCaptures] -> Maybe ErrorCode) ) ] + behaviorList :: [ (ErrorName, (RegexString, RegexString, LByteString -> [MatchWithCaptures] -> Maybe ErrorCode) ) ] behaviorList = [ ( "conn-refused" , ( "Daedalus.log" @@ -135,29 +124,29 @@ classifyZip rawzip = do , ( "stale-lock-file" , ( "node.pub$" , "[^\n]*Wallet[^\n]*/open.lock: Locked by [0-9]+: resource busy" - , (\contents matches -> Just $ StateLockFile $ LT.decodeUtf8 $ last $ getMatches contents matches) ) ) + , \contents matches -> Just $ StateLockFile $ decodeUtf8 $ last $ N.fromList $ getMatches contents matches ) ) , ( "file-not-found" , ( "node.pub$" , ": [^ ]*: openBinaryFile: does not exist \\(No such file or directory\\)" - , (\contents matches -> Just $ FileNotFound $ getMatches contents matches) ) ) + , \contents matches -> Just $ FileNotFound $ getMatches contents matches ) ) , ( "TransportError" , ( "node" , "TransportError[^\n]*" - , (\contents matches -> Just $ NetworkError $ getMatches contents matches) ) ) + , \contents matches -> Just $ NetworkError $ getMatches contents matches ) ) ] - behavior <- either (fail . Text.unpack) pure + behavior <- either (fail . toString) pure $ compileBehavior behaviorList case zipmap' of Left err -> pure $ Left err Right zipmap -> Right <$> classifyLogs behavior zipmap -isStaleLockFile :: Map FilePath [(ErrorName, ErrorCode)] -> Maybe LT.Text +isStaleLockFile :: Map FilePath [(ErrorName, ErrorCode)] -> Maybe LText isStaleLockFile = Map.foldl' checkFile Nothing where - checkFile :: Maybe LT.Text -> [(ErrorName, ErrorCode)] -> Maybe LT.Text + checkFile :: Maybe LText -> [(ErrorName, ErrorCode)] -> Maybe LText checkFile = foldl' isStale where - isStale :: Maybe LT.Text -> (ErrorName, ErrorCode) -> Maybe LT.Text + isStale :: Maybe LText -> (ErrorName, ErrorCode) -> Maybe LText isStale (Just x) _ = Just x isStale Nothing (_, StateLockFile str) = Just str isStale x _ = x diff --git a/src/LogAnalysis/Classifier.hs b/src/LogAnalysis/Classifier.hs index eb41ae2..a277d20 100644 --- a/src/LogAnalysis/Classifier.hs +++ b/src/LogAnalysis/Classifier.hs @@ -12,11 +12,8 @@ import Universum import qualified Data.ByteString.Lazy as LBS import qualified Data.Map.Strict as Map -import Data.Semigroup ((<>)) -import Data.Text (Text) import Data.Text.Encoding.Error (ignore) -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Encoding as LT +import Data.Text.Lazy (isInfixOf) import LogAnalysis.Types (Analysis, Knowledge (..), renderErrorCode) @@ -25,23 +22,23 @@ numberOfErrorText :: Int numberOfErrorText = 3 -- | Analyze each log file based on the knowlodgebases' data. -extractIssuesFromLogs :: [LBS.ByteString] -> Analysis -> Either Text Analysis +extractIssuesFromLogs :: [LByteString] -> Analysis -> Either Text Analysis extractIssuesFromLogs files analysis = filterAnalysis $ foldl' runClassifiers analysis files -- | Run analysis on given file -runClassifiers :: Analysis -> LBS.ByteString -> Analysis +runClassifiers :: Analysis -> LByteString -> Analysis runClassifiers analysis logfile = - let logLines = LT.lines $ LT.decodeUtf8With ignore logfile - in foldl' analyzeLine analysis logLines + let logLines = lines $ decodeUtf8With ignore (LBS.toStrict logfile) + in foldl' analyzeLine analysis (toLText <$> logLines) -- | Analyze each line -analyzeLine :: Analysis -> LT.Text -> Analysis +analyzeLine :: Analysis -> LText -> Analysis analyzeLine analysis str = Map.mapWithKey (compareWithKnowledge str) analysis -- | Compare the line with knowledge lists -compareWithKnowledge :: LT.Text -> Knowledge -> [ LT.Text ] -> [ LT.Text ] +compareWithKnowledge :: LText -> Knowledge -> [ LText ] -> [ LText ] compareWithKnowledge str Knowledge{..} xs = - if kErrorText `LT.isInfixOf` str + if kErrorText `isInfixOf` str then str : xs else xs @@ -57,15 +54,15 @@ extractErrorCodes :: Analysis -> [ Text ] extractErrorCodes as = map (\(Knowledge{..}, _) -> renderErrorCode kErrorCode) $ Map.toList as -- | TODO: Format the text in better way -prettyFormatAnalysis :: Analysis -> LT.Text +prettyFormatAnalysis :: Analysis -> LText prettyFormatAnalysis as = let aList = Map.toList as in foldr (\(Knowledge{..}, txts) acc -> - "\n" <> LT.pack (show kErrorCode) + "\n" <> show kErrorCode <> "\n" <> kProblem <> "\n **" <> kSolution <> "** \n" - <> foldr (\txt ts -> "\n" <> txt <> "\n" <> ts) LT.empty txts -- List errors + <> foldr1 (\txt ts -> "\n" <> txt <> "\n" <> ts) txts -- List errors <> "\n" <> acc <> "\n\n" - ) LT.empty aList + ) "" aList diff --git a/src/LogAnalysis/KnowledgeCSVParser.hs b/src/LogAnalysis/KnowledgeCSVParser.hs index 5c7470d..0bdf4e7 100644 --- a/src/LogAnalysis/KnowledgeCSVParser.hs +++ b/src/LogAnalysis/KnowledgeCSVParser.hs @@ -12,7 +12,7 @@ import qualified Data.Text.Lazy as LT import LogAnalysis.Types (ErrorCode (..), Knowledge (..)) -- |Take any string that is inside quotes -insideQuotes :: Parser LT.Text +insideQuotes :: Parser LText insideQuotes = LT.append <$> (LT.fromStrict <$> ALT.takeWhile (/= '"')) <*> (LT.concat <$> many (LT.cons <$> dquotes <*> insideQuotes)) @@ -23,7 +23,7 @@ insideQuotes = "paired double quotes" -- | Parse quoted field -quotedField :: Parser LT.Text +quotedField :: Parser LText quotedField = char '"' *> insideQuotes <* char '"' "quoted field" diff --git a/src/LogAnalysis/Types.hs b/src/LogAnalysis/Types.hs index 13cc6fb..886968c 100644 --- a/src/LogAnalysis/Types.hs +++ b/src/LogAnalysis/Types.hs @@ -13,8 +13,6 @@ import Universum import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Text (Text) -import qualified Data.Text.Lazy as LT -- | Identifier for each error data ErrorCode @@ -37,10 +35,10 @@ data ErrorCode -- | Record identifying the issue data Knowledge = Knowledge - { kErrorText :: !LT.Text -- ^ Text used for matching error lines + { kErrorText :: !LText -- ^ Text used for matching error lines , kErrorCode :: !ErrorCode -- ^ Identity for error code - , kProblem :: !LT.Text -- ^ Text describing what is the problem - , kSolution :: !LT.Text -- ^ Text describing how to solve the issue + , kProblem :: !LText -- ^ Text describing what is the problem + , kSolution :: !LText -- ^ Text describing how to solve the issue } deriving (Show) renderErrorCode :: ErrorCode -> Text @@ -65,7 +63,7 @@ toComment SentLogCorrupted = "Log file is corrupted" toComment _ = "Error" -- | Map used to collect error lines -type Analysis = Map Knowledge [LT.Text] +type Analysis = Map Knowledge [LText] -- | Create initial analysis environment setupAnalysis :: [Knowledge] -> Analysis diff --git a/src/Regex.hs b/src/Regex.hs index fef7bd5..f55cfe8 100644 --- a/src/Regex.hs +++ b/src/Regex.hs @@ -15,29 +15,22 @@ module Regex import Universum import qualified Data.Array as Array - -import qualified Data.ByteString.Lazy as LBS - +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import qualified Text.Regex.TDFA as TDFA import Text.Regex.TDFA.ByteString.Lazy (Regex) import qualified Text.Regex.TDFA.ByteString.Lazy as TDFA -import Data.Text (Text) -import qualified Data.Text as Text - -import Data.Map.Strict (Map) -import qualified Data.Map.Strict as Map - maybeToEither :: e -> Maybe a -> Either e a maybeToEither e Nothing = Left e maybeToEither _ (Just x) = Right x -type RegexString = LBS.ByteString +type RegexString = LByteString type RegexCompileError = Text compileRegex :: RegexString -> Either RegexCompileError Regex -compileRegex = either (Left . Text.pack) Right +compileRegex = either (Left . toText) Right . TDFA.compile TDFA.blankCompOpt TDFA.blankExecOpt type CaptureIndex = Int @@ -48,20 +41,20 @@ type MatchWithCaptures = (Match, Map CaptureIndex Match) fromMatchArray :: TDFA.MatchArray -> MatchWithCaptures fromMatchArray ma = either error id $ do - let m = Map.fromList (Array.assocs ma) - fullMatch <- maybeToEither "this shouldn't happen" (Map.lookup 0 m) - captures <- pure (Map.delete 0 m) - pure (fullMatch, captures) + let m = Map.fromList (Array.assocs ma) + fullMatch <- maybeToEither "this shouldn't happen" (Map.lookup 0 m) + let captures = Map.delete 0 m + pure (fullMatch, captures) -matchOnce :: Regex -> LBS.ByteString -> Maybe MatchWithCaptures +matchOnce :: Regex -> LByteString -> Maybe MatchWithCaptures matchOnce regex string = fromMatchArray <$> TDFA.matchOnce regex string -matchCount :: Regex -> LBS.ByteString -> Int +matchCount :: Regex -> LByteString -> Int matchCount = TDFA.matchCount -matchTest :: Regex -> LBS.ByteString -> Bool +matchTest :: Regex -> LByteString -> Bool matchTest = TDFA.matchTest -matchAll :: Regex -> LBS.ByteString -> [MatchWithCaptures] +matchAll :: Regex -> LByteString -> [MatchWithCaptures] matchAll regex string = map fromMatchArray (TDFA.matchAll regex string) diff --git a/src/Types.hs b/src/Types.hs index c430e43..ce71d8c 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -19,7 +19,6 @@ import Universum import Data.Aeson import Data.Aeson.Types (Parser) -import Data.Text (Text) -- | Comments data Comment = Comment @@ -65,7 +64,6 @@ data TicketInfo = TicketInfo data TicketStatus = AnalyzedByScript -- ^ Ticket has been analyzed | NoKnownIssue -- ^ Ticket had no known issue - deriving Show -- | Defining it's own show instance to use it as tags renderTicketStatus :: TicketStatus -> Text diff --git a/src/Util.hs b/src/Util.hs index b378ff2..05bcb88 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -1,23 +1,16 @@ module Util ( extractLogsFromZip - , tshow , readZip ) where import Universum import qualified Codec.Archive.Zip as Zip -import qualified Data.ByteString.Lazy as LBS import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Text (Text) -import qualified Data.Text as T - -tshow :: Show a => a -> Text -tshow = T.pack . show -- | Extract log file from given zip file -extractLogsFromZip :: Int -> LBS.ByteString -> Either Text [LBS.ByteString] +extractLogsFromZip :: Int -> LByteString -> Either Text [LByteString] extractLogsFromZip numberOfFiles file = do zipMap <- readZip file -- Read File let extractedLogs = Map.elems $ mTake numberOfFiles zipMap -- Extract selected logs @@ -25,12 +18,12 @@ extractLogsFromZip numberOfFiles file = do where mTake n = Map.fromDistinctAscList . take n . Map.toAscList -readZip :: LBS.ByteString -> Either Text (Map FilePath LBS.ByteString) +readZip :: LByteString -> Either Text (Map FilePath LByteString) readZip rawzip = case Zip.toArchiveOrFail rawzip of Left err -> Left (toText err) Right archive -> Right $ finishProcessing archive where - finishProcessing :: Zip.Archive -> Map FilePath LBS.ByteString + finishProcessing :: Zip.Archive -> Map FilePath LByteString finishProcessing = Map.fromList . map handleEntry . Zip.zEntries - handleEntry :: Zip.Entry -> (FilePath, LBS.ByteString) + handleEntry :: Zip.Entry -> (FilePath, LByteString) handleEntry entry = (Zip.eRelativePath entry, Zip.fromEntry entry) From 4cc3df9e71c1c68dc9e1a4ee33f173a7726348ad Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Mon, 14 May 2018 08:53:03 +0900 Subject: [PATCH 06/13] 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 1db88af..769ab01 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -34,15 +34,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")) ] From 7df57af313e3393906ac07a9531d57d3beea33d4 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Fri, 11 May 2018 09:39:17 +0900 Subject: [PATCH 07/13] Add comments, remove unnecessary imports --- src/Classify.hs | 1 - src/LogAnalysis/Classifier.hs | 2 +- src/LogAnalysis/KnowledgeCSVParser.hs | 6 +++--- src/LogAnalysis/Types.hs | 7 +++---- src/Regex.hs | 1 - src/Util.hs | 1 - src/Zendesk.hs | 2 ++ 7 files changed, 9 insertions(+), 11 deletions(-) diff --git a/src/Classify.hs b/src/Classify.hs index a37808c..f2c6dba 100644 --- a/src/Classify.hs +++ b/src/Classify.hs @@ -11,7 +11,6 @@ import Universum import qualified Codec.Archive.Zip as Zip import qualified Data.ByteString.Lazy.Char8 as LBSC import qualified Data.List.NonEmpty as N -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import GHC.Stack (HasCallStack) import Regex (MatchWithCaptures, Regex, RegexCompileError, RegexString, compileRegex, diff --git a/src/LogAnalysis/Classifier.hs b/src/LogAnalysis/Classifier.hs index a277d20..f6ef736 100644 --- a/src/LogAnalysis/Classifier.hs +++ b/src/LogAnalysis/Classifier.hs @@ -53,7 +53,7 @@ filterAnalysis as = do extractErrorCodes :: Analysis -> [ Text ] extractErrorCodes as = map (\(Knowledge{..}, _) -> renderErrorCode kErrorCode) $ Map.toList as --- | TODO: Format the text in better way +-- | TODO (Hiroto): Format the text in better way prettyFormatAnalysis :: Analysis -> LText prettyFormatAnalysis as = let aList = Map.toList as diff --git a/src/LogAnalysis/KnowledgeCSVParser.hs b/src/LogAnalysis/KnowledgeCSVParser.hs index 0bdf4e7..5fb41b2 100644 --- a/src/LogAnalysis/KnowledgeCSVParser.hs +++ b/src/LogAnalysis/KnowledgeCSVParser.hs @@ -11,7 +11,7 @@ import qualified Data.Text.Lazy as LT import LogAnalysis.Types (ErrorCode (..), Knowledge (..)) --- |Take any string that is inside quotes +-- | Take any string that is inside quotes insideQuotes :: Parser LText insideQuotes = LT.append <$> (LT.fromStrict <$> ALT.takeWhile (/= '"')) @@ -46,7 +46,7 @@ parseErrorCode = <|> (string "Unknown" >> return Unknown) <|> (string "Error" >> return Error) --- |Parse each csv records +-- | Parse each csv records parseKnowledge :: Parser Knowledge -- not really clean code.. parseKnowledge = do e <- quotedField @@ -60,6 +60,6 @@ parseKnowledge = do s <- quotedField return $ Knowledge e c p s --- |Parse CSV file and create knowledgebase +-- | Parse CSV file and create knowledgebase parseKnowLedgeBase :: Parser [ Knowledge ] parseKnowLedgeBase = many $ parseKnowledge <* endOfLine diff --git a/src/LogAnalysis/Types.hs b/src/LogAnalysis/Types.hs index 886968c..36a8a4f 100644 --- a/src/LogAnalysis/Types.hs +++ b/src/LogAnalysis/Types.hs @@ -11,7 +11,6 @@ module LogAnalysis.Types import Universum -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -- | Identifier for each error @@ -35,10 +34,10 @@ data ErrorCode -- | Record identifying the issue data Knowledge = Knowledge - { kErrorText :: !LText -- ^ Text used for matching error lines + { kErrorText :: !LText 　-- ^ Text used for matching error lines , kErrorCode :: !ErrorCode -- ^ Identity for error code - , kProblem :: !LText -- ^ Text describing what is the problem - , kSolution :: !LText -- ^ Text describing how to solve the issue + , kProblem :: !LText 　-- ^ Text describing what is the problem + , kSolution :: !LText 　-- ^ Text describing how to solve the issue } deriving (Show) renderErrorCode :: ErrorCode -> Text diff --git a/src/Regex.hs b/src/Regex.hs index f55cfe8..432f6df 100644 --- a/src/Regex.hs +++ b/src/Regex.hs @@ -15,7 +15,6 @@ module Regex import Universum import qualified Data.Array as Array -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import qualified Text.Regex.TDFA as TDFA import Text.Regex.TDFA.ByteString.Lazy (Regex) diff --git a/src/Util.hs b/src/Util.hs index 05bcb88..b15dbe4 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -6,7 +6,6 @@ module Util import Universum import qualified Codec.Archive.Zip as Zip -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -- | Extract log file from given zip file diff --git a/src/Zendesk.hs b/src/Zendesk.hs index 346c255..bc91d3b 100644 --- a/src/Zendesk.hs +++ b/src/Zendesk.hs @@ -63,9 +63,11 @@ defaultConfig = Config 0 "https://iohk.zendesk.com" "" "daedalus-bug-reports@ioh knowledgebasePath :: FilePath knowledgebasePath = "./knowledgebase/knowledge.csv" +-- | Filepath to token file tokenPath :: FilePath tokenPath = "./tmp-secrets/token" +-- | Filepath to assign_to file assignToPath :: FilePath assignToPath = "./tmp-secrets/assign_to" From 5c85880fa5384f753e838e1042f521576fc03757 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Tue, 15 May 2018 13:35:59 +0900 Subject: [PATCH 08/13] Fix styling --- src/CLI.hs | 47 +++++---- src/Classify.hs | 131 +++++++++++++------------- src/Lib.hs | 4 +- src/LogAnalysis/Classifier.hs | 24 ++--- src/LogAnalysis/KnowledgeCSVParser.hs | 7 +- src/LogAnalysis/Types.hs | 60 ++++++------ src/Regex.hs | 22 ++--- src/Types.hs | 121 ++++++++++++++---------- src/Util.hs | 11 ++- src/Zendesk.hs | 114 ++++++++++++---------- 10 files changed, 287 insertions(+), 254 deletions(-) diff --git a/src/CLI.hs b/src/CLI.hs index 769ab01..84d43ec 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -10,47 +10,46 @@ import Options.Applicative (Parser, argument, auto, command, execParse progDesc, strOption, (<**>)) import Paths_log_classifier (version) -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 request to the given url - | ShowStatistics -- ^ Show statistics - deriving (Show) +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 request to the given url + | ShowStatistics -- ^ Show statistics + deriving Show -- | Parser for ProcessTicket cmdProcessTicket :: Parser CLI cmdProcessTicket = ProcessTicket <$> argument auto - ( metavar "TICKET_ID" - <> help "Ticket id to analyze") + (metavar "TICKET_ID" + <> help "Ticket id to analyze") -- | Parser for RawRequest cmdRawRequest :: Parser CLI cmdRawRequest = RawRequest <$> strOption - ( metavar "URL" - <> help "Url to request") + (metavar "URL" + <> help "Url to request") -- | Parser for CLI commands cli :: Parser CLI cli = hsubparser $ mconcat - [ - command "collect-emails" (info (pure CollectEmails) - (progDesc "Collect emails requested by single user")) - , command "process-tickets" (info (pure ProcessTickets) - (progDesc "Process all the tickets i.e add comments, tags.")) - , command "process-ticket" (info cmdProcessTicket - (progDesc "Process Zendesk ticket of an given ticket id")) - , command "raw-request" (info cmdRawRequest - (progDesc "Raw request to the given url")) - , command "show-stats" (info (pure ShowStatistics) - (progDesc "Print list of ticket Ids that agent has been assigned")) - ] + [ + command "collect-emails" (info (pure CollectEmails) + (progDesc "Collect emails requested by single user")) + , command "process-tickets" (info (pure ProcessTickets) + (progDesc "Process all the tickets i.e add comments, tags.")) + , command "process-ticket" (info cmdProcessTicket + (progDesc "Process Zendesk ticket of an given ticket id")) + , command "raw-request" (info cmdRawRequest + (progDesc "Raw request to the given url")) + , command "show-stats" (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 + (fullDesc <> header "Log classifier" <> progDesc "Client for peforming analysis on Zendesk" ) diff --git a/src/Classify.hs b/src/Classify.hs index f2c6dba..0bc8f5b 100644 --- a/src/Classify.hs +++ b/src/Classify.hs @@ -4,7 +4,13 @@ {-# LANGUAGE RankNTypes #-} -- Currenty not used.. -module Classify (classifyZip, ErrorCode(..), ErrorName, postProcessError, ConfirmedError(..)) where +module Classify + ( ConfirmedError(..) + , ErrorCode(..) + , ErrorName + , classifyZip + , postProcessError + ) where import Universum @@ -19,8 +25,7 @@ import Regex (MatchWithCaptures, Regex, RegexCompileError, RegexString type ErrorName = Text -data ErrorHandler - = ErrorHandler +data ErrorHandler = ErrorHandler { errorHandlerFileRegex :: !Regex , errorHandlerRegex :: !Regex , errorHandlerMessage :: LByteString -> [MatchWithCaptures] -> Maybe ErrorCode @@ -33,53 +38,50 @@ data ErrorCode = | NetworkError [ LByteString ] deriving Show -newtype ConfirmedError = - ConfirmedStaleLockFile LText +newtype ConfirmedError = ConfirmedStaleLockFile LText -newtype Behavior - = Behavior (Map ErrorName ErrorHandler) +newtype Behavior = Behavior (Map ErrorName ErrorHandler) -compileBehavior :: [(ErrorName, (RegexString, RegexString, LByteString -> [MatchWithCaptures] -> Maybe ErrorCode))] +compileBehavior :: [(ErrorName, (RegexString, RegexString, + LByteString -> [MatchWithCaptures] -> Maybe ErrorCode))] -> Either RegexCompileError Behavior compileBehavior input = do - pairs <- forM input $ \(errName, (frx, rx, toErrorCode)) -> do - frxCompiled <- compileRegex frx - rxCompiled <- compileRegex rx - let errHandler = ErrorHandler + pairs <- forM input $ \(errName, (frx, rx, toErrorCode)) -> do + frxCompiled <- compileRegex frx + rxCompiled <- compileRegex rx + let errHandler = ErrorHandler { errorHandlerFileRegex = frxCompiled , errorHandlerRegex = rxCompiled , errorHandlerMessage = toErrorCode } - pure (errName, errHandler) - pure (Behavior (Map.fromList pairs)) + pure (errName, errHandler) + pure (Behavior (Map.fromList pairs)) runBehavior :: HasCallStack => Behavior -> Map FilePath LByteString -> IO (Map FilePath [(ErrorName, ErrorCode)]) runBehavior (Behavior behavior) files = do - let - checkFile :: FilePath -> LByteString -> IO (Maybe [(ErrorName, ErrorCode)]) - checkFile fp contents = do - hits <- Map.traverseMaybeWithKey (checkBehaviorOnFile fp contents) behavior - if length hits > 0 then - pure $ Just $ Map.toList hits - else - pure Nothing - checkBehaviorOnFile :: FilePath - -> LByteString - -> ErrorName - -> ErrorHandler - -> IO (Maybe ErrorCode) - checkBehaviorOnFile fp contents _ errhandler = - if matchTest (errorHandlerFileRegex errhandler) (LBSC.pack fp) then do - let - matches = matchAll (errorHandlerRegex errhandler) contents - if (length matches) == 0 then - pure Nothing - else - pure $ errorHandlerMessage errhandler contents matches - else pure Nothing - Map.traverseMaybeWithKey checkFile files + let + checkFile :: FilePath -> LByteString -> IO (Maybe [(ErrorName, ErrorCode)]) + checkFile fp contents = do + hits <- Map.traverseMaybeWithKey (checkBehaviorOnFile fp contents) behavior + if length hits > 0 + then pure $ Just $ Map.toList hits + else pure Nothing + checkBehaviorOnFile :: FilePath + -> LByteString + -> ErrorName + -> ErrorHandler + -> IO (Maybe ErrorCode) + checkBehaviorOnFile fp contents _ errhandler = + if matchTest (errorHandlerFileRegex errhandler) (LBSC.pack fp) then do + let matches = matchAll (errorHandlerRegex errhandler) contents + if (length matches) == 0 then + pure Nothing + else + pure $ errorHandlerMessage errhandler contents matches + else pure Nothing + Map.traverseMaybeWithKey checkFile files readZip :: HasCallStack => LByteString -> Either String (Map FilePath LByteString) readZip rawzip = case Zip.toArchiveOrFail rawzip of @@ -104,40 +106,41 @@ getMatches :: LByteString -> [MatchWithCaptures] -> [LByteString] getMatches fullBS = map (getOneMatch fullBS) getOneMatch :: LByteString -> MatchWithCaptures -> LByteString -getOneMatch bs ((start, len), _) = LBSC.take (fromIntegral len) $ LBSC.drop (fromIntegral start) bs +getOneMatch bs ((start, len), _) = + LBSC.take (fromIntegral len) $ LBSC.drop (fromIntegral start) bs classifyZip :: HasCallStack => LByteString -> IO (Either String (Map FilePath [(ErrorName, ErrorCode)])) classifyZip rawzip = do --zip <- readZip <$> LreadFile "logs.zip" - let - zipmap' = readZip rawzip - let - behaviorList :: [ (ErrorName, (RegexString, RegexString, LByteString -> [MatchWithCaptures] -> Maybe ErrorCode) ) ] - behaviorList - = [ ( "conn-refused" - , ( "Daedalus.log" - , "\"message\": \"connect ECONNREFUSED [^\"]*\"" - , countRefused ) ) - , ( "stale-lock-file" - , ( "node.pub$" - , "[^\n]*Wallet[^\n]*/open.lock: Locked by [0-9]+: resource busy" - , \contents matches -> Just $ StateLockFile $ decodeUtf8 $ last $ N.fromList $ getMatches contents matches ) ) - , ( "file-not-found" - , ( "node.pub$" - , ": [^ ]*: openBinaryFile: does not exist \\(No such file or directory\\)" - , \contents matches -> Just $ FileNotFound $ getMatches contents matches ) ) - , ( "TransportError" - , ( "node" - , "TransportError[^\n]*" - , \contents matches -> Just $ NetworkError $ getMatches contents matches ) ) - ] + let zipmap' = readZip rawzip + behaviorList :: [(ErrorName, (RegexString, RegexString, + LByteString -> [MatchWithCaptures] -> Maybe ErrorCode))] + behaviorList + = [ ( "conn-refused" + , ( "Daedalus.log" + , "\"message\": \"connect ECONNREFUSED [^\"]*\"" + , countRefused ) ) + , ( "stale-lock-file" + , ( "node.pub$" + , "[^\n]*Wallet[^\n]*/open.lock: Locked by [0-9]+: resource busy" + , \contents matches -> Just $ StateLockFile $ decodeUtf8 + $ last $ N.fromList $ getMatches contents matches ) ) + , ( "file-not-found" + , ( "node.pub$" + , ": [^ ]*: openBinaryFile: does not exist \\(No such file or directory\\)" + , \contents matches -> Just $ FileNotFound $ getMatches contents matches ) ) + , ( "TransportError" + , ( "node" + , "TransportError[^\n]*" + , \contents matches -> Just $ NetworkError $ getMatches contents matches ) ) + ] behavior <- either (fail . toString) pure $ compileBehavior behaviorList case zipmap' of - Left err -> pure $ Left err - Right zipmap -> Right <$> classifyLogs behavior zipmap + Left err -> pure $ Left err + Right zipmap -> Right <$> classifyLogs behavior zipmap isStaleLockFile :: Map FilePath [(ErrorName, ErrorCode)] -> Maybe LText isStaleLockFile = Map.foldl' checkFile Nothing @@ -155,5 +158,5 @@ postProcessError :: Map FilePath [(ErrorName, ErrorCode)] postProcessError input = finalAnswer where finalAnswer = case isStaleLockFile input of - Just msg -> Right $ ConfirmedStaleLockFile msg - Nothing -> Left input + Just msg -> Right $ ConfirmedStaleLockFile msg + Nothing -> Left input diff --git a/src/Lib.hs b/src/Lib.hs index de21fde..840ff37 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,6 +1,6 @@ module Lib - ( someFunc - ) where + ( someFunc + ) where import Universum -- TODO(ks): Here we want to import the functionality we require in cardano-report-server. diff --git a/src/LogAnalysis/Classifier.hs b/src/LogAnalysis/Classifier.hs index f6ef736..c3315e9 100644 --- a/src/LogAnalysis/Classifier.hs +++ b/src/LogAnalysis/Classifier.hs @@ -3,8 +3,8 @@ {-# LANGUAGE RecordWildCards #-} module LogAnalysis.Classifier - ( extractIssuesFromLogs - , extractErrorCodes + ( extractErrorCodes + , extractIssuesFromLogs , prettyFormatAnalysis ) where @@ -47,8 +47,8 @@ filterAnalysis :: Analysis -> Either Text Analysis filterAnalysis as = do let filteredAnalysis = Map.filter (/=[]) as if null filteredAnalysis - then Left "Cannot find any known issues" - else return $ Map.map (take numberOfErrorText) filteredAnalysis + then Left "Cannot find any known issues" + else return $ Map.map (take numberOfErrorText) filteredAnalysis extractErrorCodes :: Analysis -> [ Text ] extractErrorCodes as = map (\(Knowledge{..}, _) -> renderErrorCode kErrorCode) $ Map.toList as @@ -58,11 +58,11 @@ prettyFormatAnalysis :: Analysis -> LText prettyFormatAnalysis as = let aList = Map.toList as in foldr (\(Knowledge{..}, txts) acc -> - "\n" <> show kErrorCode - <> "\n" <> kProblem - <> "\n **" <> kSolution - <> "** \n" - <> foldr1 (\txt ts -> "\n" <> txt <> "\n" <> ts) txts -- List errors - <> "\n" <> acc - <> "\n\n" - ) "" aList + "\n" <> show kErrorCode + <> "\n" <> kProblem + <> "\n **" <> kSolution + <> "** \n" + <> foldr1 (\txt ts -> "\n" <> txt <> "\n" <> ts) txts -- List errors + <> "\n" <> acc + <> "\n\n" + ) "" aList diff --git a/src/LogAnalysis/KnowledgeCSVParser.hs b/src/LogAnalysis/KnowledgeCSVParser.hs index 5fb41b2..2588e78 100644 --- a/src/LogAnalysis/KnowledgeCSVParser.hs +++ b/src/LogAnalysis/KnowledgeCSVParser.hs @@ -17,10 +17,9 @@ insideQuotes = LT.append <$> (LT.fromStrict <$> ALT.takeWhile (/= '"')) <*> (LT.concat <$> many (LT.cons <$> dquotes <*> insideQuotes)) "inside of double quotes" - where - dquotes = - string "\"\"" >> return '"' - "paired double quotes" + where + dquotes = string "\"\"" >> return '"' + "paired double quotes" -- | Parse quoted field quotedField :: Parser LText diff --git a/src/LogAnalysis/Types.hs b/src/LogAnalysis/Types.hs index 36a8a4f..92ef428 100644 --- a/src/LogAnalysis/Types.hs +++ b/src/LogAnalysis/Types.hs @@ -1,44 +1,48 @@ {-# LANGUAGE OverloadedStrings #-} module LogAnalysis.Types - ( Analysis - , ErrorCode (..) - , Knowledge (..) - , setupAnalysis - , renderErrorCode - , toComment - ) where + ( Analysis + , ErrorCode (..) + , Knowledge (..) + , setupAnalysis + , renderErrorCode + , toComment + ) where import Universum import qualified Data.Map.Strict as Map -- | Identifier for each error -data ErrorCode - = ShortStorage -- ^ Not enough space on hard drive to store block data - | UserNameError -- ^ User is using non-latin characters for username - | TimeSync -- ^ User's PC's time is out of sync - | FileNotFound -- ^ Some of the files were not installed properly - | StaleLockFile -- ^ Open.lock file is corrupted - | SentLogCorrupted -- ^ Log file sent to the Zendesk is corrupted - | DBError -- ^ Local block data is corrupted - | DBPath -- ^ Daedalus cannot find certain files - | CannotGetDBSize -- ^ Error message of Couidn't pack log files shows up - | BalanceError -- ^ Daedalus shows wrong Ada amount - | NetworkError -- ^ Firewall is blocking the connection - | ConnectionRefused -- ^ Firewall is blocking the connection - | ResourceVanished -- ^ Network error - | Unknown -- ^ Unknown error (currently not used) - | Error -- ^ Error (currently not used) +data ErrorCode + = ShortStorage -- ^ Not enough space on hard drive to store block data + | UserNameError -- ^ User is using non-latin characters for username + | TimeSync -- ^ User's PC's time is out of sync + | FileNotFound -- ^ Some of the files were not installed properly + | StaleLockFile -- ^ Open.lock file is corrupted + | SentLogCorrupted -- ^ Log file sent to the Zendesk is corrupted + | DBError -- ^ Local block data is corrupted + | DBPath -- ^ Daedalus cannot find certain files + | CannotGetDBSize -- ^ Error message of Couidn't pack log files shows up + | BalanceError -- ^ Daedalus shows wrong Ada amount + | NetworkError -- ^ Firewall is blocking the connection + | ConnectionRefused -- ^ Firewall is blocking the connection + | ResourceVanished -- ^ Network error + | Unknown -- ^ Unknown error (currently not used) + | Error -- ^ Error (currently not used) deriving (Eq, Ord, Show) -- | Record identifying the issue data Knowledge = Knowledge - { kErrorText :: !LText 　-- ^ Text used for matching error lines - , kErrorCode :: !ErrorCode -- ^ Identity for error code - , kProblem :: !LText 　-- ^ Text describing what is the problem - , kSolution :: !LText 　-- ^ Text describing how to solve the issue - } deriving (Show) + { kErrorText :: !LText + -- ^ Text used for matching error lines + , kErrorCode :: !ErrorCode + -- ^ Identity for error code + , kProblem :: !LText + -- ^ Text describing what is the problem + , kSolution :: !LText + -- ^ Text describing how to solve the issue + } deriving (Show) renderErrorCode :: ErrorCode -> Text renderErrorCode ShortStorage = "short-storage" diff --git a/src/Regex.hs b/src/Regex.hs index 432f6df..6e1a875 100644 --- a/src/Regex.hs +++ b/src/Regex.hs @@ -1,15 +1,15 @@ module Regex - ( Regex - , RegexString - , RegexCompileError - , Match - , MatchWithCaptures - , compileRegex - , matchOnce - , matchCount - , matchTest - , matchAll - ) where + ( Match + , MatchWithCaptures + , Regex + , RegexCompileError + , RegexString + , compileRegex + , matchAll + , matchCount + , matchOnce + , matchTest + ) where -- Not used, but want to use it in the future. import Universum diff --git a/src/Types.hs b/src/Types.hs index ce71d8c..c8ddb2e 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,31 +1,47 @@ {-# LANGUAGE OverloadedStrings #-} module Types - ( Comment(..) - , CommentOuter(..) - , Attachment(..) - , Ticket(..) - , TicketList(..) - , TicketId - , TicketInfo(..) - , TicketStatus(..) - , parseAgentId - , parseComments - , parseTickets - , renderTicketStatus - ) where + ( Attachment(..) + , Comment(..) + , CommentOuter(..) + , Ticket(..) + , TicketInfo(..) + , TicketId + , TicketList(..) + , TicketStatus(..) + , parseAgentId + , parseComments + , parseTickets + , renderTicketStatus + ) where import Universum -import Data.Aeson +import Data.Aeson (FromJSON, ToJSON, Value, object, parseJSON, toJSON, withObject, (.:), + (.=)) import Data.Aeson.Types (Parser) + +-- | Attachment of the ticket +data Attachment = Attachment + { attachmentURL :: !Text + -- ^ URL of the attachment + , attachmentContentType :: !Text + -- ^ ContentType of the attachment + , attachmentSize :: !Int + -- ^ Attachment size + } + -- | Comments data Comment = Comment - { commentBody :: !Text -- ^ Body of comment - , commentAttachments :: ![Attachment] -- ^ Attachment - , commentPublic :: !Bool -- ^ Flag of whether comment should be public - , commentAuthor :: !Integer -- ^ Auther of comment + { commentBody :: !Text + -- ^ Body of comment + , commentAttachments :: ![Attachment] + -- ^ Attachment + , commentPublic :: !Bool + -- ^ Flag of whether comment should be public + , commentAuthor :: !Integer + -- ^ Auther of comment } -- | Outer comment ?? @@ -33,37 +49,38 @@ newtype CommentOuter = CommentOuter { coComment :: Comment } --- | Attachment of the ticket -data Attachment = Attachment - { attachmentURL :: !Text -- ^ URL of the attachment - , attachmentContentType :: !Text -- ^ ContentType of the attachment - , attachmentSize :: !Int -- ^ Attachment size - } - -- | Zendexk ticket data Ticket = Ticket - { ticketComment :: !Comment -- ^ Ticket comment - , ticketAssignee :: !Integer -- ^ Assignee of the ticket - , ticketTag :: ![Text] -- ^ Tags attached to ticket + { ticketComment :: !Comment + -- ^ Ticket comment + , ticketAssignee :: !Integer + -- ^ Assignee of the ticket + , ticketTag :: ![Text] + -- ^ Tags attached to ticket } -- | List of zendesk ticket data TicketList = TicketList - { ticketListTickets :: ![TicketInfo] -- ^ Information of tickets - , nextPage :: Maybe Text -- ^ Next page + { ticketListTickets :: ![TicketInfo] + -- ^ Information of tickets + , nextPage :: Maybe Text + -- ^ Next page } type TicketId = Int data TicketInfo = TicketInfo - { ticketId :: !Int -- ^ Id of an ticket - , ticketTags :: ![Text] -- ^ Tags associated with ticket + { ticketId :: !Int + -- ^ Id of an ticket + , ticketTags :: ![Text] + -- ^ Tags associated with ticket } -- | Ticket status -data TicketStatus = - AnalyzedByScript -- ^ Ticket has been analyzed - | NoKnownIssue -- ^ Ticket had no known issue +data TicketStatus = AnalyzedByScript + -- ^ Ticket has been analyzed + | NoKnownIssue + -- ^ Ticket had no known issue -- | Defining it's own show instance to use it as tags renderTicketStatus :: TicketStatus -> Text @@ -72,36 +89,36 @@ renderTicketStatus NoKnownIssue = "no-known-issues" -- | JSON Parsing instance FromJSON Comment where - parseJSON = withObject "comment" $ \o -> - Comment <$> o .: "body" <*> o .: "attachments" <*> o .: "public" <*> o .: "author_id" + parseJSON = withObject "comment" $ \o -> + Comment <$> o .: "body" <*> o .: "attachments" <*> o .: "public" <*> o .: "author_id" -instance ToJSON Comment where -- Add tag and status - toJSON (Comment b as public author) - = object [ "body" .= b, "attachments" .= as, - "public" .= public, "author_id" .= author] +instance ToJSON Comment where + toJSON (Comment b as public author) + = object [ "body" .= b, "attachments" .= as, + "public" .= public, "author_id" .= author] instance ToJSON CommentOuter where - toJSON (CommentOuter c) = object [ "comment" .= c ] + toJSON (CommentOuter c) = object [ "comment" .= c ] instance FromJSON Attachment where - parseJSON = withObject "attachment" $ \o -> - Attachment <$> o .: "content_url" <*> o .: "content_type" <*> o .: "size" + parseJSON = withObject "attachment" $ \o -> + Attachment <$> o .: "content_url" <*> o .: "content_type" <*> o .: "size" instance ToJSON Ticket where - toJSON (Ticket comment assignee tags) = - object [ "ticket" .= object - [ "comment" .= comment, "assignee_id" .= assignee, "tags" .= tags] - ] + toJSON (Ticket comment assignee tags) = + object [ "ticket" .= object + [ "comment" .= comment, "assignee_id" .= assignee, "tags" .= tags] + ] instance ToJSON Attachment where - toJSON (Attachment url contenttype size) = - object [ "content_url" .= url, "content_type" .= contenttype, "size" .= size] + toJSON (Attachment url contenttype size) = + object [ "content_url" .= url, "content_type" .= contenttype, "size" .= size] instance FromJSON TicketInfo where - parseJSON = withObject "ticket" $ \o -> TicketInfo <$> (o .: "id") <*> (o .: "tags") + parseJSON = withObject "ticket" $ \o -> TicketInfo <$> (o .: "id") <*> (o .: "tags") instance FromJSON TicketList where - parseJSON = withObject "ticketList" $ \o -> TicketList <$> o .: "tickets" <*> o .: "next_page" + parseJSON = withObject "ticketList" $ \o -> TicketList <$> o .: "tickets" <*> o .: "next_page" -- | Parse tickets parseTickets :: Value -> Parser TicketList diff --git a/src/Util.hs b/src/Util.hs index b15dbe4..3c7ab63 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -1,7 +1,7 @@ module Util - ( extractLogsFromZip - , readZip - ) where + ( extractLogsFromZip + , readZip + ) where import Universum @@ -11,12 +11,13 @@ import qualified Data.Map.Strict as Map -- | Extract log file from given zip file extractLogsFromZip :: Int -> LByteString -> Either Text [LByteString] extractLogsFromZip numberOfFiles file = do - zipMap <- readZip file -- Read File - let extractedLogs = Map.elems $ mTake numberOfFiles zipMap -- Extract selected logs + zipMap <- readZip file -- Read File + let extractedLogs = Map.elems $ mTake numberOfFiles zipMap -- Extract selected logs return extractedLogs where mTake n = Map.fromDistinctAscList . take n . Map.toAscList +-- | Read zipe file readZip :: LByteString -> Either Text (Map FilePath LByteString) readZip rawzip = case Zip.toArchiveOrFail rawzip of Left err -> Left (toText err) diff --git a/src/Zendesk.hs b/src/Zendesk.hs index bc91d3b..6a7f7f9 100644 --- a/src/Zendesk.hs +++ b/src/Zendesk.hs @@ -3,8 +3,8 @@ {-# LANGUAGE RecordWildCards #-} module Zendesk - ( runZendeskMain - ) where + ( runZendeskMain + ) where import Universum @@ -13,7 +13,7 @@ import Data.Aeson (FromJSON, ToJSON, Value, encode) import Data.Aeson.Text (encodeToLazyText) import Data.Aeson.Types (Parser, parseEither) import Data.Attoparsec.Text.Lazy (eitherResult, parse) -import Data.Text (stripEnd, isInfixOf) +import Data.Text (isInfixOf, stripEnd) import Network.HTTP.Simple (Request, addRequestHeader, getResponseBody, httpJSON, httpLBS, parseRequest_, setRequestBasicAuth, setRequestBodyJSON, setRequestMethod, setRequestPath) @@ -22,7 +22,8 @@ import CLI (CLI (..), getCliArgs) import LogAnalysis.Classifier (extractErrorCodes, extractIssuesFromLogs, prettyFormatAnalysis) import LogAnalysis.KnowledgeCSVParser (parseKnowLedgeBase) -import LogAnalysis.Types (ErrorCode (..), Knowledge, setupAnalysis, toComment, renderErrorCode) +import LogAnalysis.Types (ErrorCode (..), Knowledge, renderErrorCode, setupAnalysis, + toComment) import Types (Attachment (..), Comment (..), Ticket (..), TicketId, TicketInfo (..), TicketList (..), TicketStatus (..), parseAgentId, parseComments, parseTickets, renderTicketStatus) @@ -32,17 +33,23 @@ import Util (extractLogsFromZip) data Config = Config { cfgAgentId :: !Integer + -- ^ Zendesk agent id , cfgZendesk :: !Text + -- ^ URL to Zendesk , cfgToken :: !Text + -- ^ Zendesk token , cfgEmail :: !Text + -- ^ Email address of the user the classifier will process on , cfgAssignTo :: !Integer + -- ^ User that will be assigned to after the classifier has done the analysis , cfgKnowledgebase :: ![Knowledge] + -- ^ Knowledgebase , cfgNumOfLogsToAnalyze :: !Int - } deriving (Show, Eq) + -- ^ Number of files classifier will analyze + } deriving (Eq, Show) -data RequestType = - Requested - | Assigned +data RequestType = Requested + | Assigned newtype App a = App (ReaderT Config IO a) deriving ( Applicative @@ -55,7 +62,6 @@ newtype App a = App (ReaderT Config IO a) runApp :: App a -> Config -> IO a runApp (App a) = runReaderT a --- | This scirpt will look through tickets that are assigned by cfgEmail defaultConfig :: Config defaultConfig = Config 0 "https://iohk.zendesk.com" "" "daedalus-bug-reports@iohk.io" 0 [] 5 @@ -79,12 +85,13 @@ runZendeskMain = do assignFile <- readFile assignToPath -- Select assignee knowledges <- setupKnowledgebaseEnv knowledgebasePath assignTo <- case readEither assignFile of - Right aid -> return aid - Left err -> error err - let cfg' = defaultConfig { cfgToken = stripEnd token - , cfgAssignTo = assignTo - , cfgKnowledgebase = knowledges - } + Right agentid -> return agentid + Left err -> error err + let cfg' = defaultConfig + { cfgToken = stripEnd token + , cfgAssignTo = assignTo + , cfgKnowledgebase = knowledges + } agentId <- runApp getAgentId cfg' let cfg = cfg' { cfgAgentId = agentId } case args of @@ -118,7 +125,8 @@ runZendeskMain = do putTextLn (toText res) -- Collect statistics ShowStatistics -> do - putTextLn $ "Classifier is going to gather ticket information assigned to: " <> cfgEmail cfg + putTextLn $ "Classifier is going to gather ticket information assigned to: " + <> cfgEmail cfg printWarning tickets <- runApp (listTickets Assigned) cfg printTicketCountMessage tickets (cfgEmail cfg) @@ -133,9 +141,10 @@ printTicketCountMessage tickets email = do let ticketCount = length tickets putTextLn "Done!" putTextLn $ "There are currently " <> show ticketCount - <> " tickets in the system assigned to " <> email + <> " tickets in the system assigned to " <> email let filteredTicketCount = length $ filterAnalyzedTickets tickets - putTextLn $ show (ticketCount - filteredTicketCount) <> " tickets has been analyzed by the classifier." + putTextLn $ show (ticketCount - filteredTicketCount) + <> " tickets has been analyzed by the classifier." putTextLn $ show filteredTicketCount <> " tickets are not analyzed." putTextLn "Below are statistics:" let tagGroups = sortTickets tickets @@ -145,7 +154,8 @@ printTicketCountMessage tickets email = do sortTickets :: [TicketInfo] -> [(Text, Int)] sortTickets tickets = let extractedTags = foldr (\TicketInfo{..} acc -> ticketTags <> acc) [] tickets -- Extract tags from tickets - tags2Filter = ["s3", "s2", "cannot-sync", "closed-by-merge", "web_widget", "analyzed-by-script"] + 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 @@ -203,23 +213,23 @@ 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 + let extractResult = extractLogsFromZip cfgNumOfLogsToAnalyze rawlog + case extractResult of Left err -> do - liftIO $ putTextLn $ "Error parsing zip:" <> err - return (toComment SentLogCorrupted , [renderErrorCode SentLogCorrupted], False) + liftIO $ putTextLn $ "Error parsing zip:" <> err + return (toComment SentLogCorrupted , [renderErrorCode 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_ putTextLn errorCodes - return (toText commentRes, errorCodes, False) - Left noResult -> do - liftIO $ putTextLn noResult - return (noResult, [renderTicketStatus NoKnownIssue], False) + let analysisEnv = setupAnalysis cfgKnowledgebase + eitherAnalysisResult = extractIssuesFromLogs result analysisEnv + case eitherAnalysisResult of + Right analysisResult -> do -- do something! + let errorCodes = extractErrorCodes analysisResult + commentRes = prettyFormatAnalysis analysisResult + liftIO $ mapM_ putTextLn errorCodes + return (toText commentRes, errorCodes, False) + Left noResult -> do + liftIO $ putTextLn noResult + return (noResult, [renderTicketStatus NoKnownIssue], False) -- | Filter analyzed tickets filterAnalyzedTickets :: [TicketInfo] -> [TicketId] @@ -228,8 +238,8 @@ filterAnalyzedTickets = foldr (\TicketInfo{..} acc -> then acc else ticketId : acc ) [] - where analyzedIndicatorTag :: Text - analyzedIndicatorTag = renderTicketStatus AnalyzedByScript + where analyzedIndicatorTag :: Text + analyzedIndicatorTag = renderTicketStatus AnalyzedByScript -- | Return list of ticketIds that has been requested by config user (not used) listTickets :: RequestType -> App [TicketInfo] @@ -242,11 +252,11 @@ listTickets request = do req = apiRequest cfg url go :: [TicketInfo] -> Text -> IO [TicketInfo] go tlist nextPage' = do - let req' = apiRequestAbsolute cfg nextPage' - (TicketList pagen nextPagen) <- apiCall parseTickets req' - case nextPagen of - Just nextUrl -> go (tlist <> pagen) nextUrl - Nothing -> pure (tlist <> pagen) + let req' = apiRequestAbsolute cfg nextPage' + (TicketList pagen nextPagen) <- apiCall parseTickets req' + case nextPagen of + Just nextUrl -> go (tlist <> pagen) nextUrl + Nothing -> pure (tlist <> pagen) (TicketList page0 nextPage) <- liftIO $ apiCall parseTickets req case nextPage of @@ -259,12 +269,12 @@ postTicketComment tid body tags public = do cfg <- ask let req1 = apiRequest cfg ("tickets/" <> show tid <> ".json") req2 = addJsonBody - (Ticket - (Comment ("**Log classifier**\n\n" <> body) [] public (cfgAgentId cfg)) - (cfgAssignTo cfg) - (renderTicketStatus AnalyzedByScript:tags) - ) - req1 + (Ticket + (Comment ("**Log classifier**\n\n" <> body) [] public (cfgAgentId cfg)) + (cfgAssignTo cfg) + (renderTicketStatus AnalyzedByScript:tags) + ) + req1 void $ liftIO $ apiCall (pure . encodeToLazyText) req2 pure () @@ -298,15 +308,15 @@ apiCall parser req = do case parseEither parser v of Right o -> pure o Left e -> error $ "couldn't parse response " - <> toText e <> "\n" <> decodeUtf8 (encode v) + <> toText e <> "\n" <> decodeUtf8 (encode v) -- | General api request function apiRequest :: Config -> Text -> Request apiRequest Config{..} u = setRequestPath (encodeUtf8 path) $ addRequestHeader "Content-Type" "application/json" $ setRequestBasicAuth - (encodeUtf8 cfgEmail <> "/token") - (encodeUtf8 cfgToken) $ + (encodeUtf8 cfgEmail <> "/token") + (encodeUtf8 cfgToken) $ parseRequest_ (toString (cfgZendesk <> path)) where path ="/api/v2/" <> u @@ -315,6 +325,6 @@ apiRequest Config{..} u = setRequestPath (encodeUtf8 path) $ apiRequestAbsolute :: Config -> Text -> Request apiRequestAbsolute Config{..} u = addRequestHeader "Content-Type" "application/json" $ setRequestBasicAuth - (encodeUtf8 cfgEmail <> "/token") - (encodeUtf8 cfgToken) $ + (encodeUtf8 cfgEmail <> "/token") + (encodeUtf8 cfgToken) $ parseRequest_ (toString u) From 53660a829e461d539885ae6184f969a3d8288e86 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 17 May 2018 10:46:33 +0900 Subject: [PATCH 09/13] More fixing styles --- src/CLI.hs | 11 ++++++----- src/Classify.hs | 2 +- src/LogAnalysis/Classifier.hs | 2 +- src/LogAnalysis/KnowledgeCSVParser.hs | 15 ++++++++------- src/LogAnalysis/Types.hs | 2 +- src/Util.hs | 5 +++-- src/Zendesk.hs | 24 ++++++++++++++---------- 7 files changed, 34 insertions(+), 27 deletions(-) diff --git a/src/CLI.hs b/src/CLI.hs index 84d43ec..668b9ac 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -10,11 +10,11 @@ import Options.Applicative (Parser, argument, auto, command, execParse progDesc, strOption, (<**>)) import Paths_log_classifier (version) -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 request to the given url - | ShowStatistics -- ^ Show statistics +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 request to the given url + | ShowStatistics -- ^ Show statistics deriving Show -- | Parser for ProcessTicket @@ -45,6 +45,7 @@ cli = hsubparser $ mconcat (progDesc "Print list of ticket Ids that agent has been assigned")) ] +-- | Get CLI arguments from command line getCliArgs :: IO CLI getCliArgs = execParser opts where diff --git a/src/Classify.hs b/src/Classify.hs index 0bc8f5b..37249c6 100644 --- a/src/Classify.hs +++ b/src/Classify.hs @@ -65,7 +65,7 @@ runBehavior (Behavior behavior) files = do checkFile :: FilePath -> LByteString -> IO (Maybe [(ErrorName, ErrorCode)]) checkFile fp contents = do hits <- Map.traverseMaybeWithKey (checkBehaviorOnFile fp contents) behavior - if length hits > 0 + if length hits > 0 then pure $ Just $ Map.toList hits else pure Nothing checkBehaviorOnFile :: FilePath diff --git a/src/LogAnalysis/Classifier.hs b/src/LogAnalysis/Classifier.hs index c3315e9..cf9dc87 100644 --- a/src/LogAnalysis/Classifier.hs +++ b/src/LogAnalysis/Classifier.hs @@ -62,7 +62,7 @@ prettyFormatAnalysis as = <> "\n" <> kProblem <> "\n **" <> kSolution <> "** \n" - <> foldr1 (\txt ts -> "\n" <> txt <> "\n" <> ts) txts -- List errors + <> foldr1 (\txt ts -> "\n" <> txt <> "\n" <> ts) txts -- List errors <> "\n" <> acc <> "\n\n" ) "" aList diff --git a/src/LogAnalysis/KnowledgeCSVParser.hs b/src/LogAnalysis/KnowledgeCSVParser.hs index 2588e78..d67e0b0 100644 --- a/src/LogAnalysis/KnowledgeCSVParser.hs +++ b/src/LogAnalysis/KnowledgeCSVParser.hs @@ -18,8 +18,9 @@ insideQuotes = <*> (LT.concat <$> many (LT.cons <$> dquotes <*> insideQuotes)) "inside of double quotes" where + dquotes :: Parser Char dquotes = string "\"\"" >> return '"' - "paired double quotes" + "paired double quotes" -- | Parse quoted field quotedField :: Parser LText @@ -46,16 +47,16 @@ parseErrorCode = <|> (string "Error" >> return Error) -- | Parse each csv records -parseKnowledge :: Parser Knowledge -- not really clean code.. +parseKnowledge :: Parser Knowledge -- not really clean code.. parseKnowledge = do e <- quotedField - _ <- char ',' - _ <- char '"' + () <$ char ',' + () <$ char '"' c <- parseErrorCode - _ <- char '"' - _ <- char ',' + () <$ char '"' + () <$ char ',' p <- quotedField - _ <- char ',' + () <$ char ',' s <- quotedField return $ Knowledge e c p s diff --git a/src/LogAnalysis/Types.hs b/src/LogAnalysis/Types.hs index 92ef428..7df117d 100644 --- a/src/LogAnalysis/Types.hs +++ b/src/LogAnalysis/Types.hs @@ -14,7 +14,7 @@ import Universum import qualified Data.Map.Strict as Map -- | Identifier for each error -data ErrorCode +data ErrorCode = ShortStorage -- ^ Not enough space on hard drive to store block data | UserNameError -- ^ User is using non-latin characters for username | TimeSync -- ^ User's PC's time is out of sync diff --git a/src/Util.hs b/src/Util.hs index 3c7ab63..deb9012 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -11,10 +11,11 @@ import qualified Data.Map.Strict as Map -- | Extract log file from given zip file extractLogsFromZip :: Int -> LByteString -> Either Text [LByteString] extractLogsFromZip numberOfFiles file = do - zipMap <- readZip file -- Read File - let extractedLogs = Map.elems $ mTake numberOfFiles zipMap -- Extract selected logs + zipMap <- readZip file -- Read File + let extractedLogs = Map.elems $ mTake numberOfFiles zipMap -- Extract selected logs return extractedLogs where + mTake :: Int -> Map k a -> Map k a mTake n = Map.fromDistinctAscList . take n . Map.toAscList -- | Read zipe file diff --git a/src/Zendesk.hs b/src/Zendesk.hs index 6a7f7f9..8b10b27 100644 --- a/src/Zendesk.hs +++ b/src/Zendesk.hs @@ -81,7 +81,7 @@ runZendeskMain :: IO () runZendeskMain = do args <- getCliArgs putTextLn "Welcome to Zendesk classifier!" - token <- readFile tokenPath -- Zendesk token + token <- readFile tokenPath -- Zendesk token assignFile <- readFile assignToPath -- Select assignee knowledges <- setupKnowledgebaseEnv knowledgebasePath assignTo <- case readEither assignFile of @@ -153,12 +153,12 @@ printTicketCountMessage tickets email = do -- | Sort the ticket so we can see the statistics sortTickets :: [TicketInfo] -> [(Text, Int)] sortTickets tickets = - let extractedTags = foldr (\TicketInfo{..} acc -> ticketTags <> acc) [] tickets -- Extract tags from tickets + let extractedTags = foldr (\TicketInfo{..} acc -> ticketTags <> acc) [] tickets -- Extract tags from tickets tags2Filter = ["s3", "s2", "cannot-sync", "closed-by-merge" , "web_widget", "analyzed-by-script"] - filteredTags = filter (`notElem` tags2Filter) extractedTags -- Filter tags + filteredTags = filter (`notElem` tags2Filter) extractedTags -- Filter tags groupByTags :: [ Text ] -> [(Text, Int)] - groupByTags ts = map (\l@(x:_) -> (x, length l)) (group $ sort ts) -- Group them + groupByTags ts = map (\l@(x:_) -> (x, length l)) (group $ sort ts) -- Group them in groupByTags filteredTags -- | Read CSV file and setup knowledge base @@ -212,7 +212,7 @@ inspectAttachmentAndPostComment ticketId attachment = do inspectAttachment :: Attachment -> App (Text, [Text], Bool) inspectAttachment att = do Config{..} <- ask - rawlog <- liftIO $ getAttachment att -- Get attachment + rawlog <- liftIO $ getAttachment att -- Get attachment let extractResult = extractLogsFromZip cfgNumOfLogsToAnalyze rawlog case extractResult of Left err -> do @@ -222,7 +222,7 @@ inspectAttachment att = do let analysisEnv = setupAnalysis cfgKnowledgebase eitherAnalysisResult = extractIssuesFromLogs result analysisEnv case eitherAnalysisResult of - Right analysisResult -> do -- do something! + Right analysisResult -> do let errorCodes = extractErrorCodes analysisResult commentRes = prettyFormatAnalysis analysisResult liftIO $ mapM_ putTextLn errorCodes @@ -238,8 +238,9 @@ filterAnalyzedTickets = foldr (\TicketInfo{..} acc -> then acc else ticketId : acc ) [] - where analyzedIndicatorTag :: Text - analyzedIndicatorTag = renderTicketStatus AnalyzedByScript + where + analyzedIndicatorTag :: Text + analyzedIndicatorTag = renderTicketStatus AnalyzedByScript -- | Return list of ticketIds that has been requested by config user (not used) listTickets :: RequestType -> App [TicketInfo] @@ -288,7 +289,9 @@ getAgentId = do -- | Given attachmentUrl, return attachment in bytestring getAttachment :: Attachment -> IO LByteString getAttachment Attachment{..} = getResponseBody <$> httpLBS req - where req = parseRequest_ (toString attachmentURL) + where + req :: Request + req = parseRequest_ (toString attachmentURL) -- | Get ticket's comments getTicketComments :: TicketId -> App [Comment] @@ -319,7 +322,8 @@ apiRequest Config{..} u = setRequestPath (encodeUtf8 path) $ (encodeUtf8 cfgToken) $ parseRequest_ (toString (cfgZendesk <> path)) where - path ="/api/v2/" <> u + path :: Text + path = "/api/v2/" <> u -- | Api request but use absolute path apiRequestAbsolute :: Config -> Text -> Request From 1d520172756d33cf13f63b2ef97ef6ec28dad20b Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 17 May 2018 11:16:58 +0900 Subject: [PATCH 10/13] Fix fieldname --- src/Types.hs | 26 +++++++++++++------------- src/Zendesk.hs | 18 +++++++++--------- 2 files changed, 22 insertions(+), 22 deletions(-) diff --git a/src/Types.hs b/src/Types.hs index c8ddb2e..68f8734 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -24,23 +24,23 @@ import Data.Aeson.Types (Parser) -- | Attachment of the ticket data Attachment = Attachment - { attachmentURL :: !Text + { aURL :: !Text -- ^ URL of the attachment - , attachmentContentType :: !Text + , aContentType :: !Text -- ^ ContentType of the attachment - , attachmentSize :: !Int + , aSize :: !Int -- ^ Attachment size } -- | Comments data Comment = Comment - { commentBody :: !Text + { cBody :: !Text -- ^ Body of comment - , commentAttachments :: ![Attachment] + , cAttachments :: ![Attachment] -- ^ Attachment - , commentPublic :: !Bool + , cPublic :: !Bool -- ^ Flag of whether comment should be public - , commentAuthor :: !Integer + , cAuthor :: !Integer -- ^ Auther of comment } @@ -51,17 +51,17 @@ newtype CommentOuter = CommentOuter { -- | Zendexk ticket data Ticket = Ticket - { ticketComment :: !Comment + { tComment :: !Comment -- ^ Ticket comment - , ticketAssignee :: !Integer + , tAssignee :: !Integer -- ^ Assignee of the ticket - , ticketTag :: ![Text] + , tTag :: ![Text] -- ^ Tags attached to ticket } -- | List of zendesk ticket data TicketList = TicketList - { ticketListTickets :: ![TicketInfo] + { tlTickets :: ![TicketInfo] -- ^ Information of tickets , nextPage :: Maybe Text -- ^ Next page @@ -70,9 +70,9 @@ data TicketList = TicketList type TicketId = Int data TicketInfo = TicketInfo - { ticketId :: !Int + { tiId :: !Int -- ^ Id of an ticket - , ticketTags :: ![Text] + , tiTags :: ![Text] -- ^ Tags associated with ticket } diff --git a/src/Zendesk.hs b/src/Zendesk.hs index 8b10b27..9bb4b3d 100644 --- a/src/Zendesk.hs +++ b/src/Zendesk.hs @@ -100,7 +100,7 @@ runZendeskMain = do putTextLn $ "Classifier is going to extract emails requested by: " <> cfgEmail cfg tickets <- runApp (listTickets Requested) cfg putTextLn $ "There are " <> show (length tickets) <> " tickets requested by this user." - let ticketIds = foldr (\TicketInfo{..} acc -> ticketId : acc) [] tickets + let ticketIds = foldr (\TicketInfo{..} acc -> tiId : acc) [] tickets mapM_ (\tid -> runApp (extractEmailAddress tid) cfg) ticketIds -- Process given ticket (ProcessTicket ticketId) -> do @@ -153,7 +153,7 @@ printTicketCountMessage tickets email = do -- | Sort the ticket so we can see the statistics sortTickets :: [TicketInfo] -> [(Text, Int)] sortTickets tickets = - let extractedTags = foldr (\TicketInfo{..} acc -> ticketTags <> acc) [] tickets -- Extract tags from tickets + let extractedTags = foldr (\TicketInfo{..} acc -> tiTags <> acc) [] tickets -- Extract tags from tickets tags2Filter = ["s3", "s2", "cannot-sync", "closed-by-merge" , "web_widget", "analyzed-by-script"] filteredTags = filter (`notElem` tags2Filter) extractedTags -- Filter tags @@ -174,7 +174,7 @@ setupKnowledgebaseEnv path = do extractEmailAddress :: TicketId -> App () extractEmailAddress ticketId = do comments <- getTicketComments ticketId - let commentWithEmail = commentBody $ fromMaybe (error "No comment") (safeHead comments) + let commentWithEmail = cBody $ fromMaybe (error "No comment") (safeHead comments) emailAddress = fromMaybe (error "No email") (safeHead $ lines commentWithEmail) liftIO $ guard ("@" `isInfixOf` emailAddress) liftIO $ appendFile "emailAddress.txt" (emailAddress <> "\n") @@ -188,11 +188,11 @@ processTicketAndId ticketId = do -- Filter tickets without logs -- Could analyze the comments but I don't see it useful.. commentsWithAttachments :: [Comment] - commentsWithAttachments = filter (\x -> length (commentAttachments x) > 0) comments + commentsWithAttachments = filter (\x -> length (cAttachments x) > 0) comments -- Filter out ticket without logs attachments :: [ Attachment ] - attachments = concatMap commentAttachments commentsWithAttachments - justLogs = filter (\x -> "application/zip" == attachmentContentType x) attachments + attachments = concatMap cAttachments commentsWithAttachments + justLogs = filter (\x -> "application/zip" == aContentType x) attachments mapM_ (inspectAttachmentAndPostComment ticketId) justLogs pure () @@ -234,9 +234,9 @@ inspectAttachment att = do -- | Filter analyzed tickets filterAnalyzedTickets :: [TicketInfo] -> [TicketId] filterAnalyzedTickets = foldr (\TicketInfo{..} acc -> - if analyzedIndicatorTag `elem` ticketTags + if analyzedIndicatorTag `elem` tiTags then acc - else ticketId : acc + else tiId : acc ) [] where analyzedIndicatorTag :: Text @@ -291,7 +291,7 @@ getAttachment :: Attachment -> IO LByteString getAttachment Attachment{..} = getResponseBody <$> httpLBS req where req :: Request - req = parseRequest_ (toString attachmentURL) + req = parseRequest_ (toString aURL) -- | Get ticket's comments getTicketComments :: TicketId -> App [Comment] From b47bc2e4b55be2e9bacf1eb18bf1d4c52657da9b Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 17 May 2018 11:29:35 +0900 Subject: [PATCH 11/13] Fix getCLIArgs function styling --- src/CLI.hs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/src/CLI.hs b/src/CLI.hs index 668b9ac..a4c4bb0 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -5,7 +5,7 @@ module CLI import Universum -import Options.Applicative (Parser, argument, auto, command, execParser, fullDesc, header, +import Options.Applicative (Parser, ParserInfo, argument, auto, command, execParser, fullDesc, header, help, helper, hsubparser, info, infoOption, long, metavar, progDesc, strOption, (<**>)) import Paths_log_classifier (version) @@ -48,12 +48,14 @@ cli = hsubparser $ mconcat -- | Get CLI arguments from command line 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") + where + opts :: ParserInfo CLI + opts = info (cli <**> helper <**> versionHelper) + ( fullDesc + <> header "Log classifier" + <> progDesc "Client for peforming analysis on Zendesk" + ) + versionHelper :: Parser (a -> a) + versionHelper = infoOption + ("Log classifier version" <> show version) + (long "version" <> help "Show version") From 9b3c4eb3486761e2053dd4d58575bdf4050d04ac Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 17 May 2018 14:54:11 +0900 Subject: [PATCH 12/13] Add let --- src/CLI.hs | 2 +- src/Zendesk.hs | 18 +++++++++--------- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/CLI.hs b/src/CLI.hs index a4c4bb0..4e51276 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -15,7 +15,7 @@ data CLI = CollectEmails -- ^ Collect email addresses | ProcessTickets -- ^ Procss all the tickets in the Zendesk | RawRequest String -- ^ Raw request to the given url | ShowStatistics -- ^ Show statistics - deriving Show + deriving (Show) -- | Parser for ProcessTicket cmdProcessTicket :: Parser CLI diff --git a/src/Zendesk.hs b/src/Zendesk.hs index 9bb4b3d..8f687fd 100644 --- a/src/Zendesk.hs +++ b/src/Zendesk.hs @@ -175,7 +175,7 @@ extractEmailAddress :: TicketId -> App () extractEmailAddress ticketId = do comments <- getTicketComments ticketId let commentWithEmail = cBody $ fromMaybe (error "No comment") (safeHead comments) - emailAddress = fromMaybe (error "No email") (safeHead $ lines commentWithEmail) + let emailAddress = fromMaybe (error "No email") (safeHead $ lines commentWithEmail) liftIO $ guard ("@" `isInfixOf` emailAddress) liftIO $ appendFile "emailAddress.txt" (emailAddress <> "\n") liftIO $ putTextLn emailAddress @@ -190,9 +190,9 @@ processTicketAndId ticketId = do commentsWithAttachments :: [Comment] commentsWithAttachments = filter (\x -> length (cAttachments x) > 0) comments -- Filter out ticket without logs - attachments :: [ Attachment ] - attachments = concatMap cAttachments commentsWithAttachments - justLogs = filter (\x -> "application/zip" == aContentType x) attachments + let attachments :: [ Attachment ] + attachments = concatMap cAttachments commentsWithAttachments + let justLogs = filter (\x -> "application/zip" == aContentType x) attachments mapM_ (inspectAttachmentAndPostComment ticketId) justLogs pure () @@ -224,7 +224,7 @@ inspectAttachment att = do case eitherAnalysisResult of Right analysisResult -> do let errorCodes = extractErrorCodes analysisResult - commentRes = prettyFormatAnalysis analysisResult + let commentRes = prettyFormatAnalysis analysisResult liftIO $ mapM_ putTextLn errorCodes return (toText commentRes, errorCodes, False) Left noResult -> do @@ -247,11 +247,11 @@ listTickets :: RequestType -> App [TicketInfo] listTickets request = do cfg <- ask let agentId = cfgAgentId cfg - url = case request of + let url = case request of Requested -> "/users/" <> show agentId <> "/tickets/requested.json" Assigned -> "/users/" <> show agentId <> "/tickets/assigned.json" - req = apiRequest cfg url - go :: [TicketInfo] -> Text -> IO [TicketInfo] + let req = apiRequest cfg url + let go :: [TicketInfo] -> Text -> IO [TicketInfo] go tlist nextPage' = do let req' = apiRequestAbsolute cfg nextPage' (TicketList pagen nextPagen) <- apiCall parseTickets req' @@ -269,7 +269,7 @@ postTicketComment :: TicketId -> Text -> [Text] -> Bool -> App () postTicketComment tid body tags public = do cfg <- ask let req1 = apiRequest cfg ("tickets/" <> show tid <> ".json") - req2 = addJsonBody + let req2 = addJsonBody (Ticket (Comment ("**Log classifier**\n\n" <> body) [] public (cfgAgentId cfg)) (cfgAssignTo cfg) From b20b365bdebf7235e2b8a952b842642a1cceb8e6 Mon Sep 17 00:00:00 2001 From: HirotoShioi Date: Thu, 17 May 2018 18:47:53 +0900 Subject: [PATCH 13/13] Revert style changes --- src/LogAnalysis/KnowledgeCSVParser.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/LogAnalysis/KnowledgeCSVParser.hs b/src/LogAnalysis/KnowledgeCSVParser.hs index d67e0b0..dbaf947 100644 --- a/src/LogAnalysis/KnowledgeCSVParser.hs +++ b/src/LogAnalysis/KnowledgeCSVParser.hs @@ -50,13 +50,13 @@ parseErrorCode = parseKnowledge :: Parser Knowledge -- not really clean code.. parseKnowledge = do e <- quotedField - () <$ char ',' - () <$ char '"' + _ <- char ',' + _ <- char '"' c <- parseErrorCode - () <$ char '"' - () <$ char ',' + _ <- char '"' + _ <- char ',' p <- quotedField - () <$ char ',' + _ <- char ',' s <- quotedField return $ Knowledge e c p s