fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

chore(versionbump): Additional restrictions added.

Browse Source
This commit is contained in:
Stephan Barth 2024-09-25 03:24:29 +02:00
parent 34dd21c1e9
commit 081310c656
2 changed files with 9 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Foundation/Authorization.hs
View File

@ -60,8 +60,8 @@ import Data.Aeson.Lens hiding (_Value, key)
import qualified Data.Binary as Binary
import GHC.TypeLits (TypeError)
import qualified GHC.TypeLits as TypeError (ErrorMessage(..))
--import GHC.TypeLits (TypeError)
--import qualified GHC.TypeLits as TypeError (ErrorMessage(..))
-- import Utils.VolatileClusterSettings
@ -108,12 +108,12 @@ class (MonadHandler m, HandlerSite m ~ UniWorX, BearerAuthSite UniWorX, MonadUnl
apRunDB :: forall a. ReaderT SqlReadBackend (HandlerFor UniWorX) a -> m a
type family DisabledMonadAPInstance t err :: Constraint where
DisabledMonadAPInstance t err
= TypeError ( 'TypeError.Text "Used dangerous MonadAP instance for: " 'TypeError.:<>: 'TypeError.ShowType t
'TypeError.:$$: 'TypeError.Text "This instance is currently disabled via TypeError because: " 'TypeError.:<>: err
'TypeError.:$$: 'TypeError.Text "Please consider removing the usage triggering this error message before re-enabling or removing the instance."
)
--type family DisabledMonadAPInstance t err :: Constraint where
-- DisabledMonadAPInstance t err
-- = TypeError ( 'TypeError.Text "Used dangerous MonadAP instance for: " 'TypeError.:<>: 'TypeError.ShowType t
-- 'TypeError.:$$: 'TypeError.Text "This instance is currently disabled via TypeError because: " 'TypeError.:<>: err
-- 'TypeError.:$$: 'TypeError.Text "Please consider removing the usage triggering this error message before re-enabling or removing the instance."
-- )
instance ( BearerAuthSite UniWorX
-- , DisabledMonadAPInstance (HandlerFor UniWorX) ('TypeError.Text "It causes too many database connections")

1
src/Foundation/Yesod/Auth.hs
View File

@ -53,6 +53,7 @@ import qualified Data.Map as Map
authenticate :: ( MonadHandler m, HandlerSite m ~ UniWorX
, YesodPersist UniWorX, BackendCompatible SqlBackend (YesodPersistBackend UniWorX)
, YesodAuth UniWorX, UserId ~ AuthId UniWorX
, RenderMessage UniWorX CampusUserConversionException
)
=> Creds UniWorX -> m (AuthenticationResult UniWorX)
authenticate creds@Creds{..} = liftHandler . runDB . withReaderT projectBackend $ do