From b5410a80af7a9baa99b65391ec48483e059d510f Mon Sep 17 00:00:00 2001
From: Lucy Cifferello <12953208+elvece@users.noreply.github.com>
Date: Wed, 12 Apr 2023 14:58:04 -0600
Subject: [PATCH] enable deleting deprecated admin users

---
 src/Foundation.hs | 11 ++++++++---
 src/Model.hs      |  1 +
 src/Settings.hs   |  7 ++-----
 3 files changed, 11 insertions(+), 8 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index a0c12d6..4f54bf2 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -114,7 +114,7 @@ import Lib.PkgRepository (
 import Lib.Types.Core (PkgId, S9PK)
 import Model (
     Admin (..),
-    Key (AdminKey),
+    Key (AdminKey), EntityField (AdminId, AdminDeletedAt),
  )
 import Settings (AppSettings (appShouldLogAll))
 import System.Console.ANSI.Codes (
@@ -150,6 +150,9 @@ import Yesod.Persist.Core (
     YesodPersistRunner (..),
     defaultGetDBRunner,
  )
+import Database.Persist ((==.))
+import Database.Persist (selectFirst)
+import Database.Persist (entityVal)
 
 
 -- | The foundation datatype for your application. This can be a good place to
@@ -312,9 +315,11 @@ instance YesodAuth RegistryCtx where
         pool <- getsYesod appConnPool
         let checkCreds k s = flip runSqlPool pool $ do
                 let passHash = hashWith SHA256 . encodeUtf8 . ("start9_admin:" <>) $ decodeUtf8 s
-                get (AdminKey $ decodeUtf8 k) <&> \case
+                selectFirst [AdminDeletedAt ==. Nothing, AdminId ==. (AdminKey $ decodeUtf8 k)] [] <&> \case
                     Nothing -> False
-                    Just Admin{adminPassHash} -> adminPassHash == passHash
+                    Just adminEntity -> do 
+                        let Admin{adminPassHash} = entityVal adminEntity
+                        adminPassHash == passHash
 
         defaultMaybeBasicAuthId checkCreds defaultAuthSettings
     loginDest _ = PackageIndexR V1
diff --git a/src/Model.hs b/src/Model.hs
index cb8f24c..1160fe4 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -148,6 +148,7 @@ Admin
     Id Text
     createdAt UTCTime
     passHash (Digest SHA256)
+    deletedAt UTCTime Maybe
 
 Upload
     uploader AdminId
diff --git a/src/Settings.hs b/src/Settings.hs
index 911d464..2f6ab63 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -17,7 +17,7 @@ import           Startlude                      ( ($)
                                                 , ByteString
                                                 , ConvertText(toS)
                                                 , FilePath
-                                                , IsString(fromString)
+                                                
                                                 , Monad(return)
                                                 , Monoid(mempty)
                                                 , Text
@@ -59,10 +59,7 @@ import           Orphans.Emver                  ( )
 import Lib.Types.Core (PkgId)
 import Data.String
 import Data.List.Extra (splitOn)
-import Data.Maybe (Maybe)
-import Prelude (sequence, read)
-import Prelude (map)
-import Protolude (readMaybe)
+import Prelude (map, read)
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
 -- theoretically even a database.