module MiniReleaseRequest.Request where import Data.List (find, intercalate) data Environment = Staging | Production deriving (Eq, Show) data Strategy = Rolling | Canary Int deriving (Eq, Show) data ReleaseRequest = ReleaseRequest { serviceName :: String , environment :: Environment , replicaCount :: Int , strategy :: Strategy , owner :: Maybe String } deriving (Eq, Show) parseAssignment :: String -> Either String (String, String) parseAssignment input = case break (== '=') input of ([], _) -> Left ("expected key=value, got: " ++ input) (_, "") -> Left ("expected key=value, got: " ++ input) (key, '=' : value) | null value -> Left ("missing value for key: " ++ key) | otherwise -> Right (key, value) _ -> Left ("expected key=value, got: " ++ input) lookupOptional :: String -> [(String, String)] -> Maybe String lookupOptional key assignments = snd <$> find ((== key) . fst) assignments lookupRequired :: String -> [(String, String)] -> Either String String lookupRequired key assignments = case lookupOptional key assignments of Just value -> Right value Nothing -> Left ("missing required field: " ++ key) parseEnvironment :: String -> Either String Environment parseEnvironment "staging" = Right Staging parseEnvironment "production" = Right Production parseEnvironment other = Left ("unknown environment: " ++ other) parseReplicaCount :: String -> Either String Int parseReplicaCount rawValue = case reads rawValue of [(parsedValue, "")] | parsedValue > 0 -> Right parsedValue | otherwise -> Left "replicas must be greater than zero" _ -> Left ("invalid replica count: " ++ rawValue) resolveStrategy :: [(String, String)] -> Either String Strategy resolveStrategy assignments = do strategyName <- lookupRequired "strategy" assignments case strategyName of "rolling" -> case lookupOptional "canary" assignments of Nothing -> Right Rolling Just _ -> Left "rolling strategy does not accept a canary percentage" "canary" -> do rawPercent <- lookupRequired "canary" assignments percent <- case reads rawPercent of [(parsedPercent, "")] | parsedPercent >= 1 && parsedPercent <= 50 -> Right parsedPercent | otherwise -> Left "canary percentage must be between 1 and 50" _ -> Left ("invalid canary percentage: " ++ rawPercent) Right (Canary percent) other -> Left ("unknown strategy: " ++ other) buildReleaseRequest :: [String] -> Either String ReleaseRequest buildReleaseRequest rawAssignments = do assignments <- traverse parseAssignment rawAssignments releaseService <- lookupRequired "service" assignments releaseEnvironment <- lookupRequired "env" assignments >>= parseEnvironment releaseReplicaCount <- lookupRequired "replicas" assignments >>= parseReplicaCount releaseStrategy <- resolveStrategy assignments let releaseOwner = lookupOptional "owner" assignments pure ReleaseRequest { serviceName = releaseService , environment = releaseEnvironment , replicaCount = releaseReplicaCount , strategy = releaseStrategy , owner = releaseOwner } renderReleaseRequest :: ReleaseRequest -> String renderReleaseRequest request = intercalate ", " [ "service " ++ serviceName request , "env " ++ renderEnvironment (environment request) , "replicas " ++ show (replicaCount request) , "strategy " ++ renderStrategy (strategy request) , renderOwner (owner request) ] renderEnvironment :: Environment -> String renderEnvironment Staging = "staging" renderEnvironment Production = "production" renderStrategy :: Strategy -> String renderStrategy Rolling = "rolling" renderStrategy (Canary percent) = "canary " ++ show percent ++ "%" renderOwner :: Maybe String -> String renderOwner Nothing = "owner unassigned" renderOwner (Just assignedOwner) = "owner " ++ assignedOwner