{-# LANGUAGE NamedFieldPuns #-}

module Stackctl.StackSpecPath
  ( StackSpecPath

    -- * Fields
  , stackSpecPathAccountId
  , stackSpecPathAccountName
  , stackSpecPathRegion
  , stackSpecPathStackName
  , stackSpecPathBasePath
  , stackSpecPathFilePath

    -- * Construction
  , stackSpecPath
  , stackSpecPathFromFilePath
  ) where

import Stackctl.Prelude

import Data.Char (isDigit)
import qualified Data.Text as T
import Stackctl.AWS
import Stackctl.AWS.Scope
import System.FilePath (joinPath, splitDirectories)

data StackSpecPath = StackSpecPath
  { StackSpecPath -> AwsScope
sspAwsScope :: AwsScope
  , StackSpecPath -> String
sspAccountPathPart :: FilePath
  , StackSpecPath -> StackName
sspStackName :: StackName
  , StackSpecPath -> String
sspPath :: FilePath
  }
  deriving stock (StackSpecPath -> StackSpecPath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackSpecPath -> StackSpecPath -> Bool
$c/= :: StackSpecPath -> StackSpecPath -> Bool
== :: StackSpecPath -> StackSpecPath -> Bool
$c== :: StackSpecPath -> StackSpecPath -> Bool
Eq, Int -> StackSpecPath -> ShowS
[StackSpecPath] -> ShowS
StackSpecPath -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackSpecPath] -> ShowS
$cshowList :: [StackSpecPath] -> ShowS
show :: StackSpecPath -> String
$cshow :: StackSpecPath -> String
showsPrec :: Int -> StackSpecPath -> ShowS
$cshowsPrec :: Int -> StackSpecPath -> ShowS
Show)

stackSpecPath :: AwsScope -> StackName -> FilePath -> StackSpecPath
stackSpecPath :: AwsScope -> StackName -> String -> StackSpecPath
stackSpecPath sspAwsScope :: AwsScope
sspAwsScope@AwsScope {Text
Region
AccountId
awsRegion :: AwsScope -> Region
awsAccountName :: AwsScope -> Text
awsAccountId :: AwsScope -> AccountId
awsRegion :: Region
awsAccountName :: Text
awsAccountId :: AccountId
..} StackName
sspStackName String
sspPath =
  StackSpecPath
    { AwsScope
sspAwsScope :: AwsScope
sspAwsScope :: AwsScope
sspAwsScope
    , String
sspAccountPathPart :: String
sspAccountPathPart :: String
sspAccountPathPart
    , StackName
sspStackName :: StackName
sspStackName :: StackName
sspStackName
    , String
sspPath :: String
sspPath :: String
sspPath
    }
 where
  sspAccountPathPart :: String
sspAccountPathPart =
    Text -> String
unpack forall a b. (a -> b) -> a -> b
$ AccountId -> Text
unAccountId AccountId
awsAccountId forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
awsAccountName

stackSpecPathAccountId :: StackSpecPath -> AccountId
stackSpecPathAccountId :: StackSpecPath -> AccountId
stackSpecPathAccountId = AwsScope -> AccountId
awsAccountId forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecPath -> AwsScope
sspAwsScope

stackSpecPathAccountName :: StackSpecPath -> Text
stackSpecPathAccountName :: StackSpecPath -> Text
stackSpecPathAccountName = AwsScope -> Text
awsAccountName forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecPath -> AwsScope
sspAwsScope

stackSpecPathAccountPathPart :: StackSpecPath -> FilePath
stackSpecPathAccountPathPart :: StackSpecPath -> String
stackSpecPathAccountPathPart = StackSpecPath -> String
sspAccountPathPart

stackSpecPathRegion :: StackSpecPath -> Region
stackSpecPathRegion :: StackSpecPath -> Region
stackSpecPathRegion = AwsScope -> Region
awsRegion forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSpecPath -> AwsScope
sspAwsScope

stackSpecPathBasePath :: StackSpecPath -> FilePath
stackSpecPathBasePath :: StackSpecPath -> String
stackSpecPathBasePath = StackSpecPath -> String
sspPath

stackSpecPathStackName :: StackSpecPath -> StackName
stackSpecPathStackName :: StackSpecPath -> StackName
stackSpecPathStackName = StackSpecPath -> StackName
sspStackName

