-----------------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RecordWildCards     #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Cookie
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
--
-- = Overview
--
-- "Miso.Cookie" wraps the browser's
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore CookieStore API>
-- as 'Miso.Effect.Effect' combinators that integrate directly into the
-- Model-View-Update loop.
--
-- = Quick start
--
-- @
-- import "Miso"
-- import "Miso.Cookie"
--
-- data Action
--   = LoadSession
--   | GotSession (Maybe t'Cookie')
--   | SessionError 'Miso.String.MisoString'
--   | SaveTheme
--   | ThemeSaved
--
-- update :: Action -> 'Miso.Effect.Effect' p props Model Action
-- update LoadSession =
--   'cookieGet' \"session\" GotSession SessionError
-- update SaveTheme =
--   'cookieSet' \"theme\" \"dark\" ThemeSaved SessionError
-- update _ = pure ()
-- @
--
-- = Types
--
-- * t'Cookie' — a single cookie with all standard fields
-- * t'CookieChangeEvent' — payload for 'Miso.Subscription.Cookie.cookieChangeSub'
--
-- = API groups
--
-- * __Read__: 'cookieGet', 'cookieGetAll'
-- * __Write__: 'cookieSet'
-- * __Delete__: 'cookieDelete'
--
-- = Availability
--
-- The CookieStore API requires a
-- <https://developer.mozilla.org/en-US/docs/Web/Security/Secure_Contexts secure context>
-- (HTTPS or @localhost@) and is not yet universally supported. Operations
-- silently call the error callback when the API is unavailable.
--
-- = See also
--
-- * "Miso.Subscription.Cookie" — 'Miso.Subscription.Cookie.cookieChangeSub'
--   for subscribing to cookie change events
-- * "Miso.FFI" — raw FFI primitives ('Miso.FFI.cookieGet' etc.) for
--   advanced use-cases
-----------------------------------------------------------------------------
module Miso.Cookie
  ( -- ** Types
    Cookie (..)
  , CookieChangeEvent (..)
    -- ** Read
  , cookieGet
  , cookieGetAll
    -- ** Write
  , cookieSet
    -- ** Delete
  , cookieDelete
  , cookieDeleteWith
    -- ** Construction
  , defaultCookie
    -- ** Synchronous API variants
  , cookieSet_
  , cookieGet_
  , cookieDelete_
  , cookieDeleteWith_
  , cookieGetAll_
  ) where
-----------------------------------------------------------------------------
import           Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar)
import           Control.Monad ((<=<), forM_, join)
import           Prelude hiding ((!!))
-----------------------------------------------------------------------------
import           Miso.DSL
import           Miso.Effect
import           Miso.String (MisoString)
import qualified Miso.FFI.Internal as FFI
-----------------------------------------------------------------------------
-- | A cookie from the
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore CookieStore API>.
--
-- Fields map directly to the browser's
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/get#return_value CookieListItem>.
--
-- @since 1.13.0.0
data Cookie = Cookie
  { Cookie -> MisoString
cookieName        :: MisoString
  -- ^ Cookie name (empty string for nameless cookies)
  , Cookie -> Maybe MisoString
cookieValue       :: Maybe MisoString
  -- ^ Cookie value
  , Cookie -> Maybe MisoString
cookieDomain      :: Maybe MisoString
  -- ^ Cookie domain (@Nothing@ when unset — host-only cookie)
  , Cookie -> MisoString
cookiePath        :: MisoString
  -- ^ Cookie path
  , Cookie -> Maybe Double
cookieExpires     :: Maybe Double
  -- ^ Expiry as Unix milliseconds (@Nothing@ for session cookies)
  , Cookie -> Bool
cookieSecure      :: Bool
  -- ^ @Secure@ flag
  , Cookie -> MisoString
cookieSameSite    :: MisoString
  -- ^ @SameSite@ value: @\"strict\"@, @\"lax\"@, or @\"none\"@
  , Cookie -> Bool
cookiePartitioned :: Bool
  -- ^ @Partitioned@ flag (CHIPS — Cookies Having Independent Partitioned State)
  } deriving (Int -> Cookie -> ShowS
[Cookie] -> ShowS
Cookie -> String
(Int -> Cookie -> ShowS)
-> (Cookie -> String) -> ([Cookie] -> ShowS) -> Show Cookie
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cookie -> ShowS
showsPrec :: Int -> Cookie -> ShowS
$cshow :: Cookie -> String
show :: Cookie -> String
$cshowList :: [Cookie] -> ShowS
showList :: [Cookie] -> ShowS
Show, Cookie -> Cookie -> Bool
(Cookie -> Cookie -> Bool)
-> (Cookie -> Cookie -> Bool) -> Eq Cookie
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cookie -> Cookie -> Bool
== :: Cookie -> Cookie -> Bool
$c/= :: Cookie -> Cookie -> Bool
/= :: Cookie -> Cookie -> Bool
Eq)
-----------------------------------------------------------------------------
instance ToJSVal Cookie where
  toJSVal :: Cookie -> IO JSVal
