fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor(memcached): checking memcached key security mechanisms

Browse Source 
RESULTS:

Keys for memcached use their Binary representation!

This means that the following three are all interchangeable as a key:
      newtype Foo1 = Foo1 { someInt1 :: Int } deriving newtype (Binary)
      data    Foo2 = Foo2 { someInt2 :: Int } deriving         (Binary)
      type    Foo3 = Int
Therefore it is best to use $(memcachedHere) or $(memcachedByHere) if possible or add another type
This commit is contained in:
Steffen Jost 2024-10-11 11:23:29 +02:00 committed by Sarah Vaupel
parent ce125b6495
commit 14140c982b
2 changed files with 32 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Handler/Utils/Memcached.hs
View File

@ -25,6 +25,15 @@ module Handler.Utils.Memcached
, MemcachedException(..), AsyncTimeoutException(..)
) where
{- BEWARE: Keys for memcached use their Binary representation!
This means that the following three are all interchangeable as a key:
newtype Foo1 = Foo1 { someInt1 :: Int } deriving newtype (Binary)
data Foo2 = Foo2 { someInt2 :: Int } deriving (Binary)
type Foo3 = Int
Therefore it is best to use $(memcachedHere) or $(memcachedByHere) if possible or add another type
-}
import Import.NoFoundation hiding (utc, exp)
import Foundation.Type

26
src/Handler/Utils/Qualification.hs
View File

@ -21,14 +21,34 @@ import Handler.Utils.Widgets (statusHtml)
import Handler.Utils.Memcached
-- A type for saving QualificationId -> Qualfication queries
newtype MemcachedQualification = MemcachedQualification { unMemachedQualification :: QualificationId }
retrieveQualification :: (MonadHandler m, HandlerSite m ~ UniWorX) => QualificationId -> m (Maybe Qualification)
retrieveQualification qid = liftHandler $ $(memcachedByHere) (Just . Right $ 7 * diffHour) qid $ runDBRead $ get qid
{-
This experiment proves that a newtype-wrapper is entirely ignored by the derived Binary instance, since
regardless whether the prime or unprimed version is used, the same QualificationId leads to a hit:
newtype MemcachedQualification = MemcachedQualification { unMemachedQualification :: QualificationId } -- unnecessary, also see top comment in Handler.Utils.Memcached
deriving newtype (Eq, Ord, Show, Binary)
instance NFData MemcachedQualification where
rnf MemcachedQualification{..} = rnf unMemachedQualification
-- note that data does not work as expected either, the binary instance is only distinguished by the addition of another element
data MemcachedQualification = MemcachedQualification { unMemachedQualification :: QualificationId } -- , someId :: Text } -- with Text works OK
deriving (Eq, Ord, Show, Generic, Binary)
instance NFData MemcachedQualification where
rnf MemcachedQualification{..} = rnf (unMemachedQualification, someId)
retrieveQualification :: (MonadHandler m, HandlerSite m ~ UniWorX) => QualificationId -> m (Maybe Qualification)
retrieveQualification qid = liftHandler $ memcachedBy (Just . Right $ 7 * diffHour) (MemcachedQualification qid) $ runDBRead $ get qid
retrieveQualification qid = liftHandler $ memcachedBy (Just . Right $ 7 * diffHour) (MemcachedQualification qid) $ do
$logWarnS "CACHE-MISS" [st|Retrieve Qualification #{tshow qid} with Newtype-wrapper.|]
runDBRead $ get qid
retrieveQualification' :: (MonadHandler m, HandlerSite m ~ UniWorX) => QualificationId -> m (Maybe Qualification)
retrieveQualification' qid = liftHandler $ memcachedBy (Just . Right $ 7 * diffHour) qid $ do
$logWarnS "CACHE-MISS" [st|Retrieve Qualification #{tshow qid} directly without a wrapper.|]
runDBRead $ get qid
-}
-- | Compute new valid date from old one and from validDuration in months