Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-04-02 04:53:07 +00:00
Code Issues Packages Projects Releases Wiki Activity

log uploads

Browse Source
This commit is contained in:
Keagan McClelland
2022-05-25 15:54:11 -06:00
parent 4c8cba18a2
commit 11e361fc5b
3 changed files with 28 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
src/Foundation.hs
View File

@@ -13,7 +13,9 @@
module Foundation where
import Startlude hiding ( Handler )
import Startlude hiding ( Handler
, get
)
import Control.Monad.Logger ( Loc
, LogSource
@@ -43,9 +45,8 @@ import qualified Data.Text as T
import Language.Haskell.TH ( Loc(..) )
import Lib.PkgRepository
import Lib.Types.AppIndex
import Model ( Admin
, EntityField(AdminName, AdminPassHash)
, Unique(UniqueAdmin)
import Model ( Admin(..)
, Key(AdminKey)
)
import Settings
import System.Console.ANSI.Codes ( Color(..)
@@ -218,8 +219,10 @@ instance YesodAuth RegistryCtx where
pool <- getsYesod appConnPool
let checkCreds k s = flip runSqlPool pool $ do
let passHash = hashWith SHA256 . encodeUtf8 . ("start9_admin:" <>) $ decodeUtf8 s
ls <- selectList [AdminName ==. decodeUtf8 k, AdminPassHash ==. passHash] []
pure . not . null $ ls
get (AdminKey $ decodeUtf8 k) <&> \case
Nothing -> False
Just Admin { adminPassHash } -> adminPassHash == passHash
defaultMaybeBasicAuthId checkCreds defaultAuthSettings
loginDest _ = PackageListR
logoutDest _ = PackageListR
@@ -227,7 +230,7 @@ instance YesodAuth RegistryCtx where
instance YesodAuthPersist RegistryCtx where
type AuthEntity RegistryCtx = Admin
getAuthEntity = (entityVal <<$>>) . liftHandler . runDB . getBy . UniqueAdmin
getAuthEntity = liftHandler . runDB . get . AdminKey