toJSVal Cookie {Bool
Maybe Double
Maybe MisoString
MisoString
cookieName :: Cookie -> MisoString
cookieValue :: Cookie -> Maybe MisoString
cookieDomain :: Cookie -> Maybe MisoString
cookiePath :: Cookie -> MisoString
cookieExpires :: Cookie -> Maybe Double
cookieSecure :: Cookie -> Bool
cookieSameSite :: Cookie -> MisoString
cookiePartitioned :: Cookie -> Bool
cookieName :: MisoString
cookieValue :: Maybe MisoString
cookieDomain :: Maybe MisoString
cookiePath :: MisoString
cookieExpires :: Maybe Double
cookieSecure :: Bool
cookieSameSite :: MisoString
cookiePartitioned :: Bool
..} = do
    Object
o <- IO Object
create
    MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"name"        MisoString
cookieName        Object
o
    MisoString -> Maybe MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"value"       Maybe MisoString
cookieValue       Object
o
    MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"path"        MisoString
cookiePath        Object
o
    MisoString -> Bool -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"secure"      Bool
cookieSecure      Object
o
    MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"sameSite"    MisoString
cookieSameSite    Object
o
    MisoString -> Bool -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"partitioned" Bool
cookiePartitioned Object
o
    Maybe MisoString -> (MisoString -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe MisoString
cookieDomain  ((MisoString -> IO ()) -> IO ()) -> (MisoString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \MisoString
d -> MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"domain"  MisoString
d Object
o
    Maybe Double -> (Double -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Double
cookieExpires ((Double -> IO ()) -> IO ()) -> (Double -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Double
e -> MisoString -> Double -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"expires" Double
e Object
o
    Object -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Object
o
  {-# INLINE toJSVal #-}
-----------------------------------------------------------------------------
instance FromJSVal Cookie where
  fromJSVal :: JSVal -> IO (Maybe Cookie)
fromJSVal JSVal
v = do
    Maybe MisoString
name_        <- JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe MisoString))
-> IO JSVal -> IO (Maybe MisoString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"name"
    Maybe (Maybe MisoString)
value_       <- JSVal -> IO (Maybe (Maybe MisoString))
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe (Maybe MisoString)))
-> IO JSVal -> IO (Maybe (Maybe MisoString))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"value"
    Maybe (Maybe MisoString)
domain_      <- JSVal -> IO (Maybe (Maybe MisoString))
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe (Maybe MisoString)))
-> IO JSVal -> IO (Maybe (Maybe MisoString))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"domain"
    Maybe MisoString
path_        <- JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe MisoString))
-> IO JSVal -> IO (Maybe MisoString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"path"
    Maybe (Maybe Double)
expires_     <- JSVal -> IO (Maybe (Maybe Double))
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe (Maybe Double)))
-> IO JSVal -> IO (Maybe (Maybe Double))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"expires"
    Maybe Bool
secure_      <- JSVal -> IO (Maybe Bool)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe Bool)) -> IO JSVal -> IO (Maybe Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"secure"
    Maybe MisoString
sameSite_    <- JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe MisoString))
-> IO JSVal -> IO (Maybe MisoString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"sameSite"
    Maybe Bool
partitioned_ <- JSVal -> IO (Maybe Bool)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe Bool)) -> IO JSVal -> IO (Maybe Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
v JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"partitioned"
    Maybe Cookie -> IO (Maybe Cookie)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Cookie -> IO (Maybe Cookie))
