generated from coulomb/repo-seed
Bernd Worsch
f1978c3888
A2 — Compilation fixes: - Remove inline FK constraints from Schema.sql; IHP schema compiler cannot parse them. Add 1744329600-restore-fk-constraints.sql migration to restore referential integrity at the DB level. - Rename `#label` → `#label_` throughout to avoid clash with Haskell built-in. - Fix `hub.id == hid` UUID comparisons to use `toUUID hub.id`. - Replace non-existent `setStatus`/`respondJson` calls with `renderJsonWithStatusCode` throughout Api controllers. - Fix qualified package import for `cryptohash-sha256` in Auth.hs. - Add `CanSelect (Text, Text)` instance in Helper.View. - Refactor HSX inline lambdas to named helper functions in 100+ views (GHC cannot infer types for anonymous functions inside quasi-quoted HSX). - Fix missing imports (IHP.QueryBuilder, IHP.Fetch, Web.Routes, Only, etc.) across helpers and controllers. - Remove duplicate `diffUTCTime` definition in BottleneckDetector. - Change `createEventForHub` return type from `IO ResponseReceived` to `IO ()`. - Seed type-registry vocabulary via 1744502400-seed-type-registries.sql (moved from Schema.sql where IHP does not execute INSERT statements). A3 — Tailwind build pipeline: - Add `tailwindcss` to flake.nix native packages. - Uncomment `tailwind.exec` process in devenv shell config. - Add tailwind/tailwind.config.js (scans Web/View/**/*.hs). - Add tailwind/app.css with @tailwind directives. A4 — Admin user seed: - Add 1744416000-seed-admin-user.sql: inserts admin@inter-hub.local with bcrypt-hashed password admin1234! (cost 10). - Add .env.example documenting all required environment variables and default admin credentials. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
88 lines
3.3 KiB
Haskell
88 lines
3.3 KiB
Haskell
module Web.Controller.Api.V2.Auth where
|
|
|
|
import IHP.Prelude
|
|
import IHP.ControllerPrelude
|
|
import Web.Types
|
|
import Generated.Types
|
|
import Data.Aeson (object, (.=))
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as TE
|
|
import qualified "cryptohash-sha256" Crypto.Hash.SHA256 as SHA256
|
|
import qualified Data.ByteString.Base16 as Base16
|
|
import Network.Wai (requestHeaders, responseLBS)
|
|
|
|
-- | Extract Bearer token from Authorization header and validate it
|
|
-- against the api_keys table. Returns the ApiConsumer on success,
|
|
-- or halts with 401 JSON on failure.
|
|
requireApiConsumer :: (?context :: ControllerContext, ?modelContext :: ModelContext, ?respond :: Respond, ?request :: Request) => IO ApiConsumer
|
|
requireApiConsumer = do
|
|
let authHeader = lookup "Authorization" (requestHeaders ?request)
|
|
let mToken = authHeader >>= \h ->
|
|
let t = cs h :: Text
|
|
in if "Bearer " `T.isPrefixOf` t
|
|
then Just (T.drop 7 t)
|
|
else Nothing
|
|
case mToken of
|
|
Nothing -> unauthorized401
|
|
Just token -> do
|
|
let tokenHash = hashApiKey token
|
|
now <- getCurrentTime
|
|
mKey <- query @ApiKey
|
|
|> filterWhere (#keyHash, tokenHash)
|
|
|> fetchOneOrNothing
|
|
case mKey of
|
|
Nothing -> unauthorized401
|
|
Just apiKey -> do
|
|
when (isJust apiKey.revokedAt) unauthorized401
|
|
when (maybe False (< now) apiKey.expiresAt) do
|
|
respondWithStatus 401 $ object
|
|
[ "error" .= ("Token expired" :: Text)
|
|
, "code" .= ("token_expired" :: Text)
|
|
]
|
|
-- Update last_used_at (fire-and-forget; do not block on failure)
|
|
apiKey |> set #lastUsedAt (Just now) |> updateRecord
|
|
fetch apiKey.apiConsumerId >>= \consumer -> do
|
|
unless consumer.isActive unauthorized401
|
|
pure consumer
|
|
|
|
unauthorized401 :: (?respond :: Respond) => IO a
|
|
unauthorized401 = respondWithStatus 401 $ object
|
|
[ "error" .= ("Unauthorized" :: Text)
|
|
, "code" .= ("invalid_api_key" :: Text)
|
|
]
|
|
|
|
respondWithStatus :: (?respond :: Respond) => Int -> Value -> IO a
|
|
respondWithStatus status body = do
|
|
respondAndExit $ responseLBS
|
|
(toEnum status)
|
|
[("Content-Type", "application/json")]
|
|
(encode body)
|
|
|
|
-- | SHA-256 hex hash of the key (same as stored in key_hash column)
|
|
hashApiKey :: Text -> Text
|
|
hashApiKey key =
|
|
let bytes = TE.encodeUtf8 key
|
|
digest = SHA256.hash bytes
|
|
in TE.decodeUtf8 (Base16.encode digest)
|
|
|
|
-- | Standard paginated response envelope
|
|
paginatedResponse :: ToJSON a => [a] -> Int -> Int -> Int -> Value
|
|
paginatedResponse items page perPage total =
|
|
object
|
|
[ "data" .= items
|
|
, "meta" .= object
|
|
[ "page" .= page
|
|
, "per_page" .= perPage
|
|
, "total" .= total
|
|
]
|
|
]
|
|
|
|
-- | Parse page / per_page query params with sensible defaults
|
|
getPageParams :: (?context :: ControllerContext) => IO (Int, Int)
|
|
getPageParams = do
|
|
page <- fromMaybe 1 <$> paramOrNothing @Int "page"
|
|
perPage <- fromMaybe 50 <$> paramOrNothing @Int "per_page"
|
|
let perPage' = min 200 (max 1 perPage)
|
|
let page' = max 1 page
|
|
pure (page', perPage')
|