-- | Render the (relative) 'StackSpecPath'
stackSpecPathFilePath :: StackSpecPath -> FilePath
stackSpecPathFilePath :: StackSpecPath -> String
stackSpecPathFilePath StackSpecPath
path =
  String
"stacks"
    String -> ShowS
</> StackSpecPath -> String
stackSpecPathAccountPathPart StackSpecPath
path
    String -> ShowS
</> Text -> String
unpack (Region -> Text
fromRegion forall a b. (a -> b) -> a -> b
$ StackSpecPath -> Region
stackSpecPathRegion StackSpecPath
path)
    String -> ShowS
</> StackSpecPath -> String
stackSpecPathBasePath StackSpecPath
path

stackSpecPathFromFilePath
  :: AwsScope
  -> FilePath
  -- ^ Must be relative, @stacks/@
  -> Either String StackSpecPath
stackSpecPathFromFilePath :: AwsScope -> String -> Either String StackSpecPath
stackSpecPathFromFilePath awsScope :: AwsScope
awsScope@AwsScope {Text
Region
AccountId
awsRegion :: Region
awsAccountName :: Text
awsAccountId :: AccountId
awsRegion :: AwsScope -> Region
awsAccountName :: AwsScope -> Text
awsAccountId :: AwsScope -> AccountId
..} String
path =
  case String -> [String]
splitDirectories String
path of
    (String
"stacks" : String
pathAccount : String
pathRegion : [String]
rest) -> do
      (Text
accountName, AccountId
pathAccountId) <- String -> Either String (Text, AccountId)
parseAccountPath String
pathAccount

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AccountId
pathAccountId forall a. Eq a => a -> a -> Bool
== AccountId
awsAccountId)
        forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left
        forall a b. (a -> b) -> a -> b
$ String
"Unexpected account: "
        forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (AccountId -> Text
unAccountId AccountId
pathAccountId)
        forall a. Semigroup a => a -> a -> a
<> String
" != "
        forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (AccountId -> Text
unAccountId AccountId
awsAccountId)

      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> String
unpack (Region -> Text
fromRegion Region
awsRegion) forall a. Eq a => a -> a -> Bool
== String
pathRegion)
        forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left
        forall a b. (a -> b) -> a -> b
$ String
"Unexpected region: "
        forall a. Semigroup a => a -> a -> a
<> String
pathRegion
        forall a. Semigroup a => a -> a -> a
<> String
" != "
        forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack (Region -> Text
fromRegion Region
awsRegion)

      StackName
stackName <-
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left String
"Must end in .yaml") (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StackName
StackName)
          forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripSuffix Text
".yaml"
          forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"-"
          forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Text
pack [String]
rest

      forall a b. b -> Either a b
Right
        forall a b. (a -> b) -> a -> b
$ StackSpecPath
          { sspAwsScope :: AwsScope
sspAwsScope = AwsScope
awsScope {awsAccountName :: Text
awsAccountName = Text
accountName}
          , sspAccountPathPart :: String
sspAccountPathPart = String
pathAccount
          , sspStackName :: StackName
sspStackName = StackName
stackName
          , sspPath :: String
sspPath = [String] -> String
joinPath [String]
rest
          }
    [String]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Path is not stacks/././.: " forall a. Semigroup a => a -> a -> a
<> String
path

-- | Handle @{account-name}.{account-id}@ or @{account-id}.{account-name}@
parseAccountPath :: FilePath -> Either String (Text, AccountId)
parseAccountPath :: String -> Either String (Text, AccountId)
parseAccountPath String
path = case forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> Text -> Text
T.drop Int
1) forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
T.breakOn Text
"." forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
path of
  (Text
a, Text
b) | Text -> Bool
isAccountId Text
a -> forall a b. b -> Either a b
Right (Text
b, Text -> AccountId
AccountId Text
a)
  (Text
a, Text
b) | Text -> Bool
isAccountId Text
b -> forall a b. b -> Either a b
Right (Text
a, Text -> AccountId
AccountId Text
b)
  (Text, Text)
_ ->
    forall a b. a -> Either a b
Left
      forall a b. (a -> b) -> a -> b
$ String
"Path matches neither {account-id}.{account-name}, nor {account-name}.{account-id}: "
      forall a. Semigroup a => a -> a -> a
<> String
path
 where
  isAccountId :: Text -> Bool
isAccountId Text
x = Text -> Int
T.length Text
x forall a. Eq a => a -> a -> Bool
== Int
12 Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
x