{-|
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, threshold) 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 Data.Text (Text, pack, unpack)
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 (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)


-- | Optional arguments to pass to @printCosts@
data Options = Options {
  Options -> Integer
numberOfDays :: Integer -- ^ Number of days to show results for
, Options -> Double
threshold :: Double -- ^ Threshold to determine red/green colouring on console
, Options -> Maybe Text
csvOutputFile :: Maybe Text -- ^ Optional file to dump the csv response into
}

instance Default Options where
    def :: Options
def = Integer -> Double -> Maybe Text -> Options
Options Integer
15 Double
1.0 Maybe Text
forall a. Maybe a
Nothing

data Cost = Cost {
  Cost -> UTCTime
usageStartDate  :: UTCTime
, Cost -> UTCTime
usageEndDate  :: UTCTime
, Cost -> Double
unblendedCost :: Double
} deriving (Int -> Cost -> ShowS
[Cost] -> ShowS
Cost -> [Char]
(Int -> Cost -> ShowS)
-> (Cost -> [Char]) -> ([Cost] -> ShowS) -> Show Cost
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cost -> ShowS
showsPrec :: Int -> Cost -> ShowS
$cshow :: Cost -> [Char]
show :: Cost -> [Char]
$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"

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 -> [Char] -> [Char] -> UTCTime
forall t.
ParseTime t =>
Bool -> TimeLocale -> [Char] -> [Char] -> t
parseTimeOrError Bool
False TimeLocale
defaultTimeLocale [Char]
"%Y-%m-%dT%H:%M:%S.000Z"
               ([Char] -> UTCTime)
-> (StrictByteString -> [Char]) -> StrictByteString -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack
               (Text -> [Char])
-> (StrictByteString -> Text) -> StrictByteString -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictByteString -> Text
decodeUtf8

-- | 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
dateToday <- IO UTCTime
getCurrentTime
       let startTime :: UTCTime
startTime = NominalDiffTime -> UTCTime -> UTCTime
xDaysAgo (Integer -> NominalDiffTime
forall a. Num a => Integer -> a
fromInteger (Options -> Integer
numberOfDays Options
options)) UTCTime
dateToday
       (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 (Maybe Text -> Text -> Text -> Text -> UTCTime -> IO (Vector Cost)
getCostsFromAWS (Options -> Maybe Text
csvOutputFile Options
options)
                              Text
bucketName
                              Text
pathPrefix
                              Text
costReportName)
            (UTCTime -> UTCTime -> [UTCTime]
firstOfMonthBetween UTCTime
startTime UTCTime
dateToday)
         IO [Vector Cost] -> ([Vector Cost] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Double -> Map UTCTime Double -> IO ()
layoutTable (Options -> Double
threshold Options
options) (Map UTCTime Double -> IO ())
-> ([Vector Cost] -> Map UTCTime Double) -> [Vector Cost] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
startTime)
                                             (Map UTCTime Double -> Map UTCTime Double)
-> ([Vector Cost] -> Map UTCTime Double)
-> [Vector Cost]
-> Map UTCTime Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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] -> Vector Cost)
-> [Vector Cost]
-> Map UTCTime Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Vector Cost] -> Vector Cost
forall a. [Vector a] -> Vector a
concat
    where xDaysAgo :: NominalDiffTime -> UTCTime -> UTCTime
xDaysAgo = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime -> UTCTime -> UTCTime)
-> (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime
-> UTCTime
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* (-NominalDiffTime
nominalDay))

