Service.hs

{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

module Groot.Compose.Service
     ( ServiceComposeM
     , ServiceComposeCfg(..)
     , RunMode(..)
     , deployService
     , deployServices
     , deleteServices
     , interpretServiceComposeM
     ) where

import           Control.Lens
import           Control.Monad.Morph
import           Control.Monad.Trans.Resource
import           Data.Semigroup               ((<>))
import           Data.Text                    (Text)
import qualified Data.Text                    as T

import           Groot.Compose.Service.AWS    (awsServiceCompose)
import           Groot.Compose.Service.DryRun
import           Groot.Compose.Service.Free
import           Groot.Console
import           Groot.Core
import           Groot.Manifest
import           Groot.Types

data RunMode = DryRun | Unattended
  deriving (Eq, Show, Enum, Ord)

_DryRun :: Prism' RunMode Bool
_DryRun = prism (const DryRun) $ \case
  DryRun -> Right True
  x      -> Left x

_Unattended :: Prism' RunMode Bool
_Unattended = prism (const Unattended) $ \case
  Unattended -> Right True
  x          -> Left x

data ServiceComposeCfg = ServiceComposeCfg
  { composeManifest :: GrootManifest
  , composeCluster  :: ClusterRef
  , composeServices :: [NamedServiceDeployment]
  , composeRunMode  :: Maybe RunMode
  } deriving (Eq, Show)

interpretServiceComposeM :: Text
                         -> ServiceComposeM ()
                         -> ServiceComposeCfg
                         -> GrootM IO ()
interpretServiceComposeM userMsg action cfg =
  let shouldConfirm   = maybe True (isn't _Unattended) (composeRunMode cfg)
      isDryRun        = maybe False (\x -> not $ isn't _DryRun x) (composeRunMode cfg)
      confirmMsg srvs = userMsg <> "\n"
                     <> (T.intercalate "\n" $ T.append "   - " . fst <$> srvs)
                     <> ".\nDo you want to continue? "
      interpret       = if isDryRun then dryRunServiceCompose else awsServiceCompose
      performFor srvs =
        if shouldConfirm
        then askUserToContinue (confirmMsg srvs) $ interpret (composeManifest cfg) action
        else interpret (composeManifest cfg) action
  in hoist runResourceT $ performFor (composeServices cfg)