module Freckle.App.Memcached.CacheKey
( CacheKey
, cacheKey
, cacheKeyThrow
, fromCacheKey
) where
import Freckle.App.Prelude
import Data.Char (isControl, isSpace)
import qualified Data.Text as T
import Database.Memcache.Types (Key)
import GHC.Stack (HasCallStack)
import UnliftIO.Exception (throwString)
newtype CacheKey = CacheKey Text
deriving stock Int -> CacheKey -> ShowS
[CacheKey] -> ShowS
CacheKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CacheKey] -> ShowS
$cshowList :: [CacheKey] -> ShowS
show :: CacheKey -> String
$cshow :: CacheKey -> String
showsPrec :: Int -> CacheKey -> ShowS
$cshowsPrec :: Int -> CacheKey -> ShowS
Show
deriving newtype (CacheKey -> CacheKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CacheKey -> CacheKey -> Bool
$c/= :: CacheKey -> CacheKey -> Bool
== :: CacheKey -> CacheKey -> Bool
$c== :: CacheKey -> CacheKey -> Bool
Eq, Eq CacheKey
Int -> CacheKey -> Int
CacheKey -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: CacheKey -> Int
$chash :: CacheKey -> Int
hashWithSalt :: Int -> CacheKey -> Int
$chashWithSalt :: Int -> CacheKey -> Int
Hashable)
unCacheKey :: CacheKey -> Text
unCacheKey :: CacheKey -> Text
unCacheKey (CacheKey Text
x) = Text
x
cacheKey :: Text -> Either String CacheKey
cacheKey :: Text -> Either String CacheKey
cacheKey Text
t
| Text -> Int
T.length Text
t forall a. Ord a => a -> a -> Bool
> Int
250 = String -> Either String CacheKey
invalid String
"Must be fewer than 250 characters"
| (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isControl Text
t = String -> Either String CacheKey
invalid String
"Cannot contain control characters"
| (Char -> Bool) -> Text -> Bool
T.any Char -> Bool
isSpace Text
t = String -> Either String CacheKey
invalid String
"Cannot container whitespace"
| Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text -> CacheKey
CacheKey Text
t
where
invalid :: String -> Either String CacheKey
invalid String
msg =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Not a valid memcached key:\n " forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
t forall a. Semigroup a => a -> a -> a
<> String
"\n\n" forall a. Semigroup a => a -> a -> a
<> String
msg
cacheKeyThrow :: (HasCallStack, MonadIO m) => Text -> m CacheKey
cacheKeyThrow :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m CacheKey
cacheKeyThrow = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String CacheKey
cacheKey
fromCacheKey :: CacheKey -> Key
fromCacheKey :: CacheKey -> Key
fromCacheKey = Text -> Key
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. CacheKey -> Text
unCacheKey