module Web.Controller.Api.V2.HubCapabilityManifests where

import Web.Types
import Generated.Types
import IHP.Prelude
import IHP.ControllerPrelude
import Data.Aeson (Value(..), object, toJSON, (.=))
import IHP.ControllerSupport (getHeader, requestBodyJSON)
import Network.Wai (requestMethod)
import Web.Controller.Api.V2.Auth
    ( requireApiConsumer, paginatedResponse, getPageParams
    , respondWithStatus )
import Control.Monad (void)
import Data.Maybe (mapMaybe)
import Data.String (fromString)
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as TE
import qualified Data.UUID as UUID
import qualified Data.Vector as V
import Database.PostgreSQL.Simple (Only(..))

instance Controller ApiV2HubCapabilityManifestsController where

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

    action ApiV2ShowHubCapabilityManifestAction { hubCapabilityManifestId } = do
        case requestMethod ?request of
            "GET"   -> showManifest hubCapabilityManifestId
            "PATCH" -> updateManifest hubCapabilityManifestId
            _       -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]

    action ApiV2CreateHubCapabilityManifestAction = createManifest

    action ApiV2UpdateHubCapabilityManifestAction { hubCapabilityManifestId } =
        updateManifest hubCapabilityManifestId

    action ApiV2ActivateHubCapabilityManifestAction { hubCapabilityManifestId } = do
        when (requestMethod ?request /= "POST") do
            respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
        activateManifest hubCapabilityManifestId