layoutTable :: Double -> Map.Map UTCTime Double -> IO ()
layoutTable :: Double -> Map UTCTime Double -> IO ()
layoutTable Double
threshold = ((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 (Double -> (UTCTime, Double) -> IO ()
layoutRow Double
threshold) ([(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

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

layoutCost :: Double -> Double -> IO ()
layoutCost :: Double -> Double -> IO ()
layoutCost Double
threshold 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
threshold then
                       ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Vivid Color
Red
                     else
                       ConsoleLayer -> ColorIntensity -> Color -> SGR
SetColor ConsoleLayer
Foreground ColorIntensity
Dull Color
Green
     [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> 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 [Char]
""
     [SGR] -> IO ()
setSGR [SGR
Reset]

getCostsFromAWS :: Maybe Text -> Text -> Text -> Text -> UTCTime -> IO (Vector Cost)
getCostsFromAWS :: Maybe Text -> Text -> Text -> Text -> UTCTime -> IO (Vector Cost)
getCostsFromAWS Maybe Text
debugFile Text
bucketName Text
pathPrefix Text
costReportName UTCTime
startTime = ResourceT IO (Vector Cost) -> IO (Vector Cost)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (
     (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))
     ResourceT IO (Either Error GetObjectResponse)
-> (Either Error GetObjectResponse -> ResourceT IO (Vector Cost))
-> ResourceT IO (Vector Cost)
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
>>= \case
         Left Error
e -> do
             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
$ case 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 of
                 Just Status
status | Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status404 ->
                     Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Got 404 when trying to retrieve "
                                     [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"results for " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
mnthStr
                                     [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" which might be because "
                                     [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"no report exists for this month yet."
                 Maybe Status
_ -> [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
                         [Char]
"Could not retrieve results from: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
fullPath
                      [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Error -> [Char]
forall a. Show a => a -> [Char]
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
             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)
-> ResourceT IO StrictByteString -> ResourceT IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT () Void (ResourceT IO) StrictByteString
-> ResourceT IO StrictByteString
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (
                 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)
             (Text -> ResourceT IO ()) -> Maybe Text -> ResourceT IO ()
forall {a}. (a -> ResourceT IO ()) -> Maybe a -> ResourceT IO ()
handleJust
                 (IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ())
-> (Text -> IO ()) -> Text -> ResourceT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ByteString -> IO ()
`LBS.writeFile` ByteString
rawCsv) ([Char] -> IO ()) -> (Text -> [Char]) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack)
                 Maybe Text
debugFile
             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 mnthStr :: [Char]
mnthStr = TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%B" UTCTime
startTime
          billingPeriod :: [Char]
billingPeriod = TimeLocale -> [Char] -> UTCTime -> [Char]
forall t. FormatTime t => TimeLocale -> [Char] -> t -> [Char]
formatTime TimeLocale
defaultTimeLocale [Char]
"%_Y-%m" UTCTime
startTime
          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
<> [Char] -> Text
pack [Char]
billingPeriod
                  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"
          handleJust :: (a -> ResourceT IO ()) -> Maybe a -> ResourceT IO ()
handleJust = ResourceT IO ()
-> (a -> ResourceT IO ()) -> Maybe a -> ResourceT IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> ResourceT IO ()
forall a. a -> ResourceT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

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

-- | Given a start and end date, returns the first date of each month
-- spanned by the two dates.
firstOfMonthBetween :: UTCTime -> UTCTime -> [UTCTime]
firstOfMonthBetween :: UTCTime -> UTCTime -> [UTCTime]
firstOfMonthBetween UTCTime
start UTCTime
end = (UTCTime -> Bool) -> [UTCTime] -> [UTCTime]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
end) ([UTCTime] -> [UTCTime]) -> [UTCTime] -> [UTCTime]
forall a b. (a -> b) -> a -> b
$ (UTCTime -> UTCTime) -> UTCTime -> [UTCTime]
forall a. (a -> a) -> a -> [a]
iterate UTCTime -> UTCTime
nextMonth UTCTime
firstOfMonth
  where
    (Integer
y, Int
m, Int
_) = Day -> (Integer, Int, Int)
toGregorian (UTCTime -> Day
utctDay UTCTime
start)
    firstOfMonth :: UTCTime
firstOfMonth = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
1) (Integer -> DiffTime
secondsToDiffTime Integer
0)
    nextMonth :: UTCTime -> UTCTime
nextMonth = 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 -> Day -> Day
addGregorianMonthsClip Integer
1)

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

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