module Stackctl.AWS.Scope
  ( AwsScope (..)
  , awsScopeSpecPatterns
  , awsScopeSpecStackName
  , HasAwsScope (..)
  , fetchAwsScope
  ) where

import Stackctl.Prelude

import qualified Data.Text as T
import Stackctl.AWS
import System.Environment (lookupEnv)
import System.FilePath (joinPath, splitPath)
import System.FilePath.Glob (Pattern, compile, match)

data AwsScope = AwsScope
  { AwsScope -> AccountId
awsAccountId :: AccountId
  , AwsScope -> Text
awsAccountName :: Text
  , AwsScope -> Region
awsRegion :: Region
  }
  deriving stock (AwsScope -> AwsScope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AwsScope -> AwsScope -> Bool
$c/= :: AwsScope -> AwsScope -> Bool
== :: AwsScope -> AwsScope -> Bool
$c== :: AwsScope -> AwsScope -> Bool
Eq, Int -> AwsScope -> ShowS
[AwsScope] -> ShowS
AwsScope -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [AwsScope] -> ShowS
$cshowList :: [AwsScope] -> ShowS
show :: AwsScope -> FilePath
$cshow :: AwsScope -> FilePath
showsPrec :: Int -> AwsScope -> ShowS
$cshowsPrec :: Int -> AwsScope -> ShowS
Show, forall x. Rep AwsScope x -> AwsScope
forall x. AwsScope -> Rep AwsScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AwsScope x -> AwsScope
$cfrom :: forall x. AwsScope -> Rep AwsScope x
Generic)
  deriving anyclass ([AwsScope] -> Encoding
[AwsScope] -> Value
AwsScope -> Encoding
AwsScope -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AwsScope] -> Encoding
$ctoEncodingList :: [AwsScope] -> Encoding
toJSONList :: [AwsScope] -> Value
$ctoJSONList :: [AwsScope] -> Value
toEncoding :: AwsScope -> Encoding
$ctoEncoding :: AwsScope -> Encoding
toJSON :: AwsScope -> Value
$ctoJSON :: AwsScope -> Value
ToJSON)

awsScopeSpecPatterns :: AwsScope -> [Pattern]
awsScopeSpecPatterns :: AwsScope -> [Pattern]
awsScopeSpecPatterns AwsScope {Text
Region
AccountId
awsRegion :: Region
awsAccountName :: Text
awsAccountId :: AccountId
awsRegion :: AwsScope -> Region
awsAccountName :: AwsScope -> Text
awsAccountId :: AwsScope -> AccountId
..} =
  [ FilePath -> Pattern
compile
      forall a b. (a -> b) -> a -> b
$ FilePath
"stacks"
      FilePath -> ShowS
</> Text -> FilePath
unpack (AccountId -> Text
unAccountId AccountId
awsAccountId)
      forall a. Semigroup a => a -> a -> a
<> FilePath
".*"
      FilePath -> ShowS
</> Text -> FilePath
unpack (Region -> Text
fromRegion Region
awsRegion)
      forall a. Semigroup a => a -> a -> a
<> FilePath
"**"
      FilePath -> ShowS
</> FilePath
"*"
      FilePath -> ShowS
<.> FilePath
"yaml"
  , FilePath -> Pattern
compile
      forall a b. (a -> b) -> a -> b
$ FilePath
"stacks"
      FilePath -> ShowS
</> FilePath
"*."
      forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
unpack (AccountId -> Text
unAccountId AccountId
awsAccountId)
      FilePath -> ShowS
</> Text -> FilePath
unpack (Region -> Text
fromRegion Region
awsRegion)
      forall a. Semigroup a => a -> a -> a
<> FilePath
"**"
      FilePath -> ShowS
</> FilePath
"*"
      FilePath -> ShowS
<.> FilePath
"yaml"
  ]

awsScopeSpecStackName :: AwsScope -> FilePath -> Maybe StackName
awsScopeSpecStackName :: AwsScope -> FilePath -> Maybe StackName
awsScopeSpecStackName AwsScope
scope FilePath
path = do
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern -> FilePath -> Bool
`match` FilePath
path) forall a b. (a -> b) -> a -> b
$ AwsScope -> [Pattern]
awsScopeSpecPatterns AwsScope
scope

  -- once we've guarded that the path matches our scope patterns, we can play it
  -- pretty fast and loose with the "parsing" step
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall a b. (a -> b) -> a -> b
$ FilePath
path -- stacks/account/region/x/y.yaml
    forall a b. a -> (a -> b) -> b
& FilePath -> [FilePath]
splitPath -- [stacks/, account/, region/, x/, y.yaml]
    forall a b. a -> (a -> b) -> b
& forall a. Int -> [a] -> [a]
drop Int
3 -- [x, y.yaml]
    forall a b. a -> (a -> b) -> b
& [FilePath] -> FilePath
joinPath -- x/y.yaml
    forall a b. a -> (a -> b) -> b
& ShowS
dropExtension -- x/y
    forall a b. a -> (a -> b) -> b
& FilePath -> Text
pack
    forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
T.replace Text
"/" Text
"-" -- x-y
    forall a b. a -> (a -> b) -> b
& Text -> StackName
StackName

class HasAwsScope env where
  awsScopeL :: Lens' env AwsScope

instance HasAwsScope AwsScope where
  awsScopeL :: Lens' AwsScope AwsScope
awsScopeL = forall a. a -> a
id

fetchAwsScope
  :: (MonadResource m, MonadReader env m, HasAwsEnv env) => m AwsScope
fetchAwsScope :: forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
m AwsScope
fetchAwsScope =
  AccountId -> Text -> Region -> AwsScope
AwsScope
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
m AccountId
awsGetCallerIdentityAccount
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"unknown" FilePath -> Text
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
lookupEnv FilePath
"AWS_PROFILE")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) env.
(MonadResource m, MonadReader env m, HasAwsEnv env) =>
m Region
awsEc2DescribeFirstAvailabilityZoneRegionName