module Snap.SessionUtil where
import Data.Word
import Snap.Types
import System.Random
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Map (Map)
import qualified Data.Map as M
setCookie :: MonadSnap m => Cookie -> m ()
setCookie cookie = modifyResponse (addResponseCookie cookie)
lookupCookie :: MonadSnap m => ByteString -> m (Maybe Cookie)
lookupCookie name = getResponse
>>= maybe (getCookie name) (return . Just) . getResponseCookie name
clearCookie :: MonadSnap m => ByteString -> m ()
clearCookie name = setCookie $ Cookie name "" Nothing Nothing Nothing
popPathTo :: MonadSnap m => (ByteString -> m a) -> m a
popPathTo handler = do
req <- getRequest
let (x,y) = B.break (== '/') (rqPathInfo req)
if B.null x
then pass
else localRequest (\r -> r {rqPathInfo = B.drop 1 y}) (handler x)
ifTopDir :: MonadSnap m => m a -> m a
ifTopDir handler = ifTop $ do
req <- getRequest
if (B.last (rqURI req) /= '/')
then redirect $ rqURI req `B.append` "/" `B.append` rqQueryString req
else handler
ifTopFile :: MonadSnap m => m a -> m a
ifTopFile handler = ifTop $ do
req <- getRequest
if (B.last (rqURI req) == '/') then pass else handler
newtype SessionKey = K Word64
deriving (Eq, Ord, Enum, Bounded, Num, Real, Integral)
instance Random SessionKey where
randomR (l, h) g = let (r, g') = randomR (toInteger l, toInteger h) g
in (fromInteger r, g')
random = randomR (minBound, maxBound)
instance Show SessionKey where
show (K n) = show n
instance Read SessionKey where
readsPrec n s = map (\(a,t) -> (K a, t)) (readsPrec n s)
uniqueKey :: (Random k, Ord k) => Map k a -> IO k
uniqueKey m = do k <- randomIO
if M.member k m then uniqueKey m else return k