aws-spend-summary 0.1.0.0 → 0.2.0.0
raw patch · 3 files changed
+117/−88 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ AwsSpendSummary: threshold :: Options -> Double
- AwsSpendSummary: Options :: Integer -> Options
+ AwsSpendSummary: Options :: Integer -> Double -> Maybe Text -> Options
Files
- app/Main.hs +26/−6
- aws-spend-summary.cabal +3/−2
- src/AwsSpendSummary.hs +88/−80
app/Main.hs view
@@ -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)
aws-spend-summary.cabal view
@@ -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
src/AwsSpendSummary.hs view
@@ -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