fix import and clean up error response

This commit is contained in:
Lucy Cifferello
2022-09-07 16:13:15 -06:00
parent d9cd02ab8c
commit a332f557b2
2 changed files with 14 additions and 10 deletions

View File

@@ -55,7 +55,6 @@ import Startlude (
killThread, killThread,
newEmptyMVar, newEmptyMVar,
newMVar, newMVar,
onException,
panic, panic,
print, print,
putMVar, putMVar,
@@ -180,6 +179,7 @@ import Handler.Admin (
deletePkgCategorizeR, deletePkgCategorizeR,
getPkgDeindexR, getPkgDeindexR,
postCategoryR, postCategoryR,
postEosUploadR,
postPkgCategorizeR, postPkgCategorizeR,
postPkgDeindexR, postPkgDeindexR,
postPkgIndexR, postPkgIndexR,

View File

@@ -10,7 +10,6 @@ import Conduit (
sinkFile, sinkFile,
(.|), (.|),
) )
import Control.Exception (ErrorCall (ErrorCall))
import Control.Monad.Reader.Has (ask) import Control.Monad.Reader.Has (ask)
import Control.Monad.Trans.Maybe (MaybeT (..)) import Control.Monad.Trans.Maybe (MaybeT (..))
import Data.Aeson ( import Data.Aeson (
@@ -43,7 +42,8 @@ import Database.Persist (
PersistUniqueWrite (deleteBy, insertUnique, upsert), PersistUniqueWrite (deleteBy, insertUnique, upsert),
entityVal, entityVal,
insert_, insert_,
selectList, (=.) selectList,
(=.),
) )
import Database.Persist.Postgresql (runSqlPoolNoTransaction) import Database.Persist.Postgresql (runSqlPoolNoTransaction)
import Database.Queries (upsertPackageVersion) import Database.Queries (upsertPackageVersion)
@@ -52,8 +52,10 @@ import Foundation (
RegistryCtx (..), RegistryCtx (..),
) )
import Handler.Util ( import Handler.Util (
getHashFromQuery,
getVersionFromQuery,
orThrow, orThrow,
sendResponseText, getVersionFromQuery, getHashFromQuery sendResponseText,
) )
import Lib.PkgRepository ( import Lib.PkgRepository (
PkgRepo (PkgRepo, pkgRepoFileRoot), PkgRepo (PkgRepo, pkgRepoFileRoot),
@@ -69,18 +71,20 @@ import Lib.Types.Emver (Version (..))
import Lib.Types.Manifest (PackageManifest (..)) import Lib.Types.Manifest (PackageManifest (..))
import Model ( import Model (
Category (..), Category (..),
EntityField (EosHashHash),
EosHash (EosHash),
Key (AdminKey, PkgRecordKey, VersionRecordKey), Key (AdminKey, PkgRecordKey, VersionRecordKey),
PkgCategory (PkgCategory), PkgCategory (PkgCategory),
Unique (UniqueName, UniquePkgCategory), Unique (UniqueName, UniquePkgCategory),
Upload (..), Upload (..),
VersionRecord (versionRecordNumber, versionRecordPkgId), VersionRecord (versionRecordNumber, versionRecordPkgId),
unPkgRecordKey, EosHash (EosHash), EntityField (EosHashHash) unPkgRecordKey,
) )
import Network.HTTP.Types ( import Network.HTTP.Types (
status400,
status403, status403,
status404, status404,
status500, status500,
status400
) )
import Settings import Settings
import Startlude ( import Startlude (
@@ -104,7 +108,6 @@ import Startlude (
not, not,
replicate, replicate,
show, show,
throwIO,
toS, toS,
traverse, traverse,
void, void,
@@ -139,7 +142,8 @@ import Yesod (
logError, logError,
rawRequestBody, rawRequestBody,
requireCheckJsonBody, requireCheckJsonBody,
runDB, sendResponseStatus runDB,
sendResponseStatus,
) )
import Yesod.Auth (YesodAuth (maybeAuthId)) import Yesod.Auth (YesodAuth (maybeAuthId))
import Yesod.Core.Types (JSONResponse (JSONResponse)) import Yesod.Core.Types (JSONResponse (JSONResponse))
@@ -168,16 +172,16 @@ postPkgUploadR = do
renameDirectory dir targetPath renameDirectory dir targetPath
maybeAuthId >>= \case maybeAuthId >>= \case
Nothing -> do Nothing -> do
-- TODO: Send this to Matrix
$logError $logError
"The Impossible has happened, an unauthenticated user has managed to upload a pacakge to this registry" "The Impossible has happened, an unauthenticated user has managed to upload a pacakge to this registry"
throwIO $ ErrorCall "Unauthenticated user has uploaded package to registry!!!" pure ()
Just name -> do Just name -> do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId) packageManifestVersion now) runDB $ insert_ (Upload (AdminKey name) (PkgRecordKey packageManifestId) packageManifestVersion now)
where where
retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m) retry m = runMaybeT . asum $ replicate 3 (MaybeT $ hush <$> try @_ @SomeException m)
postEosUploadR :: Handler () postEosUploadR :: Handler ()
postEosUploadR = do postEosUploadR = do
root <- getsYesod $ (</> "eos") . resourcesDir . appSettings root <- getsYesod $ (</> "eos") . resourcesDir . appSettings