-> Maybe Cookie -> IO (Maybe Cookie)
forall a b. (a -> b) -> a -> b
$ do
      MisoString
n   <- Maybe MisoString
name_
      Maybe MisoString
vl  <- Maybe (Maybe MisoString)
value_
      MisoString
p   <- Maybe MisoString
path_
      Bool
sec <- Maybe Bool
secure_
      MisoString
ss  <- Maybe MisoString
sameSite_
      Bool
par <- Maybe Bool
partitioned_
      Cookie -> Maybe Cookie
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cookie
        { cookieName :: MisoString
cookieName        = MisoString
n
        , cookieValue :: Maybe MisoString
cookieValue       = Maybe MisoString
vl
        , cookieDomain :: Maybe MisoString
cookieDomain      = Maybe (Maybe MisoString) -> Maybe MisoString
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe MisoString)
domain_
        , cookiePath :: MisoString
cookiePath        = MisoString
p
        , cookieExpires :: Maybe Double
cookieExpires     = Maybe (Maybe Double) -> Maybe Double
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join Maybe (Maybe Double)
expires_
        , cookieSecure :: Bool
cookieSecure      = Bool
sec
        , cookieSameSite :: MisoString
cookieSameSite    = MisoString
ss
        , cookiePartitioned :: Bool
cookiePartitioned = Bool
par
        }
  {-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
-- | The event payload delivered to
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/change_event cookieStore change>
-- listeners. Consumed by 'Miso.Subscription.Cookie.cookieChangeSub'.
--
-- @since 1.13.0.0
data CookieChangeEvent = CookieChangeEvent
  { CookieChangeEvent -> [Cookie]
cookiesChanged :: [Cookie]
  -- ^ Cookies that were added or updated
  , CookieChangeEvent -> [Cookie]
cookiesDeleted :: [Cookie]
  -- ^ Cookies that were deleted
  } deriving (Int -> CookieChangeEvent -> ShowS
[CookieChangeEvent] -> ShowS
CookieChangeEvent -> String
(Int -> CookieChangeEvent -> ShowS)
-> (CookieChangeEvent -> String)
-> ([CookieChangeEvent] -> ShowS)
-> Show CookieChangeEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CookieChangeEvent -> ShowS
showsPrec :: Int -> CookieChangeEvent -> ShowS
$cshow :: CookieChangeEvent -> String
show :: CookieChangeEvent -> String
$cshowList :: [CookieChangeEvent] -> ShowS
showList :: [CookieChangeEvent] -> ShowS
Show, CookieChangeEvent -> CookieChangeEvent -> Bool
(CookieChangeEvent -> CookieChangeEvent -> Bool)
-> (CookieChangeEvent -> CookieChangeEvent -> Bool)
-> Eq CookieChangeEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CookieChangeEvent -> CookieChangeEvent -> Bool
== :: CookieChangeEvent -> CookieChangeEvent -> Bool
$c/= :: CookieChangeEvent -> CookieChangeEvent -> Bool
/= :: CookieChangeEvent -> CookieChangeEvent -> Bool
Eq)
-----------------------------------------------------------------------------
instance FromJSVal CookieChangeEvent where
  fromJSVal :: JSVal -> IO (Maybe CookieChangeEvent)
fromJSVal JSVal
ev = do
    Maybe [Cookie]
changed_ <- JSVal -> IO (Maybe [Cookie])
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO (Maybe [Cookie])) -> IO JSVal -> IO (Maybe [Cookie])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
ev JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"changed"
    Maybe [Cookie]
deleted_ <- JSVal -> IO (Maybe [Cookie])
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO (Maybe [Cookie])) -> IO JSVal -> IO (Maybe [Cookie])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
ev JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! MisoString
"deleted"
    Maybe CookieChangeEvent -> IO (Maybe CookieChangeEvent)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Cookie] -> [Cookie] -> CookieChangeEvent
