nix-playgraound/23-haskell-maybe-either/src/MiniReleaseRequest/Request.hs

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