module Test.Sandwich.Contexts.Kubernetes.MinioS3Server.Parsing (
  parseMinioUserAndPassword
  , transformKustomizeChunks
  ) where

import Control.Lens
import Data.Aeson (FromJSON)
import qualified Data.Aeson as A
import Data.Aeson.Lens
import qualified Data.Map as M
import Data.String.Interpolate
import Data.Text as T
import qualified Data.Yaml as Yaml
import Kubernetes.OpenAPI.Model as Kubernetes
import Relude
import Safe (headMay)
import Test.Sandwich.Contexts.Kubernetes.Util.Aeson
import Text.Regex.TDFA


parseMinioUserAndPassword :: Text -> Maybe (Text, Text)
parseMinioUserAndPassword :: Text -> Maybe (Text, Text)
parseMinioUserAndPassword Text
txt = case (Maybe (Text, Text, Text, [Text])
userValues, Maybe (Text, Text, Text, [Text])
passwordValues) of
  (Just (Text
_before, Text
_fullMatch, Text
_after, [Text
user]), Just (Text
_, Text
_, Text
_, [Text
password])) -> (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
user, Text -> Text
forall a. ToText a => a -> Text
toText Text
password)
  (Maybe (Text, Text, Text, [Text]),
 Maybe (Text, Text, Text, [Text]))
_ -> Maybe (Text, Text)
forall a. Maybe a
Nothing
  where
    Maybe (Text, Text, Text, [Text])
userValues :: Maybe (Text, Text, Text, [Text]) = Text
txt Text -> Text -> Maybe (Text, Text, Text, [Text])
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ ([i|MINIO_ROOT_USER="([^"]*)"|] :: Text)
    Maybe (Text, Text, Text, [Text])
passwordValues :: Maybe (Text, Text, Text, [Text]) = Text
txt Text -> Text -> Maybe (Text, Text, Text, [Text])
forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ ([i|MINIO_ROOT_PASSWORD="([^"]*)"|] :: Text)

-- testInput :: Text
-- testInput = [__i|export MINIO_ROOT_USER="WXSTFUWIRS04LMGIMJGV"
--                  export MINIO_ROOT_PASSWORD="NCDCfTaiXcGHq8QRfSaXMAWOXgdrhpGwPSkoYMWf"|]

transformKustomizeChunks :: String -> String -> [Text] -> Either String ((Text, Text), Text)
transformKustomizeChunks :: String -> String -> [Text] -> Either String ((Text, Text), Text)
transformKustomizeChunks String
namespace String
deploymentName [Text]
initialChunks = do
  userAndPassword <- [Text] -> Either String (Text, Text)
getUserAndPassword [Text]
initialChunks

  return (userAndPassword, finalYaml)

  where
    finalYaml :: Text
finalYaml = [Text]
initialChunks
              -- Don't include a kind: Namespace
              [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
Relude.filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
isNamespace)

              -- Set metadata.namespace on all values
              [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text -> Text
setMetaNamespace String
namespace)

              -- Disable TLS
              [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
disableTLS

              -- Set deployment name
              [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text -> Text
setDeploymentNameAndPoolSize String
deploymentName)

              -- Combine everything into multi-document Yaml
              [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"---\n"

getUserAndPassword :: [Text] -> Either String (Text, Text)
getUserAndPassword :: [Text] -> Either String (Text, Text)
getUserAndPassword [Text]
chunks = case [(Text, Text)] -> Maybe (Text, Text)
forall a. [a] -> Maybe a
headMay ((Text -> Maybe (Text, Text)) -> [Text] -> [(Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe (Text, Text)
getUserAndPassword' [Text]
chunks) of
  Maybe (Text, Text)
Nothing -> String -> Either String (Text, Text)
forall a b. a -> Either a b
Left String
"Couldn't find user/password YAML."
  Just (Text, Text)
x -> (Text, Text) -> Either String (Text, Text)
forall a b. b -> Either a b
Right (Text, Text)
x
  where
    getUserAndPassword' :: Text -> Maybe (Text, Text)
    getUserAndPassword' :: Text -> Maybe (Text, Text)
getUserAndPassword' (Text -> Either ParseException V1Secret
forall a. FromJSON a => Text -> Either ParseException a
decode -> Right (V1Secret {v1SecretMetadata :: V1Secret -> Maybe V1ObjectMeta
v1SecretMetadata=(Just (V1ObjectMeta {v1ObjectMetaName :: V1ObjectMeta -> Maybe Text
v1ObjectMetaName=(Just Text
"storage-configuration")}))
                                                   , v1SecretStringData :: V1Secret -> Maybe (Map String Text)
v1SecretStringData=(Just (String -> Map String Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
"config.env" -> Just Text
t))
                                                   }))
      = Text -> Maybe (Text, Text)
parseMinioUserAndPassword Text
t
    getUserAndPassword' Text
_ = Maybe (Text, Text)
forall a. Maybe a
Nothing

isNamespace :: Text -> Bool
isNamespace :: Text -> Bool
isNamespace (Text -> Either ParseException Value
forall a. FromJSON a => Text -> Either ParseException a
decode -> Right (A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"kind" -> Just (A.String Text
"Namespace")))) = Bool
True
isNamespace Text
_ = Bool
False

setMetaNamespace :: String -> Text -> Text
setMetaNamespace :: String -> Text -> Text
setMetaNamespace String
namespace (Text -> Either ParseException Value
forall a. FromJSON a => Text -> Either ParseException a
decode -> Right (A.Object obj1 :: Object
obj1@(Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"metadata" -> Just (A.Object obj2 :: Object
obj2@(Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"namespace" -> Just (A.String Text
_)))))) =
  ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode Value
obj1')
  where
    obj1' :: A.Value
    obj1' :: Value
obj1' = Object -> Value
A.Object (Text -> Value -> Object -> Object
forall v. Text -> v -> KeyMap v -> KeyMap v
aesonInsert Text
"metadata" Value
obj2' Object
obj1)

    obj2' :: A.Value
    obj2' :: Value
obj2' = Object -> Value
A.Object (Text -> Value -> Object -> Object
forall v. Text -> v -> KeyMap v -> KeyMap v
aesonInsert Text
"namespace" (Text -> Value
A.String (String -> Text
forall a. ToText a => a -> Text
toText String
namespace)) Object
obj2)
setMetaNamespace String
_ Text
t = Text
t

-- Do the steps to disable TLS in the tenant CRD.
-- See https://min.io/docs/minio/kubernetes/upstream/reference/operator-crd.html#tenantspec
disableTLS :: Text -> Text
disableTLS :: Text -> Text
disableTLS (Text -> Either ParseException Value
forall a. FromJSON a => Text -> Either ParseException a
decode -> Right x :: Value
x@(A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"kind" -> Just (A.String Text
"Tenant")))) = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode Value
x')
  where
    x' :: Value
x' = Value
x
       Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& ASetter Value Value (IxValue Object) Value
-> Value -> Value -> Value
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Object -> Identity Object) -> Value -> Identity Value
forall t. AsValue t => Prism' t Object
Prism' Value Object
_Object ((Object -> Identity Object) -> Value -> Identity Value)
-> ((IxValue Object -> Identity Value)
    -> Object -> Identity Object)
