{-|
Description : For printing AWS account costs to the terminal
Copyright   : (c) Daniel Rolls, 2024
License     : GPL-2 only

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

import Prelude hiding (concat)
import Amazonka.Data.Body (_ResponseBody)
import Amazonka.S3.GetObject (newGetObject, getObjectResponse_body)
import Amazonka.S3.Internal (BucketName(..), ObjectKey(..))
import Amazonka (_ServiceError, discover, newEnv, serviceError_status, sendEither)
import Codec.Compression.GZip (decompress)
import Conduit ((.|), foldC, liftIO, runConduit, runResourceT)
import Control.Lens ((^.), (^?), over, set)
import qualified Data.ByteString.Lazy as LBS (ByteString, fromStrict, writeFile)
import Data.Csv (FromField, FromNamedRecord, (.:), decodeByName, parseField, parseNamedRecord)
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.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 Numeric (showFFloat)
import System.Console.ANSI (Color(Green, Red), ColorIntensity(Dull, Vivid), ConsoleLayer(Foreground), SGR(Reset, SetColor), setSGR)
import System.IO (hPutStrLn, stderr)


-- | Optional arguments to pass to @printCosts@
data Options = Options {
  Options -> Integer
numberOfDays :: Integer -- ^ Number of days to show results for
}

instance Default Options where
    def :: Options
def = Integer -> Options
Options Integer
15

instance FromField UTCTime where
    parseField :: StrictByteString -> Parser UTCTime
parseField = UTCTime -> Parser UTCTime
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return
               (UTCTime -> Parser UTCTime)
-> (StrictByteString -> UTCTime)
-> StrictByteString
-> Parser UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> UTCTime
forall t.
ParseTime t =>
Bool -> TimeLocale -> String -> String -> t
parseTimeOrError Bool
False TimeLocale
defaultTimeLocale String
"%Y-%m-%dT%H:%M:%S.000Z"
               (String -> UTCTime)
-> (StrictByteString -> String) -> StrictByteString -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
               (Text -> String)
-> (StrictByteString -> Text) -> StrictByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Text
decodeUtf8

dropTime :: UTCTime -> UTCTime
dropTime :: UTCTime -> UTCTime
dropTime = ASetter UTCTime UTCTime DiffTime DiffTime
-> DiffTime -> UTCTime -> UTCTime
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter UTCTime UTCTime DiffTime DiffTime
Lens' UTCTime DiffTime
TL.utctDayTime (DiffTime -> UTCTime -> UTCTime) -> DiffTime -> UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
secondsToDiffTime Integer
0

updateDailyCost :: Map UTCTime Double -> Cost -> Map UTCTime Double
updateDailyCost :: Map UTCTime Double -> Cost -> Map UTCTime Double
updateDailyCost Map UTCTime Double
db Cost
cost = (Double -> Double -> Double)
-> UTCTime -> Double -> Map UTCTime Double -> Map UTCTime Double
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
insertWith Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
                                     (UTCTime -> UTCTime
dropTime (UTCTime -> UTCTime) -> UTCTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Cost -> UTCTime
usageStartDate Cost
cost)
                                     (Cost -> Double
unblendedCost Cost
cost)
                                     Map UTCTime Double
db

data Cost = Cost {
  Cost -> UTCTime
usageStartDate  :: UTCTime
, Cost -> UTCTime
usageEndDate  :: UTCTime
, Cost -> Double
unblendedCost :: Double
} deriving (Int -> Cost -> ShowS
[Cost] -> ShowS
Cost -> String
(Int -> Cost -> ShowS)
-> (Cost -> String) -> ([Cost] -> ShowS) -> Show Cost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cost -> ShowS
showsPrec :: Int -> Cost -> ShowS
$cshow :: Cost -> String
show :: Cost -> String
$cshowList :: [Cost] -> ShowS
showList :: [Cost] -> ShowS
Show, Cost -> Cost -> Bool
(Cost -> Cost -> Bool) -> (Cost -> Cost -> Bool) -> Eq Cost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cost -> Cost -> Bool
== :: Cost -> Cost -> Bool
$c/= :: Cost -> Cost -> Bool
/= :: Cost -> Cost -> Bool
Eq)


instance FromNamedRecord Cost where
    parseNamedRecord :: NamedRecord -> Parser Cost
parseNamedRecord NamedRecord
m = UTCTime -> UTCTime -> Double -> Cost
Cost (UTCTime -> UTCTime -> Double -> Cost)
-> Parser UTCTime -> Parser (UTCTime -> Double -> Cost)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NamedRecord
m NamedRecord -> StrictByteString -> Parser UTCTime
forall a.
FromField a =>
NamedRecord -> StrictByteString -> Parser a
.: StrictByteString
"line_item_usage_start_date"
                              Parser (UTCTime -> Double -> Cost)
-> Parser UTCTime -> Parser (Double -> Cost)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
m NamedRecord -> StrictByteString -> Parser UTCTime
forall a.
FromField a =>
NamedRecord -> StrictByteString -> Parser a
.: StrictByteString
"line_item_usage_end_date"
                              Parser (Double -> Cost) -> Parser Double -> Parser Cost
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> NamedRecord
m NamedRecord -> StrictByteString -> Parser Double
forall a.
FromField a =>
NamedRecord -> StrictByteString -> Parser a
.: StrictByteString
"line_item_unblended_cost"

extractCostData :: LBS.ByteString -> Vector Cost
extractCostData :: ByteString -> Vector Cost
extractCostData = (String -> Vector Cost)
-> ((Header, Vector Cost) -> Vector Cost)
-> Either String (Header, Vector Cost)
-> Vector Cost
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Vector Cost
forall a. HasCallStack => String -> a
error (String -> Vector Cost) -> ShowS -> String -> Vector Cost
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"could not parse csv: " <>))
                         (Header, Vector Cost) -> Vector Cost
