module Web.Controller.Api.V2.Hubs where

import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (Value, object, (.=))
import Network.Wai (requestMethod)
import Web.Controller.Api.V2.Auth
    ( requireApiConsumer, paginatedResponse, getPageParams
    , respondWithStatus )

instance Controller ApiV2HubsController where

    action ApiV2IndexHubsAction = do
        case requestMethod ?request of
            "GET"  -> listHubs
            "POST" -> createApiHub
            _      -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]

    action ApiV2ShowHubAction { hubId } = do
        _consumer <- requireApiConsumer
        hub <- fetch hubId
        renderJson (hubToJson hub)

    action ApiV2CreateHubAction = createApiHub

listHubs :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
listHubs = do
    _consumer <- requireApiConsumer
    (page, perPage) <- getPageParams
    let pageOffset = (page - 1) * perPage
    total <- query @Hub |> fetchCount
    hubs <- query @Hub
        |> orderByAsc #name
        |> limit perPage
        |> offset pageOffset
        |> fetch
    renderJson $ paginatedResponse (map hubToJson hubs) page perPage total

createApiHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createApiHub = do
    _consumer <- requireApiConsumer
    let slug   = paramOrNothing @Text "slug"
        name   = paramOrNothing @Text "name"
        domain = paramOrNothing @Text "domain"
        kind   = fromMaybe "domain" (nonEmptyText =<< paramOrNothing @Text "hubKind")
        hubFamily = nonEmptyText =<< paramOrNothing @Text "hubFamily"
        vsmFunction = nonEmptyText =<< paramOrNothing @Text "vsmFunction"
        vsmSystem = nonEmptyText =<< paramOrNothing @Text "vsmSystem"

    let missing = missingRequiredFields
            [ ("slug", slug)
            , ("name", name)
            , ("domain", domain)
            ]
    unless (null missing) do
        respondWithStatus 422 $ object
            [ "error"   .= ("Missing required fields" :: Text)
            , "missing" .= missing
            ]

    unless (validCreateHubKind kind) do
        respondWithStatus 422 $ object
            [ "error" .= ("Unsupported hubKind" :: Text)
            , "code"  .= ("unsupported_hub_kind" :: Text)
            , "value" .= kind
            , "valid" .= validCreateHubKinds
            ]

    unless (validVsmMetadata hubFamily vsmFunction vsmSystem) do
        respondWithStatus 422 $ object
            [ "error" .= ("Invalid VSM hub metadata" :: Text)
            , "code"  .= ("invalid_vsm_metadata" :: Text)
            , "hint"  .= ("Use no VSM fields, or set hubFamily=vsm with vsmFunction and vsmSystem." :: Text)
            , "validVsmSystems" .= validVsmSystems
            ]

    let Just slugText   = slug
        Just nameText   = name
        Just domainText = domain

    existing <- query @Hub
        |> filterWhere (#slug, slugText)
        |> fetchOneOrNothing
    when (isJust existing) do
        respondWithStatus 422 $ object
            [ "error" .= ("Hub slug already exists" :: Text)
            , "code"  .= ("duplicate_hub_slug" :: Text)
            , "value" .= slugText
            ]

    hub <- newRecord @Hub
        |> set #slug slugText
        |> set #name nameText
        |> set #domain domainText
        |> set #hubKind kind
        |> set #hubFamily hubFamily
        |> set #vsmFunction vsmFunction
        |> set #vsmSystem vsmSystem
        |> createRecord
    respondWithStatus 201 (hubToJson hub)

hubToJson :: Hub -> Value
hubToJson hub = object
    [ "id"        .= hub.id
    , "slug"      .= hub.slug
    , "name"      .= hub.name
    , "domain"    .= hub.domain
    , "hubKind"   .= hub.hubKind
    , "hubFamily" .= hub.hubFamily
    , "vsmFunction" .= hub.vsmFunction
    , "vsmSystem" .= hub.vsmSystem
    , "createdAt" .= hub.createdAt
    ]

validCreateHubKinds :: [Text]
validCreateHubKinds = ["domain", "shared"]

validCreateHubKind :: Text -> Bool
validCreateHubKind kind = kind `elem` validCreateHubKinds

validVsmSystems :: [Text]
validVsmSystems = ["1", "2", "3", "3*", "4", "5", "environment"]

validVsmSystem :: Text -> Bool
validVsmSystem systemName = systemName `elem` validVsmSystems

validVsmMetadata :: Maybe Text -> Maybe Text -> Maybe Text -> Bool
validVsmMetadata Nothing Nothing Nothing = True
validVsmMetadata (Just "vsm") (Just functionName) (Just systemName) =
    functionName /= "" && validVsmSystem systemName
validVsmMetadata _ _ _ = False

missingRequiredFields :: [(Text, Maybe Text)] -> [Text]
missingRequiredFields fields =
    [ name | (name, value) <- fields, maybe True (== "") value ]

nonEmptyText :: Text -> Maybe Text
nonEmptyText "" = Nothing
nonEmptyText value = Just value