-> ASetter Value Value (IxValue Object) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index Object
"spec" ((IxValue Object -> Identity (IxValue Object))
 -> Object -> Identity Object)
-> ((IxValue Object -> Identity Value)
    -> IxValue Object -> Identity (IxValue Object))
-> (IxValue Object -> Identity Value)
-> Object
-> Identity Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Identity Object)
-> IxValue Object -> Identity (IxValue Object)
forall t. AsValue t => Prism' t Object
Prism' (IxValue Object) Object
_Object ((Object -> Identity Object)
 -> IxValue Object -> Identity (IxValue Object))
-> ((IxValue Object -> Identity Value)
    -> Object -> Identity Object)
-> (IxValue Object -> Identity Value)
-> IxValue Object
-> Identity (IxValue Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index Object
"requestAutoCert") (Bool -> Value
A.Bool Bool
False)
       Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& ASetter
  Value Value (Maybe (IxValue Object)) (Maybe (IxValue Object))
-> Maybe (IxValue Object) -> Value -> Value
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Object -> Identity Object) -> Value -> Identity Value
forall t. AsValue t => Prism' t Object
Prism' Value Object
_Object ((Object -> Identity Object) -> Value -> Identity Value)
-> ((Maybe (IxValue Object) -> Identity (Maybe (IxValue Object)))
    -> Object -> Identity Object)
-> ASetter
     Value Value (Maybe (IxValue Object)) (Maybe (IxValue Object))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index Object
"spec" ((IxValue Object -> Identity (IxValue Object))
 -> Object -> Identity Object)
-> ((Maybe (IxValue Object) -> Identity (Maybe (IxValue Object)))
    -> IxValue Object -> Identity (IxValue Object))
-> (Maybe (IxValue Object) -> Identity (Maybe (IxValue Object)))
-> Object
-> Identity Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Identity Object)
-> IxValue Object -> Identity (IxValue Object)
forall t. AsValue t => Prism' t Object
Prism' (IxValue Object) Object
_Object ((Object -> Identity Object)
 -> IxValue Object -> Identity (IxValue Object))
-> ((Maybe (IxValue Object) -> Identity (Maybe (IxValue Object)))
    -> Object -> Identity Object)
-> (Maybe (IxValue Object) -> Identity (Maybe (IxValue Object)))
-> IxValue Object
-> Identity (IxValue Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Lens' Object (Maybe (IxValue Object))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Key
Index Object
"externalCertSecret") Maybe (IxValue Object)
forall a. Maybe a
Nothing
disableTLS Text
t = Text
t

