Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-03-26 10:21:51 +00:00
Code Issues Packages Projects Releases Wiki Activity

implements basic authentication for admins

Browse Source
This commit is contained in:
Keagan McClelland
2022-05-20 17:09:14 -06:00
parent e5efb877d3
commit d2aee89cda
5 changed files with 105 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
package.yaml
View File

@@ -64,6 +64,8 @@ dependencies:
- warp-tls - warp-tls
- yaml - yaml
- yesod - yesod
- yesod-auth
- yesod-auth-basic
- yesod-core - yesod-core
- yesod-persistent - yesod-persistent

46
src/Foundation.hs
View File

@@ -33,18 +33,43 @@ import qualified Yesod.Core.Unsafe as Unsafe
import Control.Monad.Logger.Extras ( wrapSGRCode ) import Control.Monad.Logger.Extras ( wrapSGRCode )
import Control.Monad.Reader.Has ( Has(extract, update) ) import Control.Monad.Reader.Has ( Has(extract, update) )
import Crypto.Hash ( SHA256(SHA256)
, hashWith
)
import Data.String.Interpolate.IsString import Data.String.Interpolate.IsString
( i ) ( i )
import qualified Data.Text as T import qualified Data.Text as T
import Language.Haskell.TH ( Loc(..) ) import Language.Haskell.TH ( Loc(..) )
import Lib.PkgRepository import Lib.PkgRepository
import Lib.Types.AppIndex import Lib.Types.AppIndex
import Model ( Admin
, EntityField(AdminName, AdminPassHash)
, Unique(UniqueAdmin)
)
import Settings import Settings
import System.Console.ANSI.Codes ( Color(..) import System.Console.ANSI.Codes ( Color(..)
, ColorIntensity(..) , ColorIntensity(..)
, ConsoleLayer(Foreground) , ConsoleLayer(Foreground)
, SGR(SetColor) , SGR(SetColor)
) )
import Yesod ( FormMessage
, defaultFormMessage
)
import Yesod.Auth ( AuthEntity
, Creds(credsIdent)
, YesodAuth
( AuthId
, authPlugins
, getAuthId
, loginDest
, logoutDest
, maybeAuthId
)
, YesodAuthPersist(getAuthEntity)
)
import Yesod.Auth.Http.Basic ( defaultAuthSettings
, defaultMaybeBasicAuthId
)
import Yesod.Persist.Core import Yesod.Persist.Core
-- | The foundation datatype for your application. This can be a good place to -- | The foundation datatype for your application. This can be a good place to
@@ -175,6 +200,27 @@ instance YesodPersistRunner RegistryCtx where
getDBRunner :: Handler (DBRunner RegistryCtx, Handler ()) getDBRunner :: Handler (DBRunner RegistryCtx, Handler ())
getDBRunner = defaultGetDBRunner appConnPool getDBRunner = defaultGetDBRunner appConnPool
instance RenderMessage RegistryCtx FormMessage where
renderMessage _ _ = defaultFormMessage
instance YesodAuth RegistryCtx where
type AuthId RegistryCtx = Text
getAuthId = pure . Just . credsIdent
maybeAuthId = do
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
defaultMaybeBasicAuthId checkCreds defaultAuthSettings
loginDest _ = PackageListR
logoutDest _ = PackageListR
authPlugins _ = []
instance YesodAuthPersist RegistryCtx where
type AuthEntity RegistryCtx = Admin
getAuthEntity = (entityVal <<$>>) . liftHandler . runDB . getBy . UniqueAdmin
unsafeHandler :: RegistryCtx -> Handler a -> IO a unsafeHandler :: RegistryCtx -> Handler a -> IO a
unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger

14
src/Model.hs
View File

@@ -11,9 +11,11 @@
module Model where module Model where
import Crypto.Hash
import Database.Persist.TH import Database.Persist.TH
import Lib.Types.AppIndex import Lib.Types.AppIndex
import Lib.Types.Emver import Lib.Types.Emver
import Orphans.Cryptonite ( )
import Orphans.Emver ( ) import Orphans.Emver ( )
import Startlude import Startlude
@@ -100,4 +102,16 @@ PkgDependency
UniquePkgDepVersion pkgId pkgVersion depId UniquePkgDepVersion pkgId pkgVersion depId
deriving Eq deriving Eq
deriving Show deriving Show
Admin
createdAt UTCTime
name Text
passHash (Digest SHA256)
UniqueAdmin name
Upload
uploader AdminId
pkgId PkgRecordId
pkgVersion Version
createdAt UTCTime
|] |]

42
src/Orphans/Cryptonite.hs Normal file
View File

@@ -0,0 +1,42 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TypeApplications #-}
module Orphans.Cryptonite where
import Crypto.Hash ( Digest
, digestFromByteString
)
import Crypto.Hash.Algorithms ( SHA256 )
import Data.ByteArray.Encoding ( Base(Base16)
, convertFromBase
, convertToBase
)
import Data.Text ( pack )
import Database.Persist ( PersistField(..)
, PersistValue(PersistText)
, SqlType(SqlString)
)
import Database.Persist.Sql ( PersistFieldSql(..) )
import Startlude ( ($)
, (.)
, Bifunctor(bimap, first)
, ByteString
, Either(Left)
, Semigroup((<>))
, decodeUtf8
, encodeUtf8
, join
, note
, show
)
instance PersistField (Digest SHA256) where
toPersistValue = PersistText . decodeUtf8 . convertToBase Base16
fromPersistValue (PersistText t) =
join
. bimap pack (note "Invalid SHA256 Digest" . digestFromByteString)
. convertFromBase @_ @ByteString Base16
. encodeUtf8
$ t
fromPersistValue v = Left $ "Invalid PersistValue type: " <> show v
instance PersistFieldSql (Digest SHA256) where
sqlType _ = SqlString

1
stack.yaml
View File

@@ -45,6 +45,7 @@ extra-deps:
- monad-logger-extras-0.1.1.1 - monad-logger-extras-0.1.1.1
- wai-request-spec-0.10.2.4 - wai-request-spec-0.10.2.4
- warp-3.3.19 - warp-3.3.19
- yesod-auth-basic-0.1.0.3
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
# flags: {} # flags: {}