cleanup

src/Handler/Admin.hs

@@ -58,7 +58,7 @@ import Handler.Util (
     getHashFromQuery,
     getVersionFromQuery,
     orThrow,
-    sendResponseText, checkAdminAllowedPkgs,
+    sendResponseText, checkAdminAllowedPkgs, checkAdminAuth,
  )
 import Lib.PkgRepository (
     PkgRepo (PkgRepo, pkgRepoFileRoot),
@@ -197,13 +197,7 @@ postPkgUploadR = do
             removePathForcibly targetPath
             createDirectoryIfMissing True targetPath
             renameDirectory dir targetPath
-            maybeAuthId >>= \case
-                Nothing -> do
-                    $logError
-                        "Impossible: an unauthenticated user has managed to upload a pacakge to this registry."
-                    pure ()
-                Just name -> do
-                    (authorized, _) <- checkAdminAllowedPkgs packageManifestId name
+            (authorized, name) <- checkAdminAuth packageManifestId
             if authorized
                 then do
                     now <- liftIO getCurrentTime
@@ -256,14 +250,8 @@ instance ToJSON IndexPkgReq where
 postPkgIndexR :: Handler ()
 postPkgIndexR = do
     IndexPkgReq{..} <- requireCheckJsonBody
-    maybeAuthId >>= \case
-        Nothing -> do
-            $logError
-                "Impossible: an unauthenticated user has accessed the index endpoint."
-            pure ()
-        Just name -> do
-            (authorized, _) <- checkAdminAllowedPkgs indexPkgReqId name
-            if authorized
+    (admin, _) <- checkAdminAuth indexPkgReqId
+    if admin
         then do
             manifest <- getManifestLocation indexPkgReqId indexPkgReqVersion
             man <-
@@ -279,14 +267,8 @@ postPkgIndexR = do
 postPkgDeindexR :: Handler ()
 postPkgDeindexR = do
     IndexPkgReq{..} <- requireCheckJsonBody
-    maybeAuthId >>= \case
-        Nothing -> do
-            $logError
-                "Impossible: an unauthenticated user has accessed the deindex endpoint."
-            pure ()
-        Just name -> do
-            (authorized, _) <- checkAdminAllowedPkgs indexPkgReqId name
-            if authorized
+    (admin, _) <- checkAdminAuth indexPkgReqId
+    if admin
         then do
             case indexPkgReqArches of
                 Nothing -> runDB $ delete (VersionRecordKey (PkgRecordKey indexPkgReqId) indexPkgReqVersion)
@@ -345,14 +327,8 @@ deleteCategoryR cat = runDB $ deleteBy (UniqueName cat)
 
 postPkgCategorizeR :: Text -> PkgId -> Handler ()
 postPkgCategorizeR cat pkg = do
-    maybeAuthId >>= \case
-        Nothing -> do
-            $logError
-                "Impossible: an unauthenticated user has accessed the categorize endpoint."
-            pure ()
-        Just name -> do
-            (authorized, _) <- checkAdminAllowedPkgs pkg name
-            if authorized
+    (admin, _) <- checkAdminAuth pkg
+    if admin
         then runDB $ do
             catEnt <- getBy (UniqueName cat) `orThrow` sendResponseText status404 [i|Category "#{cat}" does not exist|]
             _pkgEnt <- get (PkgRecordKey pkg) `orThrow` sendResponseText status404 [i|Package "#{pkg}" does not exist|]
@@ -367,14 +343,8 @@ postPkgCategorizeR cat pkg = do
 
 deletePkgCategorizeR :: Text -> PkgId -> Handler ()
 deletePkgCategorizeR cat pkg = do
-    maybeAuthId >>= \case
-        Nothing -> do
-            $logError
-                "Impossible: an unauthenticated user has accessed the uncategorize endpoint."
-            pure ()
-        Just name -> do
-            (authorized, _) <- checkAdminAllowedPkgs pkg name
-            if authorized
+    (admin, _) <- checkAdminAuth pkg
+    if admin
         then runDB $ do
             catEnt <- getBy (UniqueName cat) `orThrow` sendResponseText status404 [i|Category "#{cat}" does not exist|]
             deleteBy (UniquePkgCategory (PkgRecordKey pkg) (entityKey catEnt))

src/Handler/Util.hs

@@ -90,6 +90,8 @@ import Data.Bifunctor (Bifunctor(first))
 import qualified Data.MultiMap as MM
 import Startlude (bimap)
 import Data.List (length)
+import Control.Monad.Logger (logError)
+import Yesod.Auth (YesodAuth(maybeAuthId))
 
 orThrow :: MonadHandler m => m (Maybe a) -> m a -> m a
 orThrow action other =
@@ -265,3 +267,14 @@ checkAdminAllowedPkgs pkgId adminId = do
             res <- runDB $ getAllowedPkgs pkgId (AdminKey adminId)
             pure $ if length res > 0 then (True, False) else (False, False)
         else pure (True, True)
+
+checkAdminAuth :: PkgId -> Handler (Bool, Text)
+checkAdminAuth pkgId = do
+    maybeAuthId >>= \case
+        Nothing -> do
+            $logError
+                "Impossible: an unauthenticated user has accessed an authenticated endpoint."
+            pure (False, "")
+        Just name -> do
+            (authorized, _) <- checkAdminAllowedPkgs pkgId name
+            pure (authorized, name)