generated from coulomb/repo-seed
tegwick
4ebc04e1f4
Some checks failed
Build and Deploy / build-push-deploy (push) Has been cancelled
113 lines
3.5 KiB
Haskell
113 lines
3.5 KiB
Haskell
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" -> createHub
|
|
_ -> respondWithStatus 405 $ object ["error" .= ("Method not allowed" :: Text)]
|
|
|
|
action ApiV2ShowHubAction { hubId } = do
|
|
_consumer <- requireApiConsumer
|
|
hub <- fetch hubId
|
|
renderJson (hubToJson hub)
|
|
|
|
action ApiV2CreateHubAction = createHub
|
|
|
|
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
|
|
|
|
createHub :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ()
|
|
createHub = do
|
|
_consumer <- requireApiConsumer
|
|
let slug = paramOrNothing @Text "slug"
|
|
name = paramOrNothing @Text "name"
|
|
domain = paramOrNothing @Text "domain"
|
|
kind = fromMaybe "domain" (nonEmptyText =<< paramOrNothing @Text "hubKind")
|
|
|
|
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
|
|
]
|
|
|
|
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
|
|
|> 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
|
|
, "createdAt" .= hub.createdAt
|
|
]
|
|
|
|
validCreateHubKinds :: [Text]
|
|
validCreateHubKinds = ["domain", "shared"]
|
|
|
|
validCreateHubKind :: Text -> Bool
|
|
validCreateHubKind kind = kind `elem` validCreateHubKinds
|
|
|
|
missingRequiredFields :: [(Text, Maybe Text)] -> [Text]
|
|
missingRequiredFields fields =
|
|
[ name | (name, value) <- fields, maybe True (== "") value ]
|
|
|
|
nonEmptyText :: Text -> Maybe Text
|
|
nonEmptyText "" = Nothing
|
|
nonEmptyText value = Just value
|