setDeploymentNameAndPoolSize :: String -> Text -> Text
setDeploymentNameAndPoolSize :: String -> Text -> Text
setDeploymentNameAndPoolSize String
deploymentName (Text -> Either ParseException Value
forall a. FromJSON a => Text -> Either ParseException a
decode -> Right x :: Value
x@(A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"kind" -> Just (A.String Text
"Tenant")))) = ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (Value -> ByteString
forall a. ToJSON a => a -> ByteString
Yaml.encode Value
x')
  where
    x' :: Value
x' = Value
x
       Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& ASetter Value Value (IxValue Object) Value
-> Value -> Value -> Value
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Object -> Identity Object) -> Value -> Identity Value
forall t. AsValue t => Prism' t Object
Prism' Value Object
_Object ((Object -> Identity Object) -> Value -> Identity Value)
-> ((IxValue Object -> Identity Value)
    -> Object -> Identity Object)
-> ASetter Value Value (IxValue Object) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index Object
"metadata" ((IxValue Object -> Identity (IxValue Object))
 -> Object -> Identity Object)
-> ((IxValue Object -> Identity Value)
    -> IxValue Object -> Identity (IxValue Object))
-> (IxValue Object -> Identity Value)
-> Object
-> Identity Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Identity Object)
-> IxValue Object -> Identity (IxValue Object)
forall t. AsValue t => Prism' t Object
Prism' (IxValue Object) Object
_Object ((Object -> Identity Object)
 -> IxValue Object -> Identity (IxValue Object))
-> ((IxValue Object -> Identity Value)
    -> Object -> Identity Object)
-> (IxValue Object -> Identity Value)
-> IxValue Object
-> Identity (IxValue Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index Object
"name") (Text -> Value
A.String (String -> Text
forall a. ToText a => a -> Text
toText String
deploymentName))
       Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& ASetter Value Value (IxValue Object) Value
-> Value -> Value -> Value
forall s t a b. ASetter s t a b -> b -> s -> t
set ((Object -> Identity Object) -> Value -> Identity Value
forall t. AsValue t => Prism' t Object
Prism' Value Object
_Object ((Object -> Identity Object) -> Value -> Identity Value)
-> ((IxValue Object -> Identity Value)
    -> Object -> Identity Object)
-> ASetter Value Value (IxValue Object) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index Object
"spec" ((IxValue Object -> Identity (IxValue Object))
 -> Object -> Identity Object)
-> ((IxValue Object -> Identity Value)
    -> IxValue Object -> Identity (IxValue Object))
-> (IxValue Object -> Identity Value)
-> Object
-> Identity Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Identity Object)
-> IxValue Object -> Identity (IxValue Object)
forall t. AsValue t => Prism' t Object
Prism' (IxValue Object) Object
_Object ((Object -> Identity Object)
 -> IxValue Object -> Identity (IxValue Object))
-> ((IxValue Object -> Identity Value)
    -> Object -> Identity Object)
-> (IxValue Object -> Identity Value)
-> IxValue Object
-> Identity (IxValue Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index Object
"pools" ((IxValue Object -> Identity (IxValue Object))
 -> Object -> Identity Object)
-> ((IxValue Object -> Identity Value)
    -> IxValue Object -> Identity (IxValue Object))
-> (IxValue Object -> Identity Value)
-> Object
-> Identity Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> Identity (Vector Value))
-> IxValue Object -> Identity (IxValue Object)
forall t. AsValue t => Prism' t (Vector Value)
Prism' (IxValue Object) (Vector Value)
_Array ((Vector Value -> Identity (Vector Value))
 -> IxValue Object -> Identity (IxValue Object))
-> ((IxValue Object -> Identity Value)
    -> Vector Value -> Identity (Vector Value))
-> (IxValue Object -> Identity Value)
-> IxValue Object
-> Identity (IxValue Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Vector Value)
-> Traversal' (Vector Value) (IxValue (Vector Value))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Int
Index (Vector Value)
0 ((IxValue (Vector Value) -> Identity (IxValue (Vector Value)))
 -> Vector Value -> Identity (Vector Value))
-> ((IxValue Object -> Identity Value)
    -> IxValue (Vector Value) -> Identity (IxValue (Vector Value)))
-> (IxValue Object -> Identity Value)
-> Vector Value
-> Identity (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Identity Object)
-> IxValue (Vector Value) -> Identity (IxValue (Vector Value))
forall t. AsValue t => Prism' t Object
Prism' (IxValue (Vector Value)) Object
_Object ((Object -> Identity Object)
 -> IxValue (Vector Value) -> Identity (IxValue (Vector Value)))
-> ((IxValue Object -> Identity Value)
    -> Object -> Identity Object)
-> (IxValue Object -> Identity Value)
-> IxValue (Vector Value)
-> Identity (IxValue (Vector Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Object -> Traversal' Object (IxValue Object)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Key
Index Object
"servers") (Scientific -> Value
A.Number Scientific
1)
setDeploymentNameAndPoolSize String
_ Text
t = Text
t

decode :: FromJSON a => Text -> Either Yaml.ParseException a
decode :: forall a. FromJSON a => Text -> Either ParseException a
decode = ByteString -> Either ParseException a
forall a. FromJSON a => ByteString -> Either ParseException a
Yaml.decodeEither' (ByteString -> Either ParseException a)
-> (Text -> ByteString) -> Text -> Either ParseException a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8