CookieChangeEvent ([Cookie] -> [Cookie] -> CookieChangeEvent)
-> Maybe [Cookie] -> Maybe ([Cookie] -> CookieChangeEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Cookie]
changed_ Maybe ([Cookie] -> CookieChangeEvent)
-> Maybe [Cookie] -> Maybe CookieChangeEvent
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Cookie]
deleted_)
  {-# INLINE fromJSVal #-}
-----------------------------------------------------------------------------
instance ToJSVal CookieChangeEvent where
  toJSVal :: CookieChangeEvent -> IO JSVal
toJSVal CookieChangeEvent {[Cookie]
cookiesChanged :: CookieChangeEvent -> [Cookie]
cookiesDeleted :: CookieChangeEvent -> [Cookie]
cookiesChanged :: [Cookie]
cookiesDeleted :: [Cookie]
..} = do
    Object
o <- IO Object
create
    MisoString -> [Cookie] -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"changed" [Cookie]
cookiesChanged Object
o
    MisoString -> [Cookie] -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"deleted" [Cookie]
cookiesDeleted Object
o
    Object -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Object
o
  {-# INLINE toJSVal #-}
-----------------------------------------------------------------------------
instance ToArgs CookieChangeEvent where
  toArgs :: CookieChangeEvent -> IO [JSVal]
toArgs CookieChangeEvent
ev = (JSVal -> [JSVal] -> [JSVal]
forall a. a -> [a] -> [a]
:[]) (JSVal -> [JSVal]) -> IO JSVal -> IO [JSVal]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CookieChangeEvent -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal CookieChangeEvent
ev
  {-# INLINE toArgs #-}
-----------------------------------------------------------------------------
-- | Retrieve a cookie value by name.
--
-- Calls @successful@ with @'Just' value@ when found, @'Nothing'@ when
-- absent, or @errorful@ with the error message if the operation fails.
--
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/get>
--
-- @since 1.13.0.0
cookieGet
  :: MisoString
  -- ^ Cookie name
  -> (Maybe MisoString -> action)
  -- ^ Successful callback (@Nothing@ when the cookie is absent)
  -> (MisoString -> action)
  -- ^ Errorful callback
  -> Effect context props model action
cookieGet :: forall action context props model.
MisoString
-> (Maybe MisoString -> action)
-> (MisoString -> action)
-> Effect context props model action
cookieGet MisoString
name Maybe MisoString -> action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect context props model action
forall action context props model.
(Sink action -> IO ()) -> Effect context props model action
withSink ((Sink action -> IO ()) -> Effect context props model action)
-> (Sink action -> IO ()) -> Effect context props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
  MisoString -> (JSVal -> IO ()) -> (MisoString -> IO ()) -> IO ()
FFI.cookieGet MisoString
name
    (Sink action
sink Sink action
-> (Maybe MisoString -> action) -> Maybe MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MisoString -> action
successful (Maybe MisoString -> IO ())
-> (JSVal -> IO (Maybe MisoString)) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal)
    (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
-----------------------------------------------------------------------------
-- | Retrieve all cookies visible to the current document.
--
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/getAll>
--
-- @since 1.13.0.0
cookieGetAll
  :: ([Cookie] -> action)
  -- ^ Successful callback
  -> (MisoString -> action)
  -- ^ Errorful callback
  -> Effect context props model action
cookieGetAll :: forall action context props model.
([Cookie] -> action)
-> (MisoString -> action) -> Effect context props model action
cookieGetAll [Cookie] -> action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect context props model action
forall action context props model.
(Sink action -> IO ()) -> Effect context props model action
withSink ((Sink action -> IO ()) -> Effect context props model action)
-> (Sink action -> IO ()) -> Effect context props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
  (JSVal -> IO ()) -> (MisoString -> IO ()) -> IO ()
FFI.cookieGetAll
    (Sink action
sink Sink action -> ([Cookie] -> action) -> [Cookie] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cookie] -> action
successful ([Cookie] -> IO ()) -> (JSVal -> IO [Cookie]) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO [Cookie]
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked)
    (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
-----------------------------------------------------------------------------
-- | A t'Cookie' with sensible defaults: @path = "/"@, session expiry,
-- @SameSite = "lax"@, not secure, not partitioned, no domain restriction.
--
-- @since 1.13.0.0
defaultCookie :: MisoString -> MisoString -> Cookie
defaultCookie :: MisoString -> MisoString -> Cookie
defaultCookie MisoString
name MisoString
value = Cookie
  { cookieName :: MisoString
cookieName        = MisoString
name
  , cookieValue :: Maybe MisoString
cookieValue       = MisoString -> Maybe MisoString
forall a. a -> Maybe a
Just MisoString
value
  , cookieDomain :: Maybe MisoString
cookieDomain      = Maybe MisoString
forall a. Maybe a
Nothing
  , cookiePath :: MisoString
cookiePath        = MisoString
"/"
  , cookieExpires :: Maybe Double
cookieExpires     = Maybe Double
forall a. Maybe a
Nothing
  , cookieSecure :: Bool
cookieSecure      = Bool
False
  , cookieSameSite :: MisoString
cookieSameSite    = MisoString
"lax"
  , cookiePartitioned :: Bool
cookiePartitioned = Bool
False
  }
-----------------------------------------------------------------------------
-- | Set a cookie via the
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore CookieStore API>.
--
-- Use 'defaultCookie' to construct a t'Cookie' with sensible defaults, or
-- supply a fully specified t'Cookie' record for custom path, domain, expiry etc.
--
-- __Important:__ You cannot use both @expires@ and @maxAge@ in the same call.
-- If you do, the @set()@ method will fail with a @TypeError@.
--
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/set>
--
-- @since 1.13.0.0
cookieSet
  :: Cookie
  -- ^ Cookie to set (use 'defaultCookie' for the common case)
  -> action
  -- ^ Successful callback
  -> (MisoString -> action)
  -- ^ Errorful callback
  -> Effect context props model action
cookieSet :: forall action context props model.
Cookie
-> action
-> (MisoString -> action)
-> Effect context props model action
cookieSet Cookie
cookie action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect context props model action
forall action context props model.
(Sink action -> IO ()) -> Effect context props model action
withSink ((Sink action -> IO ()) -> Effect context props model action)
-> (Sink action -> IO ()) -> Effect context props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
  JSVal
c_ <- Cookie -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Cookie
cookie
  JSVal -> IO () -> (MisoString -> IO ()) -> IO ()
FFI.cookieSet JSVal
c_ (Sink action
sink action
successful) (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
-----------------------------------------------------------------------------
-- | Delete a cookie by name.
--
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/delete>
--
-- @since 1.13.0.0
cookieDelete
  :: MisoString
  -- ^ Cookie name
  -> action
  -- ^ Successful callback
  -> (MisoString -> action)
  -- ^ Errorful callback
  -> Effect context props model action
cookieDelete :: forall action context props model.
MisoString
-> action
-> (MisoString -> action)
-> Effect context props model action
cookieDelete MisoString
name action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect context props model action
forall action context props model.
(Sink action -> IO ()) -> Effect context props model action
withSink ((Sink action -> IO ()) -> Effect context props model action)
-> (Sink action -> IO ()) -> Effect context props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
  MisoString -> IO () -> (MisoString -> IO ()) -> IO ()
FFI.cookieDelete MisoString
name (Sink action
sink action
successful) (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
-----------------------------------------------------------------------------
-- | Delete a cookie by matching on name, path, domain, and\/or partitioned
-- flag — useful when multiple cookies share the same name across different
-- paths or domains.
--
-- Use 'defaultCookie' to build the argument and override only the fields
-- you need:
--
-- @
-- 'cookieDeleteWith' ('defaultCookie' \"session\" \"\") { 'cookiePath' = \"\/admin\" }
--   Deleted
--   SessionError
-- @
--
-- <https://developer.mozilla.org/en-US/docs/Web/API/CookieStore/delete>
--
-- @since 1.13.0.0
cookieDeleteWith
  :: Cookie
  -- ^ Cookie whose name, path, domain and partitioned fields are used for matching
  -> action
  -- ^ Successful callback
  -> (MisoString -> action)
  -- ^ Errorful callback
  -> Effect context props model action
cookieDeleteWith :: forall action context props model.
Cookie
-> action
-> (MisoString -> action)
-> Effect context props model action
cookieDeleteWith Cookie
cookie action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect context props model action
forall action context props model.
(Sink action -> IO ()) -> Effect context props model action
withSink ((Sink action -> IO ()) -> Effect context props model action)
-> (Sink action -> IO ()) -> Effect context props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
  JSVal
c_ <- Cookie -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Cookie
cookie
  JSVal -> IO () -> (MisoString -> IO ()) -> IO ()
FFI.cookieDeleteWith JSVal
c_ (Sink action
sink action
successful) (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MisoString -> action
errorful)
-----------------------------------------------------------------------------
-- | Synchronous API variant of 'cookieSet'.
--
-- Blocks the calling thread until the browser resolves the promise, returning
-- @'Right' ()@ on success or @'Left' err@ on failure.
--
-- __Note:__ best used with 'Miso.Effect.io' or 'Miso.Effect.io_', to avoid blocking the scheduler thread.
--
-- @since 1.13.0.0
cookieSet_ :: Cookie -> IO (Either MisoString ())
cookieSet_ :: Cookie -> IO (Either MisoString ())
cookieSet_ Cookie
cookie = do
  MVar (Either MisoString ())
mvar <- IO (MVar (Either MisoString ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString ()))
  JSVal
c_ <- Cookie -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Cookie
cookie
  JSVal -> IO () -> (MisoString -> IO ()) -> IO ()
FFI.cookieSet JSVal
c_
    (MVar (Either MisoString ()) -> Either MisoString () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString ())
mvar (() -> Either MisoString ()
forall a b. b -> Either a b
Right ()))
    (\MisoString
e -> MVar (Either MisoString ()) -> Either MisoString () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString ())
mvar (MisoString -> Either MisoString ()
forall a b. a -> Either a b
Left MisoString
e))
  MVar (Either MisoString ()) -> IO (Either MisoString ())
forall a. MVar a -> IO a
takeMVar MVar (Either MisoString ())
mvar
{-# INLINE cookieSet_ #-}
-----------------------------------------------------------------------------
-- | Synchronous API variant of 'cookieGet'.
--
-- Blocks the calling thread until the browser resolves the promise, returning
-- @'Right' ('Just' value)@ when the cookie exists, @'Right' 'Nothing'@
-- when absent, or @'Left' err@ on failure.
--
-- __Note:__ best used with 'Miso.Effect.io' or 'Miso.Effect.io_', to avoid blocking the scheduler thread.
--
-- @since 1.13.0.0
cookieGet_ :: MisoString -> IO (Either MisoString (Maybe MisoString))
cookieGet_ :: MisoString -> IO (Either MisoString (Maybe MisoString))
cookieGet_ MisoString
name = do
  MVar (Either MisoString (Maybe MisoString))
mvar <- IO (MVar (Either MisoString (Maybe MisoString)))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString (Maybe MisoString)))
  MisoString -> (JSVal -> IO ()) -> (MisoString -> IO ()) -> IO ()
FFI.cookieGet MisoString
name
    (\JSVal
v -> JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
v IO (Maybe MisoString) -> (Maybe MisoString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Either MisoString (Maybe MisoString))
-> Either MisoString (Maybe MisoString) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString (Maybe MisoString))
mvar (Either MisoString (Maybe MisoString) -> IO ())
-> (Maybe MisoString -> Either MisoString (Maybe MisoString))
-> Maybe MisoString
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe MisoString -> Either MisoString (Maybe MisoString)
forall a b. b -> Either a b
Right)
    (\MisoString
e -> MVar (Either MisoString (Maybe MisoString))
-> Either MisoString (Maybe MisoString) -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString (Maybe MisoString))
mvar (MisoString -> Either MisoString (Maybe MisoString)
forall a b. a -> Either a b
Left MisoString
e))
  MVar (Either MisoString (Maybe MisoString))
-> IO (Either MisoString (Maybe MisoString))
forall a. MVar a -> IO a
takeMVar MVar (Either MisoString (Maybe MisoString))
mvar
{-# INLINE cookieGet_ #-}
-----------------------------------------------------------------------------
-- | Synchronous API variant of 'cookieDelete'.
--
-- Blocks the calling thread until the browser resolves the promise, returning
-- @'Right' ()@ on success or @'Left' err@ on failure.
--
-- __Note:__ best used with 'Miso.Effect.io' or 'Miso.Effect.io_', to avoid blocking the scheduler thread.
--
-- @since 1.13.0.0
cookieDelete_ :: MisoString -> IO (Either MisoString ())
cookieDelete_ :: MisoString -> IO (Either MisoString ())
cookieDelete_ MisoString
name = do
  MVar (Either MisoString ())
mvar <- IO (MVar (Either MisoString ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString ()))
  MisoString -> IO () -> (MisoString -> IO ()) -> IO ()
FFI.cookieDelete MisoString
name
    (MVar (Either MisoString ()) -> Either MisoString () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString ())
mvar (() -> Either MisoString ()
forall a b. b -> Either a b
Right ()))
    (\MisoString
e -> MVar (Either MisoString ()) -> Either MisoString () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString ())
mvar (MisoString -> Either MisoString ()
forall a b. a -> Either a b
Left MisoString
e))
  MVar (Either MisoString ()) -> IO (Either MisoString ())
forall a. MVar a -> IO a
takeMVar MVar (Either MisoString ())
mvar
{-# INLINE cookieDelete_ #-}
-----------------------------------------------------------------------------
-- | Synchronous API variant of 'cookieDeleteWith'.
--
-- Blocks the calling thread until the browser resolves the promise, returning
-- @'Right' ()@ on success or @'Left' err@ on failure.
--
-- __Note:__ best used with 'Miso.Effect.io' or 'Miso.Effect.io_', to avoid blocking the scheduler thread.
--
-- @since 1.13.0.0
cookieDeleteWith_ :: Cookie -> IO (Either MisoString ())
cookieDeleteWith_ :: Cookie -> IO (Either MisoString ())
cookieDeleteWith_ Cookie
cookie = do
  MVar (Either MisoString ())
mvar <- IO (MVar (Either MisoString ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString ()))
  JSVal
c_ <- Cookie -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Cookie
cookie
  JSVal -> IO () -> (MisoString -> IO ()) -> IO ()
FFI.cookieDeleteWith JSVal
c_
    (MVar (Either MisoString ()) -> Either MisoString () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString ())
mvar (() -> Either MisoString ()
forall a b. b -> Either a b
Right ()))
    (\MisoString
e -> MVar (Either MisoString ()) -> Either MisoString () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString ())
mvar (MisoString -> Either MisoString ()
forall a b. a -> Either a b
Left MisoString
e))
  MVar (Either MisoString ()) -> IO (Either MisoString ())