forall a b. (a, b) -> b
snd
                  (Either String (Header, Vector Cost) -> Vector Cost)
-> (ByteString -> Either String (Header, Vector Cost))
-> ByteString
-> Vector Cost
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (Header, Vector Cost)
forall a.
FromNamedRecord a =>
ByteString -> Either String (Header, Vector a)
decodeByName

startOfMonth :: UTCTime -> UTCTime
startOfMonth :: UTCTime -> UTCTime
startOfMonth = UTCTime -> UTCTime
dropTime
               (UTCTime -> UTCTime) -> (UTCTime -> UTCTime) -> UTCTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter UTCTime UTCTime Day Day
-> (Day -> Day) -> UTCTime -> UTCTime
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter UTCTime UTCTime Day Day
Lens' UTCTime Day
TL.utctDay
                      ((\(Integer
y,Int
m,Int
_) -> Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
1) ((Integer, Int, Int) -> Day)
-> (Day -> (Integer, Int, Int)) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> (Integer, Int, Int)
toGregorian)

-- | Print the costs to the terminal
printCosts :: Options -> Text -> Text -> Text -> IO ()
printCosts :: Options -> Text -> Text -> Text -> IO ()
printCosts Options
options Text
bucketName Text
pathPrefix Text
costReportName =
    do UTCTime
startDate <- NominalDiffTime -> IO UTCTime
xDaysAgo (Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Options -> Integer
numberOfDays Options
options))
       UTCTime
today <- IO UTCTime
getCurrentTime
       [Vector Cost]
awsResults <- (UTCTime -> IO (Vector Cost)) -> [UTCTime] -> IO [Vector Cost]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text -> Text -> Text -> UTCTime -> IO (Vector Cost)
getCostsFromAWS Text
bucketName
                                           Text
pathPrefix
                                           Text
costReportName)
                          ([UTCTime] -> IO [Vector Cost]) -> [UTCTime] -> IO [Vector Cost]
forall a b. (a -> b) -> a -> b
$ [UTCTime] -> [UTCTime]
dropDuplicates ([UTCTime] -> [UTCTime]) -> [UTCTime] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime
startOfMonth (UTCTime -> UTCTime) -> [UTCTime] -> [UTCTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UTCTime
startDate, UTCTime
today]
       Map UTCTime Double -> IO ()
layoutTable (Map UTCTime Double -> IO ()) -> Map UTCTime Double -> IO ()
forall a b. (a -> b) -> a -> b
$ (UTCTime -> Double -> Bool)
-> Map UTCTime Double -> Map UTCTime Double
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
filterWithKey (\UTCTime
k Double
_ -> UTCTime
k UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
> UTCTime
startDate)
                                   (Map UTCTime Double -> Map UTCTime Double)
-> Map UTCTime Double -> Map UTCTime Double
forall a b. (a -> b) -> a -> b
$ (Map UTCTime Double -> Cost -> Map UTCTime Double)
-> Map UTCTime Double -> Vector Cost -> Map UTCTime Double
forall b a. (b -> a -> b) -> b -> Vector a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Map UTCTime Double -> Cost -> Map UTCTime Double
updateDailyCost Map UTCTime Double
forall k a. Map k a
Map.empty (Vector Cost -> Map UTCTime Double)
-> Vector Cost -> Map UTCTime Double
forall a b. (a -> b) -> a -> b
$ [Vector Cost] -> Vector Cost
forall a. [Vector a] -> Vector a
concat [Vector Cost]
awsResults
    where dropDuplicates :: [UTCTime] -> [UTCTime]
