Events.hs

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TemplateHaskell       #-}

module Groot.CLI.Service.Events
     ( ServiceEventOpts
     , serviceEventsOpt
     , runServiceEvents
     ) where

import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import           Control.Monad.Trans.Resource
import           Data.Conduit
import           Data.Foldable
import           Data.List.NonEmpty           (NonEmpty ((:|)), intersperse)
import           Data.Semigroup               ((<>))
import           Data.String
import           Data.Typeable
import           Network.AWS
import qualified Network.AWS.ECS              as ECS
import           Options.Applicative

import           Groot.CLI.Common
import           Groot.Console
import           Groot.Core
import           Groot.Core.Events
import           Groot.Data.Text
import           Groot.Types

data ServiceEventOpts = ServiceEventOpts
  { _clusterId    :: Maybe ClusterRef
  , _follow       :: Bool
  , _eventCount   :: Int
  , _serviceNames :: NonEmpty ContainerServiceRef
  } deriving (Eq, Show)

serviceRefArg :: Parser ContainerServiceRef
serviceRefArg = fromString <$> argument str (metavar "SERVICE_NAMES")

serviceRefArgList :: Parser (NonEmpty ContainerServiceRef)
serviceRefArgList = fmap (\x -> (head x) :| (tail x)) (some serviceRefArg)

serviceEventsOpt :: Parser ServiceEventOpts
serviceEventsOpt = ServiceEventOpts
               <$> optional clusterOpt
               <*> switch
                 ( long "follow"
                 <> short 'f'
                 <> help "Follow the trail of events" )
               <*> eventCountOpt
               <*> serviceRefArgList

fetchEvents :: (Typeable mi, MonadResource mi, MonadBaseControl IO mi, MonadCatch mi, MonadConsole mi, MonadIO mo, Foldable f)
            => f ContainerServiceCoords
            -> Bool
            -> Int
            -> GrootM mi (Source mo ECS.ServiceEvent)
fetchEvents coords inf = serviceEventLog (toList coords) inf

runServiceEvents :: ServiceEventOpts -> GrootM IO ()
runServiceEvents (ServiceEventOpts (Just clusterRef) follow lastN serviceRefs) = mapReaderT runResourceT $ do
  eventSource <- fetchEvents (fmap (\x -> ContainerServiceCoords x clusterRef) serviceRefs) follow lastN
  runConduit $ eventSource =$ printEventSink
runServiceEvents (ServiceEventOpts Nothing follow lastN serviceRefs) = mapReaderT runResourceT $ do
  env         <- ask
  putInfo $ "Scanning clusters for services: " <> (fold . intersperse (styleless ", ") $ (styled yellowStyle . toText) <$> serviceRefs)
  coords      <- runAWS env $ findServiceCoords serviceRefs
  eventSource <- fetchEvents coords follow lastN
  runConduit $ eventSource =$ printEventSink