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/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 diff --git a/src/CLI.hs b/src/CLI.hs index 18f5bea..4e51276 100644 --- a/src/CLI.hs +++ b/src/CLI.hs @@ -3,56 +3,59 @@ module CLI , getCliArgs ) where -import Data.Semigroup ((<>)) -import Options.Applicative (Parser, argument, auto, command, execParser, fullDesc, header, +import Universum + +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) -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")) + ] +-- | 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") diff --git a/src/Classify.hs b/src/Classify.hs index 6cf2235..37249c6 100644 --- a/src/Classify.hs +++ b/src/Classify.hs @@ -4,160 +4,151 @@ {-# LANGUAGE RankNTypes #-} -- Currenty not used.. -module Classify (classifyZip, ErrorCode(..), ErrorName, postProcessError, ConfirmedError(..)) where - -import qualified Codec.Archive.Zip as Zip - -import Control.Monad (forM) +module Classify + ( ConfirmedError(..) + , ErrorCode(..) + , ErrorName + , classifyZip + , postProcessError + ) where +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 qualified Data.List.NonEmpty as N +import qualified Data.Map.Strict as Map +import GHC.Stack (HasCallStack) import Regex (MatchWithCaptures, Regex, RegexCompileError, RegexString, compileRegex, matchAll, matchTest) -import Data.Text (Text) -import qualified Data.Text as Text - -import Data.List (foldl') -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) type ErrorName = Text -data ErrorHandler - = ErrorHandler +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) +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 - 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 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 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 - -> ErrorName - -> ErrorHandler - -> IO (Maybe ErrorCode) - checkBehaviorOnFile fp contents _ errhandler = do - 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 do - pure Nothing - Map.traverseMaybeWithKey checkFile files - -readZip :: HasCallStack => LBS.ByteString -> Either String (Map FilePath LBS.ByteString) + 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 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" - let - zipmap' = readZip rawzip - let - behaviorList :: [ (ErrorName, (RegexString, RegexString, LBS.ByteString -> [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 $ LT.decodeUtf8 $ last $ 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 . Text.unpack) pure + --zip <- readZip <$> LreadFile "logs.zip" + 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 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 @@ -167,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 2b221f8..840ff37 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,8 +1,8 @@ module Lib - ( someFunc - ) where - + ( 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..cf9dc87 100644 --- a/src/LogAnalysis/Classifier.hs +++ b/src/LogAnalysis/Classifier.hs @@ -3,67 +3,66 @@ {-# LANGUAGE RecordWildCards #-} module LogAnalysis.Classifier - ( extractIssuesFromLogs - , extractErrorCodes + ( extractErrorCodes + , extractIssuesFromLogs , 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) 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 (..), toTag) +import LogAnalysis.Types (Analysis, Knowledge (..), renderErrorCode) -- | Number of error texts it should show numberOfErrorText :: Int numberOfErrorText = 3 -- | Analyze each log file based on the knowlodgebases' data. -extractIssuesFromLogs :: [LBS.ByteString] -> Analysis -> Either String 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 -- | 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 - 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{..}, _) -> toTag kErrorCode) $ Map.toList as +extractErrorCodes as = map (\(Knowledge{..}, _) -> renderErrorCode kErrorCode) $ Map.toList as -prettyFormatAnalysis :: Analysis -> LT.Text +-- | TODO (Hiroto): Format the text in better way +prettyFormatAnalysis :: Analysis -> LText prettyFormatAnalysis as = let aList = Map.toList as in foldr (\(Knowledge{..}, txts) acc -> - "\n" <> LT.pack (show kErrorCode) - <> "\n" <> kProblem - <> "\n **" <> kSolution - <> "** \n" - <> foldr (\txt ts -> "\n" <> txt <> "\n" <> ts) LT.empty txts -- List errors - <> "\n" <> acc - <> "\n\n" - ) LT.empty 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 c52db08..dbaf947 100644 --- a/src/LogAnalysis/KnowledgeCSVParser.hs +++ b/src/LogAnalysis/KnowledgeCSVParser.hs @@ -4,27 +4,26 @@ 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 +-- | Take any string that is inside quotes +insideQuotes :: Parser LText insideQuotes = - LT.append <$> (LT.fromStrict <$> takeWhile (/= '"')) + 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 :: Parser Char + dquotes = string "\"\"" >> return '"' + "paired double quotes" -- | Parse quoted field -quotedField :: Parser LT.Text +quotedField :: Parser LText quotedField = char '"' *> insideQuotes <* char '"' "quoted field" @@ -47,8 +46,8 @@ parseErrorCode = <|> (string "Unknown" >> return Unknown) <|> (string "Error" >> return Error) --- |Parse each csv records -parseKnowledge :: Parser Knowledge -- not really clean code.. +-- | Parse each csv records +parseKnowledge :: Parser Knowledge -- not really clean code.. parseKnowledge = do e <- quotedField _ <- char ',' @@ -61,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 ef18156..7df117d 100644 --- a/src/LogAnalysis/Types.hs +++ b/src/LogAnalysis/Types.hs @@ -1,69 +1,72 @@ {-# LANGUAGE OverloadedStrings #-} module LogAnalysis.Types - ( Analysis - , ErrorCode (..) - , Knowledge (..) - , setupAnalysis - , toTag - , toComment - ) where + ( Analysis + , ErrorCode (..) + , Knowledge (..) + , setupAnalysis + , renderErrorCode + , toComment + ) where + +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 - = 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) + = 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 :: !LT.Text -- ^ 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 - } 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) -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" 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 c4960d8..6e1a875 100644 --- a/src/Regex.hs +++ b/src/Regex.hs @@ -1,42 +1,35 @@ 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 import qualified Data.Array as Array - -import qualified Data.ByteString.Lazy as LBS - +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 @@ -47,20 +40,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 6f06d01..68f8734 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -1,108 +1,124 @@ {-# LANGUAGE OverloadedStrings #-} module Types - ( Comment(..) - , CommentOuter(..) - , Attachment(..) - , Ticket(..) - , TicketList(..) - , TicketId - , TicketInfo(..) - , TicketStatus(..) - , parseAgentId - , parseComments - , parseTickets - ) where - -import Data.Aeson + ( Attachment(..) + , Comment(..) + , CommentOuter(..) + , Ticket(..) + , TicketInfo(..) + , TicketId + , TicketList(..) + , TicketStatus(..) + , parseAgentId + , parseComments + , parseTickets + , renderTicketStatus + ) where + +import Universum + +import Data.Aeson (FromJSON, ToJSON, Value, object, parseJSON, toJSON, withObject, (.:), + (.=)) import Data.Aeson.Types (Parser) -import Data.Text (Text) + + +-- | Attachment of the ticket +data Attachment = Attachment + { aURL :: !Text + -- ^ URL of the attachment + , aContentType :: !Text + -- ^ ContentType of the attachment + , aSize :: !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 - } deriving (Show, Eq) + { cBody :: !Text + -- ^ Body of comment + , cAttachments :: ![Attachment] + -- ^ Attachment + , cPublic :: !Bool + -- ^ Flag of whether comment should be public + , cAuthor :: !Integer + -- ^ Auther of comment + } -- | 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) + { tComment :: !Comment + -- ^ Ticket comment + , tAssignee :: !Integer + -- ^ Assignee of the ticket + , tTag :: ![Text] + -- ^ Tags attached to ticket + } -- | List of zendesk ticket data TicketList = TicketList - { ticketListTickets :: ![TicketInfo] -- ^ Information of tickets - , nextPage :: Maybe Text -- ^ Next page - } deriving (Show, Eq) + { tlTickets :: ![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 - } deriving (Eq) - -instance Show TicketInfo where - show (TicketInfo tid _) = show tid + { tiId :: !Int + -- ^ Id of an ticket + , tiTags :: ![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 -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 - 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 d47eeb6..deb9012 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -1,34 +1,30 @@ module Util - ( extractLogsFromZip - , tshow - , readZip - ) where + ( extractLogsFromZip + , 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 String [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 + 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 -readZip :: LBS.ByteString -> Either String (Map FilePath LBS.ByteString) +-- | Read zipe file +readZip :: LByteString -> Either Text (Map FilePath LByteString) 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 + 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) diff --git a/src/Zendesk.hs b/src/Zendesk.hs index eb9a47d..8f687fd 100644 --- a/src/Zendesk.hs +++ b/src/Zendesk.hs @@ -3,26 +3,17 @@ {-# LANGUAGE RecordWildCards #-} module Zendesk - ( runZendeskMain - ) where + ( runZendeskMain + ) where + +import Universum -import Control.Monad (guard, void) -import Control.Monad.IO.Class (MonadIO, liftIO) 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 (isInfixOf, stripEnd) import Network.HTTP.Simple (Request, addRequestHeader, getResponseBody, httpJSON, httpLBS, parseRequest_, setRequestBasicAuth, setRequestBodyJSON, setRequestMethod, setRequestPath) @@ -31,25 +22,34 @@ 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, renderErrorCode, setupAnalysis, + toComment) 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 + -- ^ 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 @@ -62,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 @@ -70,107 +69,116 @@ 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" 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 - , cfgKnowledgebase = knowledges - } + assignTo <- case readEither assignFile of + 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 -- 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." - let ticketIds = foldr (\TicketInfo{..} acc -> ticketId : acc) [] tickets + putTextLn $ "There are " <> show (length tickets) <> " tickets requested by this user." + let ticketIds = foldr (\TicketInfo{..} acc -> tiId : 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 - <> " tickets in the system assigned to " <> email + 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)] 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"] - filteredTags = filter (`notElem` tags2Filter) extractedTags -- Filter tags + 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 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 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 = cBody $ fromMaybe (error "No comment") (safeHead comments) + let 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 () @@ -180,18 +188,18 @@ 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 + let attachments :: [ Attachment ] + attachments = concatMap cAttachments commentsWithAttachments + let justLogs = filter (\x -> "application/zip" == aContentType x) attachments mapM_ (inspectAttachmentAndPostComment ticketId) justLogs pure () -- | 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 @@ -204,51 +212,52 @@ inspectAttachmentAndPostComment ticketId attachment = do 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 + rawlog <- liftIO $ getAttachment att -- Get attachment + let extractResult = extractLogsFromZip cfgNumOfLogsToAnalyze rawlog + case extractResult 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 - case eitherAnalysisResult of - Right analysisResult -> do -- do something! - let errorCodes = extractErrorCodes analysisResult - let commentRes = prettyFormatAnalysis analysisResult - liftIO $ mapM_ T.putStrLn errorCodes - return (LT.toStrict commentRes, errorCodes, False) - Left noResult -> do - liftIO $ putStrLn noResult - return (LT.toStrict (LT.pack noResult), [tshow NoKnownIssue], False) + let analysisEnv = setupAnalysis cfgKnowledgebase + eitherAnalysisResult = extractIssuesFromLogs result analysisEnv + case eitherAnalysisResult of + Right analysisResult -> do + 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) -- | 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 - analyzedIndicatorTag = tshow AnalyzedByScript + where + analyzedIndicatorTag :: Text + analyzedIndicatorTag = renderTicketStatus AnalyzedByScript -- | Return list of ticketIds that has been requested by config user (not used) listTickets :: RequestType -> App [TicketInfo] 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" - req = apiRequest cfg url - go :: [TicketInfo] -> Text -> IO [TicketInfo] - go list 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) + let url = case request of + Requested -> "/users/" <> show agentId <> "/tickets/requested.json" + Assigned -> "/users/" <> show agentId <> "/tickets/assigned.json" + 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' + case nextPagen of + Just nextUrl -> go (tlist <> pagen) nextUrl + Nothing -> pure (tlist <> pagen) (TicketList page0 nextPage) <- liftIO $ apiCall parseTickets req case nextPage of @@ -259,14 +268,14 @@ 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") - req2 = addJsonBody - (Ticket - (Comment ("**Log classifier**\n\n" <> body) [] public (cfgAgentId cfg)) - (cfgAssignTo cfg) - (tshow AnalyzedByScript:tags) - ) - req1 + let req1 = apiRequest cfg ("tickets/" <> show tid <> ".json") + let req2 = addJsonBody + (Ticket + (Comment ("**Log classifier**\n\n" <> body) [] public (cfgAgentId cfg)) + (cfgAssignTo cfg) + (renderTicketStatus AnalyzedByScript:tags) + ) + req1 void $ liftIO $ apiCall (pure . encodeToLazyText) req2 pure () @@ -278,15 +287,17 @@ 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 :: Request + req = parseRequest_ (toString aURL) -- | 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 +311,24 @@ 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 :: Text + 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)