forall a. MVar a -> IO a
takeMVar MVar (Either MisoString ())
mvar
{-# INLINE cookieDeleteWith_ #-}
-----------------------------------------------------------------------------
-- | Synchronous API variant of 'cookieGetAll'.
--
-- Blocks the calling thread until the browser resolves the promise, returning
-- @'Right' cookies@ on success or @'Left' err@ on failure.
--
-- __Note:__ best used with 'Miso.Effect.io' or 'Miso.Effect.io_', to avoid blocking the scheduler thread.
--
-- @since 1.13.0.0
cookieGetAll_ :: IO (Either MisoString [Cookie])
cookieGetAll_ :: IO (Either MisoString [Cookie])
cookieGetAll_ = do
  MVar (Either MisoString [Cookie])
mvar <- IO (MVar (Either MisoString [Cookie]))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString [Cookie]))
  (JSVal -> IO ()) -> (MisoString -> IO ()) -> IO ()
FFI.cookieGetAll
    (\JSVal
v -> JSVal -> IO [Cookie]
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
v IO [Cookie] -> ([Cookie] -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MVar (Either MisoString [Cookie])
-> Either MisoString [Cookie] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString [Cookie])
mvar (Either MisoString [Cookie] -> IO ())
-> ([Cookie] -> Either MisoString [Cookie]) -> [Cookie] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Cookie] -> Either MisoString [Cookie]
forall a b. b -> Either a b
Right)
    (\MisoString
e -> MVar (Either MisoString [Cookie])
-> Either MisoString [Cookie] -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Either MisoString [Cookie])
mvar (MisoString -> Either MisoString [Cookie]
forall a b. a -> Either a b
Left MisoString
e))
  MVar (Either MisoString [Cookie])
-> IO (Either MisoString [Cookie])
forall a. MVar a -> IO a
takeMVar MVar (Either MisoString [Cookie])
mvar
{-# INLINE cookieGetAll_ #-}
-----------------------------------------------------------------------------