dropDuplicates = Set UTCTime -> [UTCTime]
forall a. Set a -> [a]
Set.toList (Set UTCTime -> [UTCTime])
-> ([UTCTime] -> Set UTCTime) -> [UTCTime] -> [UTCTime]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UTCTime] -> Set UTCTime
forall a. Ord a => [a] -> Set a
Set.fromList

xDaysAgo :: NominalDiffTime -> IO UTCTime
xDaysAgo :: NominalDiffTime -> IO UTCTime
xDaysAgo NominalDiffTime
days = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
days NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
nominalDay) (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime

layoutRow :: (UTCTime, Double) -> IO ()
layoutRow :: (UTCTime, Double) -> IO ()
layoutRow (UTCTime
a,Double
b) = do String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> String
layoutDate UTCTime
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": "
                     Double -> IO ()
layoutCost Double
b
                     String -> IO ()
putStrLn String
""
                  where layoutDate :: UTCTime -> String
layoutDate = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%d %B"

layoutCost :: Double -> IO ()
layoutCost :: Double -> IO ()
layoutCost Double
cost =
  do [SGR] -> IO ()
setSGR ([SGR] -> IO ()) -> [SGR] -> IO ()
forall a b. (a -> b) -> a -> b
$ SGR -> [SGR]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SGR -> [SGR]) -> SGR -> [SGR]
forall a b. (a -> b) -> a -> b
$ if Double
cost Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0.02 then
                       ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red
                     else
                       ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Green
     String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
4) Double
cost String
""
     [SGR] -> IO ()
setSGR [SGR
Reset]

layoutTable :: Map.Map UTCTime Double -> IO ()
layoutTable :: Map UTCTime Double -> IO ()
layoutTable = ((UTCTime, Double) -> IO ()) -> [(UTCTime, Double)] -> IO ()
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (UTCTime, Double) -> IO ()
layoutRow ([(UTCTime, Double)] -> IO ())
-> (Map UTCTime Double -> [(UTCTime, Double)])
-> Map UTCTime Double
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UTCTime Double -> [(UTCTime, Double)]
forall k a. Map k a -> [(k, a)]
toAscList

debugOutput :: FilePath
debugOutput :: String
debugOutput = String
"processed-csv-debug.csv"

getCostsFromAWS :: Text -> Text -> Text -> UTCTime -> IO (Vector Cost)
getCostsFromAWS :: Text -> Text -> Text -> UTCTime -> IO (Vector Cost)
getCostsFromAWS Text
bucketName Text
pathPrefix Text
costReportName UTCTime
startTime =
    do ResourceT IO (Vector Cost) -> IO (Vector Cost)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (
        do Either Error GetObjectResponse
res' <- (EnvNoAuth -> ResourceT IO Env) -> ResourceT IO Env
forall (m :: * -> *). MonadIO m => (EnvNoAuth -> m Env) -> m Env
newEnv EnvNoAuth -> ResourceT IO Env
forall (m :: * -> *) (withAuth :: * -> *).
(MonadCatch m, MonadIO m, Foldable withAuth) =>
Env' withAuth -> m Env
discover
                   ResourceT IO Env
-> (Env -> ResourceT IO (Either Error GetObjectResponse))
-> ResourceT IO (Either Error GetObjectResponse)
forall a b.
ResourceT IO a -> (a -> ResourceT IO b) -> ResourceT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Env
-> GetObject -> ResourceT IO (Either Error (AWSResponse GetObject))
forall (m :: * -> *) a.
(MonadResource m, AWSRequest a, Typeable a,
 Typeable (AWSResponse a)) =>
Env -> a -> m (Either Error (AWSResponse a))
`sendEither` BucketName -> ObjectKey -> GetObject
newGetObject (Text -> BucketName
BucketName Text
bucketName)
                                                  (Text -> ObjectKey
ObjectKey Text
fullPath))
           case Either Error GetObjectResponse
res' of
             Left Error
e -> do if (Status -> Int
statusCode (Status -> Int) -> Maybe Status -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Error
e Error -> Getting (First Status) Error Status -> Maybe Status
forall s a. s -> Getting (First a) s a -> Maybe a
^? (ServiceError -> Const (First Status) ServiceError)
-> Error -> Const (First Status) Error
forall a. AsError a => Prism' a ServiceError
Prism' Error ServiceError
_ServiceError ((ServiceError -> Const (First Status) ServiceError)
 -> Error -> Const (First Status) Error)
-> ((Status -> Const (First Status) Status)
    -> ServiceError -> Const (First Status) ServiceError)
-> Getting (First Status) Error Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Status -> Const (First Status) Status)
-> ServiceError -> Const (First Status) ServiceError
Lens' ServiceError Status
serviceError_status)) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
404 then
                            IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Got 404 when trying to retrieve results for month number " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