listManifests :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
listManifests = do
    _consumer <- requireApiConsumer
    (page, perPage) <- getPageParams
    let pageOffset = (page - 1) * perPage
        mHubId = paramOrNothing @(Id Hub) "hubId"
        mStatus = paramOrNothing @Text "status"
        baseQ = query @HubCapabilityManifest |> orderByDesc #createdAt
        q1 = case mHubId of
            Just hubId -> baseQ |> filterWhere (#hubId, hubId)
            Nothing    -> baseQ
        q2 = case mStatus of
            Just status -> q1 |> filterWhere (#status, status)
            Nothing     -> q1
    total <- q2 |> fetchCount
    manifests <- q2
        |> limit perPage
        |> offset pageOffset
        |> fetch
    renderJson $ paginatedResponse (map manifestToJson manifests) page perPage total

showManifest :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Id HubCapabilityManifest -> IO ()
showManifest manifestId = do
    _consumer <- requireApiConsumer
    manifest <- fetch manifestId
    renderJson (manifestToJson manifest)

createManifest :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
createManifest = do
    _consumer <- requireApiConsumer
    let hubIdText = paramOrNothing @Text "hubId"
        manifestVersion = fromMaybe "1.0" (nonEmptyText =<< paramOrNothing @Text "manifestVersion")
        capabilityDescription = paramOrNothing @Text "capabilityDescription"
        contact = paramOrNothing @Text "contact"

    when (maybe True (== "") hubIdText) do
        respondWithStatus 422 $ object
            [ "error"   .= ("Missing required fields" :: Text)
            , "missing" .= (["hubId"] :: [Text])
            ]

    let Just rawHubId = hubIdText
    case UUID.fromText rawHubId of
        Nothing -> respondWithStatus 422 $ object
            ["error" .= ("hubId must be a valid UUID" :: Text)]
        Just rawId -> do
            let hubId = Id rawId :: Id Hub
            mHub <- fetchOneOrNothing hubId
            case mHub of
                Nothing -> respondWithStatus 422 $ object ["error" .= ("Hub not found" :: Text)]
                Just _hub -> do
                    existing <- query @HubCapabilityManifest
                        |> filterWhere (#hubId, hubId)
                        |> fetchOneOrNothing
                    when (isJust existing) do
                        respondWithStatus 422 $ object
                            [ "error" .= ("Hub already has a capability manifest" :: Text)
                            , "code"  .= ("manifest_already_exists" :: Text)
                            ]
                    declaredWidgetTypes <- textArrayFieldFromRequestOrEmpty "declaredWidgetTypes"
                    declaredEventTypes <- textArrayFieldFromRequestOrEmpty "declaredEventTypes"
                    declaredAnnotationCategories <- textArrayFieldFromRequestOrEmpty "declaredAnnotationCategories"
                    declaredPolicyScopes <- textArrayFieldFromRequestOrEmpty "declaredPolicyScopes"
                    manifest <- newRecord @HubCapabilityManifest
                        |> set #hubId hubId
                        |> set #manifestVersion manifestVersion
                        |> set #declaredWidgetTypes (toJSON declaredWidgetTypes)
                        |> set #declaredEventTypes (toJSON declaredEventTypes)
                        |> set #declaredAnnotationCategories (toJSON declaredAnnotationCategories)
                        |> set #declaredPolicyScopes (toJSON declaredPolicyScopes)
                        |> set #capabilityDescription capabilityDescription
                        |> set #contact contact
                        |> set #status "draft"
                        |> createRecord
                    respondWithStatus 201 (manifestToJson manifest)

updateManifest :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Id HubCapabilityManifest -> IO ()
updateManifest manifestId = do
    _consumer <- requireApiConsumer
    manifest <- fetch manifestId
    unless (manifest.status == "draft") do
        respondWithStatus 422 $ object
            [ "error" .= ("Active manifests are read-only" :: Text)
            , "code"  .= ("manifest_read_only" :: Text)
            ]

    maybeDeclaredWidgetTypes <- textArrayFieldFromRequest "declaredWidgetTypes"
    maybeDeclaredEventTypes <- textArrayFieldFromRequest "declaredEventTypes"
    maybeDeclaredAnnotationCategories <- textArrayFieldFromRequest "declaredAnnotationCategories"
    maybeDeclaredPolicyScopes <- textArrayFieldFromRequest "declaredPolicyScopes"
    let manifestVersion = fromMaybe manifest.manifestVersion (nonEmptyText =<< paramOrNothing @Text "manifestVersion")
        capabilityDescription = fromMaybe manifest.capabilityDescription (Just <$> paramOrNothing @Text "capabilityDescription")
        contact = fromMaybe manifest.contact (Just <$> paramOrNothing @Text "contact")
        declaredWidgetTypes = maybe manifest.declaredWidgetTypes toJSON maybeDeclaredWidgetTypes
        declaredEventTypes = maybe manifest.declaredEventTypes toJSON maybeDeclaredEventTypes
        declaredAnnotationCategories = maybe manifest.declaredAnnotationCategories toJSON maybeDeclaredAnnotationCategories
        declaredPolicyScopes = maybe manifest.declaredPolicyScopes toJSON maybeDeclaredPolicyScopes

    manifest <- manifest
        |> set #manifestVersion manifestVersion
        |> set #declaredWidgetTypes declaredWidgetTypes
        |> set #declaredEventTypes declaredEventTypes
        |> set #declaredAnnotationCategories declaredAnnotationCategories
        |> set #declaredPolicyScopes declaredPolicyScopes
        |> set #capabilityDescription capabilityDescription
        |> set #contact contact
        |> updateRecord
    renderJson (manifestToJson manifest)

activateManifest :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => Id HubCapabilityManifest -> IO ()
activateManifest manifestId = do
    _consumer <- requireApiConsumer
    manifest <- fetch manifestId
    when (manifest.status == "active") do
        respondWithStatus 200 (manifestToJson manifest)
    when (manifest.status == "retired") do
        respondWithStatus 422 $ object
            [ "error" .= ("Retired manifests cannot be activated" :: Text)
            , "code"  .= ("manifest_retired" :: Text)
            ]

    hub <- fetch manifest.hubId
    let wTypes = jsonArrayTexts manifest.declaredWidgetTypes
        eTypes = jsonArrayTexts manifest.declaredEventTypes
        cats = jsonArrayTexts manifest.declaredAnnotationCategories
        scopes = jsonArrayTexts manifest.declaredPolicyScopes

    conflicts <- fmap concat $ sequence
        [ concat <$> mapM (checkConflict "widget_type_registry" hub.id) wTypes
        , concat <$> mapM (checkConflict "event_type_registry" hub.id) eTypes
        , concat <$> mapM (checkConflict "annotation_category_registry" hub.id) cats
        , concat <$> mapM (checkConflict "policy_scope_registry" hub.id) scopes
        ]
    unless (null conflicts) do
        respondWithStatus 422 $ object
            [ "error"     .= ("Manifest activation blocked by type conflicts" :: Text)
            , "code"      .= ("manifest_type_conflict" :: Text)
            , "conflicts" .= conflicts
            ]

    mapM_ (upsertType "widget_type_registry" hub.id) wTypes
    mapM_ (upsertType "event_type_registry" hub.id) eTypes
    mapM_ (upsertType "annotation_category_registry" hub.id) cats
    mapM_ (upsertType "policy_scope_registry" hub.id) scopes
    now <- getCurrentTime
    manifest <- manifest
        |> set #status "active"
        |> set #activatedAt (Just now)
        |> updateRecord
    renderJson (manifestToJson manifest)

manifestToJson :: HubCapabilityManifest -> Value
manifestToJson manifest = object
    [ "id" .= manifest.id
    , "hubId" .= manifest.hubId
    , "manifestVersion" .= manifest.manifestVersion
    , "declaredWidgetTypes" .= manifest.declaredWidgetTypes
    , "declaredEventTypes" .= manifest.declaredEventTypes
    , "declaredAnnotationCategories" .= manifest.declaredAnnotationCategories
    , "declaredPolicyScopes" .= manifest.declaredPolicyScopes
    , "capabilityDescription" .= manifest.capabilityDescription
    , "contact" .= manifest.contact
    , "status" .= manifest.status
    , "activatedAt" .= manifest.activatedAt
    , "createdAt" .= manifest.createdAt
    , "updatedAt" .= manifest.updatedAt
    ]

textArrayFieldFromRequestOrEmpty :: (?context :: ControllerContext, ?request :: Request) => Text -> IO [Text]
textArrayFieldFromRequestOrEmpty fieldName =
    fromMaybe [] <$> textArrayFieldFromRequest fieldName

textArrayFieldFromRequest :: (?context :: ControllerContext, ?request :: Request) => Text -> IO (Maybe [Text])
textArrayFieldFromRequest fieldName =
    case getHeader "Content-Type" of
        Just contentType | "application/json" `BS.isPrefixOf` contentType -> do
            body <- requestBodyJSON
            pure $ textArrayFieldFromJsonBody fieldName body
        _ ->
            let values = paramList @Text (TE.encodeUtf8 fieldName)
            in pure $ if null values then Nothing else Just values

textArrayFieldFromJsonBody :: Text -> Value -> Maybe [Text]
textArrayFieldFromJsonBody fieldName (Object body) =
    case KM.lookup (K.fromText fieldName) body of
        Just (Array values) -> Just (mapMaybe extractText (V.toList values))
        _ -> Nothing
  where
    extractText (String value) = Just value
    extractText _              = Nothing
textArrayFieldFromJsonBody _ _ = Nothing

jsonArrayTexts :: Value -> [Text]
jsonArrayTexts (Array values) = mapMaybe extractText (V.toList values)
  where
    extractText (String value) = Just value
    extractText _              = Nothing
jsonArrayTexts _ = []

checkConflict ::
    (?modelContext :: ModelContext) =>
    Text -> Id Hub -> Text -> IO [Text]
checkConflict tableName hubId name = do
    rows <- sqlQuery
        (fromString $ cs ("SELECT owner_hub_id FROM " <> tableName <> " WHERE name = ?"))
        (Only name)
    case rows of
        [] -> pure []
        [Only Nothing] -> pure []
        [Only (Just ownerId)] ->
            if ownerId == hubId
                then pure []
                else pure ["Type '" <> name <> "' in " <> tableName <> " is already owned by another hub"]
        _ -> pure []

upsertType ::
    (?modelContext :: ModelContext) =>
    Text -> Id Hub -> Text -> IO ()
upsertType tableName hubId name =
    void $ sqlExec
        (fromString $ cs ("INSERT INTO " <> tableName <> " (name, label, owner_hub_id, status) "
         <> "VALUES (?, ?, ?, 'active') ON CONFLICT (name) DO NOTHING"))
        (name, name, hubId)

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