    module Yesod.Core.Internal.Session
        ( encodeClientSession
        , decodeClientSession
        , clientSessionDateCacher
        , ClientSessionDateCache(..)
        , SaveSession
        , SessionBackend(..)
        ) where

    import qualified Web.ClientSession as CS
    import Data.Serialize
    import Data.Time
    import Data.ByteString (ByteString)
    import Control.Monad (guard)
    import Yesod.Core.Types
    import Yesod.Core.Internal.Util
    import Control.AutoUpdate

    encodeClientSession :: CS.Key
                        -> CS.IV
                        -> ClientSessionDateCache  -- ^ expire time
                        -> ByteString -- ^ remote host
                        -> SessionMap -- ^ session
                        -> ByteString -- ^ cookie value
    encodeClientSession :: Key
    -> IV
    -> ClientSessionDateCache
    -> ByteString
    -> SessionMap
    -> ByteString
    encodeClientSession Key
    key IV
    iv ClientSessionDateCache
    date ByteString
    rhost SessionMap
    session' =
        Key -> IV -> ByteString -> ByteString
    CS.encrypt Key
    key IV
    iv (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ SessionCookie -> ByteString
    forall a. Serialize a => a -> ByteString
    encode (SessionCookie -> ByteString) -> SessionCookie -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Either UTCTime ByteString
    -> ByteString -> SessionMap -> SessionCookie
    SessionCookie Either UTCTime ByteString
    forall {a}. Either a ByteString
    expires ByteString
    rhost SessionMap
    session'
          where expires :: Either a ByteString
    expires = ByteString -> Either a ByteString
    forall a b. b -> Either a b
    Right (ClientSessionDateCache -> ByteString
    csdcExpiresSerialized ClientSessionDateCache
    date)

    decodeClientSession :: CS.Key
                        -> ClientSessionDateCache  -- ^ current time
                        -> ByteString -- ^ remote host field
                        -> ByteString -- ^ cookie value
                        -> Maybe SessionMap
    decodeClientSession :: Key
    -> ClientSessionDateCache
    -> ByteString
    -> ByteString
    -> Maybe SessionMap
    decodeClientSession Key
    key ClientSessionDateCache
    date ByteString
    rhost ByteString
    encrypted = do
        decrypted <- Key -> ByteString -> Maybe ByteString
    CS.decrypt Key
    key ByteString
    encrypted
        SessionCookie (Left expire) rhost' session' <-
            either (const Nothing) Just $ decode decrypted
        guard $ expire > csdcNow date
        guard $ rhost' == rhost
        return session'

    ----------------------------------------------------------------------

    -- Originally copied from Kazu's date-cache, but now using mkAutoUpdate.
    --
    -- The cached date is updated every 10s, we don't need second
    -- resolution for session expiration times.
    --
    -- The second component of the returned tuple used to be an action that
    -- killed the updater thread, but is now a no-op that's just there
    -- to preserve the type.

    clientSessionDateCacher ::
         NominalDiffTime -- ^ Inactive session validity.
      -> IO (IO ClientSessionDateCache, IO ())
    clientSessionDateCacher :: NominalDiffTime -> IO (IO ClientSessionDateCache, IO ())
    clientSessionDateCacher NominalDiffTime
    validity = do
        getClientSessionDateCache <- UpdateSettings ClientSessionDateCache
    -> IO (IO ClientSessionDateCache)
    forall a. UpdateSettings a -> IO (IO a)
    mkAutoUpdate UpdateSettings ()
    defaultUpdateSettings
          { updateAction = getUpdated
          , updateFreq   = 10000000 -- 10s
          }

        return (getClientSessionDateCache, return ())
      where
        getUpdated :: IO ClientSessionDateCache
    getUpdated = do
          now <- IO UTCTime
    getCurrentTime
          let expires  = NominalDiffTime
    validity NominalDiffTime -> UTCTime -> UTCTime
    `addUTCTime` UTCTime
    now
              expiresS = Put -> ByteString
    runPut (UTCTime -> Put
    putTime UTCTime
    expires)
          return $! ClientSessionDateCache now expires expiresS