mnthStr String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" which might be because no report exists for this month yet."
                          else
                            IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                              String
"Could not retrieve: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
fullPath String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Error -> String
forall a. Show a => a -> String
show Error
e
                          Vector Cost -> ResourceT IO (Vector Cost)
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Cost
forall a. Vector a
Data.Vector.empty
             Right GetObjectResponse
res -> do StrictByteString
r <- ConduitT () Void (ResourceT IO) StrictByteString
-> ResourceT IO StrictByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) StrictByteString
 -> ResourceT IO StrictByteString)
-> ConduitT () Void (ResourceT IO) StrictByteString
-> ResourceT IO StrictByteString
forall a b. (a -> b) -> a -> b
$
                               GetObjectResponse
res GetObjectResponse
-> Getting
     (ConduitT () StrictByteString (ResourceT IO) ())
     GetObjectResponse
     (ConduitT () StrictByteString (ResourceT IO) ())
-> ConduitT () StrictByteString (ResourceT IO) ()
forall s a. s -> Getting a s a -> a
^. (ResponseBody
 -> Const
      (ConduitT () StrictByteString (ResourceT IO) ()) ResponseBody)
-> GetObjectResponse
-> Const
     (ConduitT () StrictByteString (ResourceT IO) ()) GetObjectResponse
Lens' GetObjectResponse ResponseBody
getObjectResponse_body ((ResponseBody
  -> Const
       (ConduitT () StrictByteString (ResourceT IO) ()) ResponseBody)
 -> GetObjectResponse
 -> Const
      (ConduitT () StrictByteString (ResourceT IO) ()) GetObjectResponse)
-> ((ConduitT () StrictByteString (ResourceT IO) ()
     -> Const
          (ConduitT () StrictByteString (ResourceT IO) ())
          (ConduitT () StrictByteString (ResourceT IO) ()))
    -> ResponseBody
    -> Const
         (ConduitT () StrictByteString (ResourceT IO) ()) ResponseBody)
-> Getting
     (ConduitT () StrictByteString (ResourceT IO) ())
     GetObjectResponse
     (ConduitT () StrictByteString (ResourceT IO) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConduitT () StrictByteString (ResourceT IO) ()
 -> Const
      (ConduitT () StrictByteString (ResourceT IO) ())
      (ConduitT () StrictByteString (ResourceT IO) ()))
-> ResponseBody
-> Const
     (ConduitT () StrictByteString (ResourceT IO) ()) ResponseBody
Iso' ResponseBody (ConduitT () StrictByteString (ResourceT IO) ())
_ResponseBody ConduitT () StrictByteString (ResourceT IO) ()
-> ConduitT StrictByteString Void (ResourceT IO) StrictByteString
-> ConduitT () Void (ResourceT IO) StrictByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT StrictByteString Void (ResourceT IO) StrictByteString
forall (m :: * -> *) a o. (Monad m, Monoid a) => ConduitT a o m a
foldC
                             let rawCsv :: ByteString
rawCsv = ByteString -> ByteString
decompress (ByteString -> ByteString)
-> (StrictByteString -> ByteString)
-> StrictByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> ByteString
LBS.fromStrict (StrictByteString -> ByteString) -> StrictByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ StrictByteString
r
                             IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile String
debugOutput ByteString
rawCsv
                             Vector Cost -> ResourceT IO (Vector Cost)
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Cost -> ResourceT IO (Vector Cost))
-> (ByteString -> Vector Cost)
-> ByteString
-> ResourceT IO (Vector Cost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Vector Cost
extractCostData (ByteString -> ResourceT IO (Vector Cost))
-> ByteString -> ResourceT IO (Vector Cost)
forall a b. (a -> b) -> a -> b
$ ByteString
rawCsv)
    where (Integer
yr, Int
mnth, Int
_) = Day -> (Integer, Int, Int)
toGregorian (Day -> (Integer, Int, Int)) -> Day -> (Integer, Int, Int)
forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
startTime
          mnthStr :: Text
mnthStr = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ShowS
twoDigitPad ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
mnth
          fullPath :: Text
fullPath = Text
pathPrefix
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
costReportName
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/data"
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/BILLING_PERIOD=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Integer -> String
forall a. Show a => a -> String
show Integer
yr) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
mnthStr
                   Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
costReportName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-00001.csv.gz"
          twoDigitPad :: ShowS
twoDigitPad String
s = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
'0' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s