diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,9 +1,9 @@ module Main (main) where -import AwsSpendSummary (Options(Options), numberOfDays, printCosts) +import AwsSpendSummary (Options(Options), threshold, numberOfDays, printCosts) import Data.Default (def) import Data.Text (Text) -import Options.Applicative ((<**>), Parser, ParserInfo, argument, auto, execParser, fullDesc, header, help, helper, hidden, info, long, metavar, option, progDesc, short, showDefault, str, value) +import Options.Applicative ((<**>), Parser, ParserInfo, argument, auto, execParser, fullDesc, header, help, helper, info, long, metavar, option, optional, progDesc, short, showDefault, str, strOption, value) data CostQuery = CostQuery { @@ -11,26 +11,44 @@ , bucketPath :: Text , costReportName :: Text , daysToQuery :: Integer +, requestThreshold :: Double +, requestCsvOutputFile :: Maybe Text } costArgParser :: Parser CostQuery costArgParser = CostQuery - <$> argument str (metavar "BUCKET_NAME") + <$> argument str ( + metavar "BUCKET_NAME" + <> help "The name of the S3 bucket that the cost report was exported to") <*> argument str ( metavar "BUCKET_PATH" <> help ( "This is the prefix to the bucket key AWS asks " <> "you specify when setting up a cost report") ) - <*> argument str (metavar "COST_REPORT_NAME") + <*> argument str ( + metavar "COST_REPORT_NAME" + <> help "The name given when creating the cost report") <*> option auto ( long "days" <> short 'd' - <> hidden <> metavar "DAYS" <> value (numberOfDays def) <> showDefault <> help "Number of days to print" ) + <*> option auto ( + long "threshold" + <> short 't' + <> metavar "DOLLARS" + <> value (threshold def) + <> showDefault + <> help "Threshold to detrmine red/green colouring on thhe console" + ) + <*> optional ( strOption $ + long "csv-output" + <> help "Specify a file to dump the CSV output into. Useful for testing debugging or to go and explore further!" + <> metavar "FILENAME" + ) opts :: ParserInfo CostQuery opts = info @@ -42,7 +60,9 @@ main :: IO () main = do costQuery <- execParser opts - printCosts (Options (daysToQuery costQuery)) + printCosts (Options (daysToQuery costQuery) + (requestThreshold costQuery) + (requestCsvOutputFile costQuery)) (bucketName costQuery) (bucketPath costQuery) (costReportName costQuery) diff --git a/aws-spend-summary.cabal b/aws-spend-summary.cabal --- a/aws-spend-summary.cabal +++ b/aws-spend-summary.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: aws-spend-summary -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Extract recent daily AWS costs description: @@ -21,7 +21,8 @@ data-default >=0.7.1.1 && <0.9 , text >=2.0.2 && < 2.2 default-extensions: - ScopedTypeVariables + LambdaCase + , ScopedTypeVariables , OverloadedStrings library diff --git a/src/AwsSpendSummary.hs b/src/AwsSpendSummary.hs --- a/src/AwsSpendSummary.hs +++ b/src/AwsSpendSummary.hs @@ -6,7 +6,7 @@ This module is for printing AWS account costs to the terminal. Costs are all unblended and shown per day. -} -module AwsSpendSummary (Options(Options), numberOfDays, printCosts) where +module AwsSpendSummary (Options(Options), numberOfDays, printCosts, threshold) where import Prelude hiding (concat) import Amazonka.Data.Body (_ResponseBody) @@ -21,15 +21,14 @@ import Data.Default (Default, def) import Data.Map as Map (Map(), insertWith, filterWithKey, toAscList) import qualified Data.Map as Map (empty) -import qualified Data.Set as Set (fromList, toList) -import Data.Text.Encoding (decodeUtf8) import Data.Text (Text, pack, unpack) -import Data.Time.Calendar (fromGregorian, toGregorian) -import Data.Time.Clock (UTCTime, NominalDiffTime, addUTCTime, getCurrentTime, nominalDay, secondsToDiffTime, utctDay) +import Data.Text.Encoding (decodeUtf8) +import Data.Time.Calendar (addGregorianMonthsClip, fromGregorian, toGregorian) +import Data.Time.Clock (UTCTime(UTCTime), addUTCTime, getCurrentTime, nominalDay, secondsToDiffTime, utctDay) import Data.Time.Format (defaultTimeLocale, formatTime, parseTimeOrError) import qualified Data.Time.Timelens as TL (utctDay, utctDayTime) import Data.Vector (Vector, concat, empty) -import Network.HTTP.Types.Status (statusCode) +import Network.HTTP.Types.Status (status404) import Numeric (showFFloat) import System.Console.ANSI (Color(Green, Red), ColorIntensity(Dull, Vivid), ConsoleLayer(Foreground), SGR(Reset, SetColor), setSGR) import System.IO (hPutStrLn, stderr) @@ -38,25 +37,12 @@ -- | Optional arguments to pass to @printCosts@ data Options = Options { numberOfDays :: Integer -- ^ Number of days to show results for +, threshold :: Double -- ^ Threshold to determine red/green colouring on console +, csvOutputFile :: Maybe Text -- ^ Optional file to dump the csv response into } instance Default Options where - def = Options 15 - -instance FromField UTCTime where - parseField = return - . parseTimeOrError False defaultTimeLocale "%Y-%m-%dT%H:%M:%S.000Z" - . unpack - . decodeUtf8 - -dropTime :: UTCTime -> UTCTime -dropTime = set TL.utctDayTime $ secondsToDiffTime 0 - -updateDailyCost :: Map UTCTime Double -> Cost -> Map UTCTime Double -updateDailyCost db cost = insertWith (+) - (dropTime $ usageStartDate cost) - (unblendedCost cost) - db + def = Options 15 1.0 Nothing data Cost = Cost { usageStartDate :: UTCTime @@ -70,77 +56,99 @@ <*> m .: "line_item_usage_end_date" <*> m .: "line_item_unblended_cost" -extractCostData :: LBS.ByteString -> Vector Cost -extractCostData = either (error . ("could not parse csv: " <>)) - snd - . decodeByName - -startOfMonth :: UTCTime -> UTCTime -startOfMonth = dropTime - . over TL.utctDay - ((\(y,m,_) -> fromGregorian y m 1) . toGregorian) +instance FromField UTCTime where + parseField = return + . parseTimeOrError False defaultTimeLocale "%Y-%m-%dT%H:%M:%S.000Z" + . unpack + . decodeUtf8 -- | Print the costs to the terminal printCosts :: Options -> Text -> Text -> Text -> IO () printCosts options bucketName pathPrefix costReportName = - do startDate <- xDaysAgo (fromInteger (numberOfDays options)) - today <- getCurrentTime - awsResults <- mapM (getCostsFromAWS bucketName - pathPrefix - costReportName) - $ dropDuplicates $ startOfMonth <$> [startDate, today] - layoutTable $ filterWithKey (\k _ -> k > startDate) - $ foldl updateDailyCost Map.empty $ concat awsResults - where dropDuplicates = Set.toList . Set.fromList + do dateToday <- getCurrentTime + let startTime = xDaysAgo (fromInteger (numberOfDays options)) dateToday + mapM (getCostsFromAWS (csvOutputFile options) + bucketName + pathPrefix + costReportName) + (firstOfMonthBetween startTime dateToday) + >>= layoutTable (threshold options) . filterWithKey (\k _ -> k > startTime) + . foldl updateDailyCost Map.empty + . concat + where xDaysAgo = addUTCTime . (* (-nominalDay)) -xDaysAgo :: NominalDiffTime -> IO UTCTime -xDaysAgo days = addUTCTime (-days * nominalDay) <$> getCurrentTime +layoutTable :: Double -> Map.Map UTCTime Double -> IO () +layoutTable threshold = foldMap (layoutRow threshold) . toAscList -layoutRow :: (UTCTime, Double) -> IO () -layoutRow (a,b) = do putStr $ layoutDate a <> ": " - layoutCost b - putStrLn "" - where layoutDate = formatTime defaultTimeLocale "%d %B" +layoutRow :: Double -> (UTCTime, Double) -> IO () +layoutRow threshold (a,b) = + do putStr $ layoutDate a <> ": " + layoutCost threshold b + putStrLn "" + where layoutDate = formatTime defaultTimeLocale "%d %B" -layoutCost :: Double -> IO () -layoutCost cost = - do setSGR $ pure $ if cost > 0.02 then +layoutCost :: Double -> Double -> IO () +layoutCost threshold cost = + do setSGR $ pure $ if cost > threshold then SetColor Foreground Vivid Red else SetColor Foreground Dull Green putStr $ showFFloat (Just 4) cost "" setSGR [Reset] -layoutTable :: Map.Map UTCTime Double -> IO () -layoutTable = foldMap layoutRow . toAscList +getCostsFromAWS :: Maybe Text -> Text -> Text -> Text -> UTCTime -> IO (Vector Cost) +getCostsFromAWS debugFile bucketName pathPrefix costReportName startTime = runResourceT ( + newEnv discover + >>= (`sendEither` newGetObject (BucketName bucketName) + (ObjectKey fullPath)) + >>= \case + Left e -> do + liftIO $ case e ^? _ServiceError . serviceError_status of + Just status | status == status404 -> + hPutStrLn stderr $ "Got 404 when trying to retrieve " + <> "results for " <> mnthStr + <> " which might be because " + <> "no report exists for this month yet." + _ -> error $ + "Could not retrieve results from: " <> show fullPath + <> "\n" <> show e + return Data.Vector.empty + Right res -> do + rawCsv <- decompress . LBS.fromStrict <$> runConduit ( + res ^. getObjectResponse_body . _ResponseBody .| foldC) + handleJust + (liftIO . (`LBS.writeFile` rawCsv) . unpack) + debugFile + return . extractCostData $ rawCsv + ) + where mnthStr = formatTime defaultTimeLocale "%B" startTime + billingPeriod = formatTime defaultTimeLocale "%_Y-%m" startTime + fullPath = pathPrefix + <> "/" <> costReportName + <> "/data" + <> "/BILLING_PERIOD=" <> pack billingPeriod + <> "/" <> costReportName <> "-00001.csv.gz" + handleJust = maybe (return ()) -debugOutput :: FilePath -debugOutput = "processed-csv-debug.csv" +extractCostData :: LBS.ByteString -> Vector Cost +extractCostData = either (error . ("could not parse csv: " <>)) + snd + . decodeByName -getCostsFromAWS :: Text -> Text -> Text -> UTCTime -> IO (Vector Cost) -getCostsFromAWS bucketName pathPrefix costReportName startTime = - do runResourceT ( - do res' <- newEnv discover - >>= (`sendEither` newGetObject (BucketName bucketName) - (ObjectKey fullPath)) - case res' of - Left e -> do if (statusCode <$> (e ^? _ServiceError . serviceError_status)) == Just 404 then - liftIO $ hPutStrLn stderr $ "Got 404 when trying to retrieve results for month number " <> unpack mnthStr <> " which might be because no report exists for this month yet." - else - liftIO $ hPutStrLn stderr $ - "Could not retrieve: " <> show fullPath <> "\n" <> show e - return Data.Vector.empty - Right res -> do r <- runConduit $ - res ^. getObjectResponse_body . _ResponseBody .| foldC - let rawCsv = decompress . LBS.fromStrict $ r - liftIO $ LBS.writeFile debugOutput rawCsv - return . extractCostData $ rawCsv) - where (yr, mnth, _) = toGregorian $ utctDay startTime - mnthStr = pack $ twoDigitPad $ show mnth - fullPath = pathPrefix - <> "/" <> costReportName - <> "/data" - <> "/BILLING_PERIOD=" <> pack (show yr) <> "-" <> mnthStr - <> "/" <> costReportName <> "-00001.csv.gz" - twoDigitPad s = replicate (2 - length s) '0' ++ s +-- | Given a start and end date, returns the first date of each month +-- spanned by the two dates. +firstOfMonthBetween :: UTCTime -> UTCTime -> [UTCTime] +firstOfMonthBetween start end = takeWhile (<= end) $ iterate nextMonth firstOfMonth + where + (y, m, _) = toGregorian (utctDay start) + firstOfMonth = UTCTime (fromGregorian y m 1) (secondsToDiffTime 0) + nextMonth = over TL.utctDay (addGregorianMonthsClip 1) +updateDailyCost :: Map UTCTime Double -> Cost -> Map UTCTime Double +updateDailyCost db cost = insertWith (+) + (dropTime $ usageStartDate cost) + (unblendedCost cost) + db + +dropTime :: UTCTime -> UTCTime +dropTime = set TL.utctDayTime $ secondsToDiffTime 0