{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Miso.Cookie
(
Cookie (..)
, CookieChangeEvent (..)
, cookieGet
, cookieGetAll
, cookieSet
, cookieDelete
, cookieDeleteWith
, defaultCookie
, 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
data Cookie = Cookie
{ Cookie -> MisoString
cookieName :: MisoString
, Cookie -> Maybe MisoString
cookieValue :: Maybe MisoString
, Cookie -> Maybe MisoString
cookieDomain :: Maybe MisoString
, Cookie -> MisoString
cookiePath :: MisoString
, Cookie -> Maybe Double
cookieExpires :: Maybe Double
, Cookie -> Bool
cookieSecure :: Bool
, Cookie -> MisoString
cookieSameSite :: MisoString
, Cookie -> Bool
cookiePartitioned :: Bool
} 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
o <- IO Object
create
FFI.set "name" cookieName o
FFI.set "value" cookieValue o
FFI.set "path" cookiePath o
FFI.set "secure" cookieSecure o
FFI.set "sameSite" cookieSameSite o
FFI.set "partitioned" cookiePartitioned o
forM_ cookieDomain $ \MisoString
d -> MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"domain" MisoString
d Object
o
forM_ cookieExpires $ \Double
e -> MisoString -> Double -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"expires" Double
e Object
o
toJSVal o
{-# INLINE toJSVal #-}
instance FromJSVal Cookie where
fromJSVal :: JSVal -> IO (Maybe Cookie)
fromJSVal JSVal
v = do
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"
value_ <- fromJSVal =<< v ! "value"
domain_ <- fromJSVal =<< v ! "domain"
path_ <- fromJSVal =<< v ! "path"
expires_ <- fromJSVal =<< v ! "expires"
secure_ <- fromJSVal =<< v ! "secure"
sameSite_ <- fromJSVal =<< v ! "sameSite"
partitioned_ <- fromJSVal =<< v ! "partitioned"
pure $ do
n <- name_
vl <- value_
p <- path_
sec <- secure_
ss <- sameSite_
par <- partitioned_
pure Cookie
{ cookieName = n
, cookieValue = vl
, cookieDomain = join domain_
, cookiePath = p
, cookieExpires = join expires_
, cookieSecure = sec
, cookieSameSite = ss
, cookiePartitioned = par
}
{-# INLINE fromJSVal #-}
data CookieChangeEvent = CookieChangeEvent
{ CookieChangeEvent -> [Cookie]
cookiesChanged :: [Cookie]
, CookieChangeEvent -> [Cookie]
cookiesDeleted :: [Cookie]
} 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
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"
deleted_ <- fromJSValUnchecked =<< ev ! "deleted"
pure (CookieChangeEvent <$> changed_ <*> 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
o <- IO Object
create
FFI.set "changed" cookiesChanged o
FFI.set "deleted" cookiesDeleted o
toJSVal 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 #-}
cookieGet
:: MisoString
-> (Maybe MisoString -> action)
-> (MisoString -> action)
-> Effect parent props model action
cookieGet :: forall action parent props model.
MisoString
-> (Maybe MisoString -> action)
-> (MisoString -> action)
-> Effect parent props model action
cookieGet MisoString
name Maybe MisoString -> action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent 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)
cookieGetAll
:: ([Cookie] -> action)
-> (MisoString -> action)
-> Effect parent props model action
cookieGetAll :: forall action parent props model.
([Cookie] -> action)
-> (MisoString -> action) -> Effect parent props model action
cookieGetAll [Cookie] -> action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent 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)
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
}
cookieSet
:: Cookie
-> action
-> (MisoString -> action)
-> Effect parent props model action
cookieSet :: forall action parent props model.
Cookie
-> action
-> (MisoString -> action)
-> Effect parent props model action
cookieSet Cookie
cookie action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
c_ <- Cookie -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Cookie
cookie
FFI.cookieSet c_ (sink successful) (sink . errorful)
cookieDelete
:: MisoString
-> action
-> (MisoString -> action)
-> Effect parent props model action
cookieDelete :: forall action parent props model.
MisoString
-> action
-> (MisoString -> action)
-> Effect parent props model action
cookieDelete MisoString
name action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent 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)
cookieDeleteWith
:: Cookie
-> action
-> (MisoString -> action)
-> Effect parent props model action
cookieDeleteWith :: forall action parent props model.
Cookie
-> action
-> (MisoString -> action)
-> Effect parent props model action
cookieDeleteWith Cookie
cookie action
successful MisoString -> action
errorful = (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
c_ <- Cookie -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Cookie
cookie
FFI.cookieDeleteWith c_ (sink successful) (sink . errorful)
cookieSet_ :: Cookie -> IO (Either MisoString ())
cookieSet_ :: Cookie -> IO (Either MisoString ())
cookieSet_ Cookie
cookie = do
mvar <- IO (MVar (Either MisoString ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString ()))
c_ <- toJSVal cookie
FFI.cookieSet c_
(putMVar mvar (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))
takeMVar mvar
{-# INLINE cookieSet_ #-}
cookieGet_ :: MisoString -> IO (Either MisoString (Maybe MisoString))
cookieGet_ :: MisoString -> IO (Either MisoString (Maybe MisoString))
cookieGet_ MisoString
name = do
mvar <- IO (MVar (Either MisoString (Maybe MisoString)))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString (Maybe MisoString)))
FFI.cookieGet 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))
takeMVar mvar
{-# INLINE cookieGet_ #-}
cookieDelete_ :: MisoString -> IO (Either MisoString ())
cookieDelete_ :: MisoString -> IO (Either MisoString ())
cookieDelete_ MisoString
name = do
mvar <- IO (MVar (Either MisoString ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString ()))
FFI.cookieDelete name
(putMVar mvar (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))
takeMVar mvar
{-# INLINE cookieDelete_ #-}
cookieDeleteWith_ :: Cookie -> IO (Either MisoString ())
cookieDeleteWith_ :: Cookie -> IO (Either MisoString ())
cookieDeleteWith_ Cookie
cookie = do
mvar <- IO (MVar (Either MisoString ()))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString ()))
c_ <- toJSVal cookie
FFI.cookieDeleteWith c_
(putMVar mvar (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))
takeMVar mvar
{-# INLINE cookieDeleteWith_ #-}
cookieGetAll_ :: IO (Either MisoString [Cookie])
cookieGetAll_ :: IO (Either MisoString [Cookie])
cookieGetAll_ = do
mvar <- IO (MVar (Either MisoString [Cookie]))
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar (Either MisoString [Cookie]))
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))
takeMVar mvar
{-# INLINE cookieGetAll_ #-}