module IHP.AutoRefresh where
import IHP.Prelude
import IHP.AutoRefresh.Types
import qualified Data.TMap as TypeMap
import IHP.ControllerSupport
import IHP.ApplicationContext
import qualified Data.UUID.V4 as UUID
import qualified Data.UUID as UUID
import IHP.Controller.Session
import qualified Network.WebSockets as Websocket
import qualified Network.Wai.Handler.WebSockets as Websocket
import qualified Network.Wai.Internal as Wai
import IHP.ControllerSupport
import qualified Data.Binary.Builder as ByteString
import qualified Control.Concurrent as Concurrent
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.Types as PG
import qualified Database.PostgreSQL.Simple.Notification as PG
import qualified Data.Set as Set
import IHP.ModelSupport
import qualified Control.Exception as Exception
import Control.Monad (void)
import Control.Concurrent.Async
import qualified Control.Concurrent.MVar as MVar
import qualified Data.Maybe as Maybe
import qualified Data.Text as Text
import IHP.WebSocket
import qualified IHP.PGNotify as PGNotify
import IHP.Controller.Context
initAutoRefresh :: (?context :: ControllerContext, ?applicationContext :: ApplicationContext) => IO ()
initAutoRefresh :: IO ()
initAutoRefresh = do
AutoRefreshState -> IO ()
forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext AutoRefreshState
AutoRefreshDisabled
IORef AutoRefreshServer -> IO ()
forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext (?applicationContext::ApplicationContext
ApplicationContext
?applicationContext ApplicationContext
-> (ApplicationContext -> IORef AutoRefreshServer)
-> IORef AutoRefreshServer
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "autoRefreshServer"
-> ApplicationContext -> IORef AutoRefreshServer
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "autoRefreshServer" (Proxy "autoRefreshServer")
Proxy "autoRefreshServer"
#autoRefreshServer)
autoRefresh :: (
?theAction :: action
, Controller action
, ?modelContext :: ModelContext
, ?context :: ControllerContext
) => ((?modelContext :: ModelContext) => IO ()) -> IO ()
autoRefresh :: ((?modelContext::ModelContext) => IO ()) -> IO ()
autoRefresh (?modelContext::ModelContext) => IO ()
runAction = do
AutoRefreshState
autoRefreshState <- (?context::ControllerContext, Typeable AutoRefreshState) =>
IO AutoRefreshState
forall value.
(?context::ControllerContext, Typeable value) =>
IO value
fromContext @AutoRefreshState
IORef AutoRefreshServer
autoRefreshServer <- (?context::ControllerContext,
Typeable (IORef AutoRefreshServer)) =>
IO (IORef AutoRefreshServer)
forall value.
(?context::ControllerContext, Typeable value) =>
IO value
fromContext @(IORef AutoRefreshServer)
case AutoRefreshState
autoRefreshState of
AutoRefreshState
AutoRefreshDisabled -> do
[UUID]
availableSessions <- (?context::ControllerContext) =>
IORef AutoRefreshServer -> IO [UUID]
IORef AutoRefreshServer -> IO [UUID]
getAvailableSessions IORef AutoRefreshServer
autoRefreshServer
UUID
id <- IO UUID
UUID.nextRandom
ControllerContext
frozenControllerContext <- ControllerContext -> IO ControllerContext
freeze ?context::ControllerContext
ControllerContext
?context
let renderView :: RequestContext -> IO ()
renderView = \RequestContext
requestContext -> do
ControllerContext
controllerContext <- ControllerContext -> IO ControllerContext
unfreeze ControllerContext
frozenControllerContext
let ?context = controllerContext { requestContext }
action -> IO ()
forall controller.
(Controller controller, ?context::ControllerContext,
?modelContext::ModelContext, ?theAction::controller) =>
controller -> IO ()
action action
?theAction::action
?theAction
AutoRefreshState -> IO ()
forall value.
(?context::ControllerContext, Typeable value) =>
value -> IO ()
putContext (UUID -> AutoRefreshState
AutoRefreshEnabled UUID
id)
(?context::ControllerContext) => Text -> Text -> IO ()
Text -> Text -> IO ()
setSession Text
"autoRefreshSessions" ((UUID -> Text) -> [UUID] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map UUID -> Text
UUID.toText (UUID
idUUID -> [UUID] -> [UUID]
forall a. a -> [a] -> [a]
:[UUID]
availableSessions) [Text] -> ([Text] -> Text) -> Text
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Text -> [Text] -> Text
Text.intercalate Text
"")
(?modelContext::ModelContext) =>
((?modelContext::ModelContext,
?touchedTables::IORef (Set ByteString)) =>
IO ())
-> IO ()
((?modelContext::ModelContext,
?touchedTables::IORef (Set ByteString)) =>
IO ())
-> IO ()
withTableReadTracker do
let handleResponse :: ResponseException -> IO ()
handleResponse exception :: ResponseException
exception@(ResponseException Response
response) = case Response
response of
Wai.ResponseBuilder Status
status ResponseHeaders
headers Builder
builder -> do
Set ByteString
tables <- IORef (Set ByteString) -> IO (Set ByteString)
forall a. IORef a -> IO a
readIORef ?touchedTables::IORef (Set ByteString)
IORef (Set ByteString)
?touchedTables
UTCTime
lastPing <- IO UTCTime
getCurrentTime
let lastResponse :: ByteString
lastResponse = Builder -> ByteString
ByteString.toLazyByteString Builder
builder
MVar ()
event <- IO (MVar ())
forall a. IO (MVar a)
MVar.newEmptyMVar
let session :: AutoRefreshSession
session = AutoRefreshSession :: UUID
-> (RequestContext -> IO ())
-> MVar ()
-> Set ByteString
-> ByteString
-> UTCTime
-> AutoRefreshSession
AutoRefreshSession { UUID
$sel:id:AutoRefreshSession :: UUID
id :: UUID
id, RequestContext -> IO ()
$sel:renderView:AutoRefreshSession :: RequestContext -> IO ()
renderView :: RequestContext -> IO ()
renderView, MVar ()
$sel:event:AutoRefreshSession :: MVar ()
event :: MVar ()
event, Set ByteString
$sel:tables:AutoRefreshSession :: Set ByteString
tables :: Set ByteString
tables, ByteString
$sel:lastResponse:AutoRefreshSession :: ByteString
lastResponse :: ByteString
lastResponse, UTCTime
$sel:lastPing:AutoRefreshSession :: UTCTime
lastPing :: UTCTime
lastPing }
IORef AutoRefreshServer
-> (AutoRefreshServer -> AutoRefreshServer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef AutoRefreshServer
autoRefreshServer (\AutoRefreshServer
s -> AutoRefreshServer
s { $sel:sessions:AutoRefreshServer :: [AutoRefreshSession]
sessions = AutoRefreshSession
sessionAutoRefreshSession -> [AutoRefreshSession] -> [AutoRefreshSession]
forall a. a -> [a] -> [a]
:(Proxy "sessions" -> AutoRefreshServer -> [AutoRefreshSession]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sessions" (Proxy "sessions")
Proxy "sessions"
#sessions AutoRefreshServer
s) } )
IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async (IORef AutoRefreshServer -> IO ()
gcSessions IORef AutoRefreshServer
autoRefreshServer)
(?modelContext::ModelContext) =>
IORef (Set ByteString) -> IORef AutoRefreshServer -> IO ()
IORef (Set ByteString) -> IORef AutoRefreshServer -> IO ()
registerNotificationTrigger ?touchedTables::IORef (Set ByteString)
IORef (Set ByteString)
?touchedTables IORef AutoRefreshServer
autoRefreshServer
ResponseException -> IO ()
forall a e. Exception e => e -> a
throw ResponseException
exception
Response
_ -> Text -> IO ()
forall a. Text -> a
error Text
"Unimplemented WAI response type."
IO ()
(?modelContext::ModelContext) => IO ()
runAction IO () -> (ResponseException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exception.catch` ResponseException -> IO ()
handleResponse
AutoRefreshEnabled {} -> do
IO ()
(?modelContext::ModelContext) => IO ()
runAction
data AutoRefreshWSApp = AwaitingSessionID | AutoRefreshActive { AutoRefreshWSApp -> UUID
sessionId :: UUID }
instance WSApp AutoRefreshWSApp where
initialState :: AutoRefreshWSApp
initialState = AutoRefreshWSApp
AwaitingSessionID
run :: IO ()
run = do
UUID
sessionId <- (?connection::Connection, WebSocketsData UUID) => IO UUID
forall a. (?connection::Connection, WebSocketsData a) => IO a
receiveData @UUID
AutoRefreshWSApp -> IO ()
forall state. (?state::IORef state) => state -> IO ()
setState AutoRefreshActive :: UUID -> AutoRefreshWSApp
AutoRefreshActive { UUID
sessionId :: UUID
$sel:sessionId:AwaitingSessionID :: UUID
sessionId }
[UUID]
availableSessions <- ?applicationContext::ApplicationContext
ApplicationContext
?applicationContext
ApplicationContext
-> (ApplicationContext -> IORef AutoRefreshServer)
-> IORef AutoRefreshServer
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "autoRefreshServer"
-> ApplicationContext -> IORef AutoRefreshServer
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "autoRefreshServer" (Proxy "autoRefreshServer")
Proxy "autoRefreshServer"
#autoRefreshServer
IORef AutoRefreshServer
-> (IORef AutoRefreshServer -> IO [UUID]) -> IO [UUID]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (?context::ControllerContext) =>
IORef AutoRefreshServer -> IO [UUID]
IORef AutoRefreshServer -> IO [UUID]
getAvailableSessions
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UUID
sessionId UUID -> [UUID] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UUID]
availableSessions) do
AutoRefreshSession { RequestContext -> IO ()
renderView :: RequestContext -> IO ()
$sel:renderView:AutoRefreshSession :: AutoRefreshSession -> RequestContext -> IO ()
renderView, MVar ()
event :: MVar ()
$sel:event:AutoRefreshSession :: AutoRefreshSession -> MVar ()
event, ByteString
lastResponse :: ByteString
$sel:lastResponse:AutoRefreshSession :: AutoRefreshSession -> ByteString
lastResponse } <- (?applicationContext::ApplicationContext) =>
UUID -> IO AutoRefreshSession
UUID -> IO AutoRefreshSession
getSessionById UUID
sessionId
let handleResponseException :: ResponseException -> IO ()
handleResponseException (ResponseException Response
response) = case Response
response of
Wai.ResponseBuilder Status
status ResponseHeaders
headers Builder
builder -> do
let html :: ByteString
html = Builder -> ByteString
ByteString.toLazyByteString Builder
builder
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
html ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
lastResponse) do
ByteString -> IO ()
forall text.
(?connection::Connection, WebSocketsData text) =>
text -> IO ()
sendTextData ByteString
html
(?applicationContext::ApplicationContext) =>
UUID -> (AutoRefreshSession -> AutoRefreshSession) -> IO ()
UUID -> (AutoRefreshSession -> AutoRefreshSession) -> IO ()
updateSession UUID
sessionId (\AutoRefreshSession
session -> AutoRefreshSession
session { $sel:lastResponse:AutoRefreshSession :: ByteString
lastResponse = ByteString
html })
Response
_ -> Text -> IO ()
forall a. Text -> a
error Text
"Unimplemented WAI response type."
IO Any -> IO (Async Any)
forall a. IO a -> IO (Async a)
async (IO Any -> IO (Async Any)) -> IO Any -> IO (Async Any)
forall a b. (a -> b) -> a -> b
$ IO () -> IO Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever do
MVar () -> IO ()
forall a. MVar a -> IO a
MVar.takeMVar MVar ()
event
let requestContext :: RequestContext
requestContext = Proxy "requestContext" -> ControllerContext -> RequestContext
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "requestContext" (Proxy "requestContext")
Proxy "requestContext"
#requestContext ?context::ControllerContext
ControllerContext
?context
(RequestContext -> IO ()
renderView RequestContext
requestContext) IO () -> (ResponseException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` ResponseException -> IO ()
handleResponseException
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
IO DataMessage -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever IO DataMessage
(?connection::Connection) => IO DataMessage
receiveDataMessage
onPing :: IO ()
onPing = do
UTCTime
now <- IO UTCTime
getCurrentTime
AutoRefreshActive { UUID
sessionId :: UUID
$sel:sessionId:AwaitingSessionID :: AutoRefreshWSApp -> UUID
sessionId } <- IO AutoRefreshWSApp
forall state. (?state::IORef state) => IO state
getState
(?applicationContext::ApplicationContext) =>
UUID -> (AutoRefreshSession -> AutoRefreshSession) -> IO ()
UUID -> (AutoRefreshSession -> AutoRefreshSession) -> IO ()
updateSession UUID
sessionId (\AutoRefreshSession
session -> AutoRefreshSession
session { $sel:lastPing:AutoRefreshSession :: UTCTime
lastPing = UTCTime
now })
onClose :: IO ()
onClose = do
IO AutoRefreshWSApp
forall state. (?state::IORef state) => IO state
getState IO AutoRefreshWSApp -> (AutoRefreshWSApp -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
AutoRefreshActive { UUID
sessionId :: UUID
$sel:sessionId:AwaitingSessionID :: AutoRefreshWSApp -> UUID
sessionId } -> do
let autoRefreshServer :: IORef AutoRefreshServer
autoRefreshServer = ?applicationContext::ApplicationContext
ApplicationContext
?applicationContext ApplicationContext
-> (ApplicationContext -> IORef AutoRefreshServer)
-> IORef AutoRefreshServer
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "autoRefreshServer"
-> ApplicationContext -> IORef AutoRefreshServer
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "autoRefreshServer" (Proxy "autoRefreshServer")
Proxy "autoRefreshServer"
#autoRefreshServer
IORef AutoRefreshServer
-> (AutoRefreshServer -> AutoRefreshServer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef AutoRefreshServer
autoRefreshServer (\AutoRefreshServer
server -> AutoRefreshServer
server { $sel:sessions:AutoRefreshServer :: [AutoRefreshSession]
sessions = (AutoRefreshSession -> Bool)
-> [AutoRefreshSession] -> [AutoRefreshSession]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AutoRefreshSession { UUID
id :: UUID
$sel:id:AutoRefreshSession :: AutoRefreshSession -> UUID
id } -> UUID
id UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
/= UUID
sessionId) (Proxy "sessions" -> AutoRefreshServer -> [AutoRefreshSession]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sessions" (Proxy "sessions")
Proxy "sessions"
#sessions AutoRefreshServer
server) })
AutoRefreshWSApp
AwaitingSessionID -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
registerNotificationTrigger :: (?modelContext :: ModelContext) => IORef (Set ByteString) -> IORef AutoRefreshServer -> IO ()
registerNotificationTrigger :: IORef (Set ByteString) -> IORef AutoRefreshServer -> IO ()
registerNotificationTrigger IORef (Set ByteString)
touchedTablesVar IORef AutoRefreshServer
autoRefreshServer = do
[ByteString]
touchedTables <- Set ByteString -> [ByteString]
forall a. Set a -> [a]
Set.toList (Set ByteString -> [ByteString])
-> IO (Set ByteString) -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Set ByteString) -> IO (Set ByteString)
forall a. IORef a -> IO a
readIORef IORef (Set ByteString)
touchedTablesVar
Set ByteString
subscribedTables <- (Proxy "subscribedTables" -> AutoRefreshServer -> Set ByteString
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "subscribedTables" (Proxy "subscribedTables")
Proxy "subscribedTables"
#subscribedTables) (AutoRefreshServer -> Set ByteString)
-> IO AutoRefreshServer -> IO (Set ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IORef AutoRefreshServer
autoRefreshServer IORef AutoRefreshServer
-> (IORef AutoRefreshServer -> IO AutoRefreshServer)
-> IO AutoRefreshServer
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> IORef AutoRefreshServer -> IO AutoRefreshServer
forall a. IORef a -> IO a
readIORef)
let subscriptionRequired :: [ByteString]
subscriptionRequired = [ByteString]
touchedTables [ByteString] -> ([ByteString] -> [ByteString]) -> [ByteString]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ByteString
table -> Set ByteString
subscribedTables Set ByteString -> (Set ByteString -> Bool) -> Bool
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember ByteString
table)
IORef AutoRefreshServer
-> (AutoRefreshServer -> AutoRefreshServer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef AutoRefreshServer
autoRefreshServer (\AutoRefreshServer
server -> AutoRefreshServer
server { $sel:subscribedTables:AutoRefreshServer :: Set ByteString
subscribedTables = Proxy "subscribedTables" -> AutoRefreshServer -> Set ByteString
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "subscribedTables" (Proxy "subscribedTables")
Proxy "subscribedTables"
#subscribedTables AutoRefreshServer
server Set ByteString -> Set ByteString -> Set ByteString
forall a. Semigroup a => a -> a -> a
<> [ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
Set.fromList [ByteString]
subscriptionRequired })
[Async ()]
subscriptions <- [ByteString]
subscriptionRequired [ByteString] -> ([ByteString] -> IO [Async ()]) -> IO [Async ()]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (ByteString -> IO (Async ())) -> [ByteString] -> IO [Async ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ByteString
table -> (?modelContext::ModelContext) =>
ByteString -> IO () -> IO (Async ())
ByteString -> IO () -> IO (Async ())
PGNotify.watchInsertOrUpdateTable ByteString
table do
[AutoRefreshSession]
sessions <- (Proxy "sessions" -> AutoRefreshServer -> [AutoRefreshSession]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sessions" (Proxy "sessions")
Proxy "sessions"
#sessions) (AutoRefreshServer -> [AutoRefreshSession])
-> IO AutoRefreshServer -> IO [AutoRefreshSession]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef AutoRefreshServer -> IO AutoRefreshServer
forall a. IORef a -> IO a
readIORef IORef AutoRefreshServer
autoRefreshServer
[AutoRefreshSession]
sessions
[AutoRefreshSession]
-> ([AutoRefreshSession] -> [AutoRefreshSession])
-> [AutoRefreshSession]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (AutoRefreshSession -> Bool)
-> [AutoRefreshSession] -> [AutoRefreshSession]
forall a. (a -> Bool) -> [a] -> [a]
filter (\AutoRefreshSession
session -> ByteString
table ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` (Proxy "tables" -> AutoRefreshSession -> Set ByteString
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "tables" (Proxy "tables")
Proxy "tables"
#tables AutoRefreshSession
session))
[AutoRefreshSession]
-> ([AutoRefreshSession] -> [MVar ()]) -> [MVar ()]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (AutoRefreshSession -> MVar ())
-> [AutoRefreshSession] -> [MVar ()]
forall a b. (a -> b) -> [a] -> [b]
map (\AutoRefreshSession
session -> Proxy "event" -> AutoRefreshSession -> MVar ()
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "event" (Proxy "event")
Proxy "event"
#event AutoRefreshSession
session)
[MVar ()] -> ([MVar ()] -> IO [Bool]) -> IO [Bool]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (MVar () -> IO Bool) -> [MVar ()] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\MVar ()
event -> MVar () -> () -> IO Bool
forall a. MVar a -> a -> IO Bool
MVar.tryPutMVar MVar ()
event ())
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
IORef AutoRefreshServer
-> (AutoRefreshServer -> AutoRefreshServer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef AutoRefreshServer
autoRefreshServer (\AutoRefreshServer
s -> AutoRefreshServer
s { $sel:subscriptions:AutoRefreshServer :: [Async ()]
subscriptions = Proxy "subscriptions" -> AutoRefreshServer -> [Async ()]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "subscriptions" (Proxy "subscriptions")
Proxy "subscriptions"
#subscriptions AutoRefreshServer
s [Async ()] -> [Async ()] -> [Async ()]
forall a. Semigroup a => a -> a -> a
<> [Async ()]
subscriptions })
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
getAvailableSessions :: (?context :: ControllerContext) => IORef AutoRefreshServer -> IO [UUID]
getAvailableSessions :: IORef AutoRefreshServer -> IO [UUID]
getAvailableSessions IORef AutoRefreshServer
autoRefreshServer = do
[AutoRefreshSession]
allSessions <- (Proxy "sessions" -> AutoRefreshServer -> [AutoRefreshSession]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sessions" (Proxy "sessions")
Proxy "sessions"
#sessions) (AutoRefreshServer -> [AutoRefreshSession])
-> IO AutoRefreshServer -> IO [AutoRefreshSession]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef AutoRefreshServer -> IO AutoRefreshServer
forall a. IORef a -> IO a
readIORef IORef AutoRefreshServer
autoRefreshServer
Text
text <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> IO (Maybe Text) -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (?context::ControllerContext) => Text -> IO (Maybe Text)
Text -> IO (Maybe Text)
getSession Text
"autoRefreshSessions"
let uuidCharCount :: Int
uuidCharCount = Text -> Int
Text.length (UUID -> Text
UUID.toText UUID
UUID.nil)
let allSessionIds :: [UUID]
allSessionIds = (AutoRefreshSession -> UUID) -> [AutoRefreshSession] -> [UUID]
forall a b. (a -> b) -> [a] -> [b]
map (Proxy "id" -> AutoRefreshSession -> UUID
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "id" (Proxy "id")
Proxy "id"
#id) [AutoRefreshSession]
allSessions
Text
text
Text -> (Text -> [Text]) -> [Text]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Int -> Text -> [Text]
Text.chunksOf Int
uuidCharCount
[Text] -> ([Text] -> [UUID]) -> [UUID]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Text -> Maybe UUID) -> [Text] -> [UUID]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe UUID
UUID.fromText
[UUID] -> ([UUID] -> [UUID]) -> [UUID]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (UUID -> Bool) -> [UUID] -> [UUID]
forall a. (a -> Bool) -> [a] -> [a]
filter (\UUID
id -> UUID
id UUID -> [UUID] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UUID]
allSessionIds)
[UUID] -> ([UUID] -> IO [UUID]) -> IO [UUID]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> [UUID] -> IO [UUID]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
getSessionById :: (?applicationContext :: ApplicationContext) => UUID -> IO AutoRefreshSession
getSessionById :: UUID -> IO AutoRefreshSession
getSessionById UUID
sessionId = do
AutoRefreshServer
autoRefreshServer <- ?applicationContext::ApplicationContext
ApplicationContext
?applicationContext
ApplicationContext
-> (ApplicationContext -> IORef AutoRefreshServer)
-> IORef AutoRefreshServer
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "autoRefreshServer"
-> ApplicationContext -> IORef AutoRefreshServer
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "autoRefreshServer" (Proxy "autoRefreshServer")
Proxy "autoRefreshServer"
#autoRefreshServer
IORef AutoRefreshServer
-> (IORef AutoRefreshServer -> IO AutoRefreshServer)
-> IO AutoRefreshServer
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> IORef AutoRefreshServer -> IO AutoRefreshServer
forall a. IORef a -> IO a
readIORef
AutoRefreshServer
autoRefreshServer
AutoRefreshServer
-> (AutoRefreshServer -> [AutoRefreshSession])
-> [AutoRefreshSession]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "sessions" -> AutoRefreshServer -> [AutoRefreshSession]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sessions" (Proxy "sessions")
Proxy "sessions"
#sessions
[AutoRefreshSession]
-> ([AutoRefreshSession] -> Maybe AutoRefreshSession)
-> Maybe AutoRefreshSession
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (AutoRefreshSession -> Bool)
-> [AutoRefreshSession] -> Maybe AutoRefreshSession
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\AutoRefreshSession { UUID
id :: UUID
$sel:id:AutoRefreshSession :: AutoRefreshSession -> UUID
id } -> UUID
id UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
sessionId)
Maybe AutoRefreshSession
-> (Maybe AutoRefreshSession -> AutoRefreshSession)
-> AutoRefreshSession
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> AutoRefreshSession
-> Maybe AutoRefreshSession -> AutoRefreshSession
forall a. a -> Maybe a -> a
Maybe.fromMaybe (Text -> AutoRefreshSession
forall a. Text -> a
error Text
"getSessionById: Could not find the session")
AutoRefreshSession
-> (AutoRefreshSession -> IO AutoRefreshSession)
-> IO AutoRefreshSession
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> AutoRefreshSession -> IO AutoRefreshSession
forall (f :: * -> *) a. Applicative f => a -> f a
pure
updateSession :: (?applicationContext :: ApplicationContext) => UUID -> (AutoRefreshSession -> AutoRefreshSession) -> IO ()
updateSession :: UUID -> (AutoRefreshSession -> AutoRefreshSession) -> IO ()
updateSession UUID
sessionId AutoRefreshSession -> AutoRefreshSession
updateFunction = do
let server :: IORef AutoRefreshServer
server = ?applicationContext::ApplicationContext
ApplicationContext
?applicationContext ApplicationContext
-> (ApplicationContext -> IORef AutoRefreshServer)
-> IORef AutoRefreshServer
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "autoRefreshServer"
-> ApplicationContext -> IORef AutoRefreshServer
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "autoRefreshServer" (Proxy "autoRefreshServer")
Proxy "autoRefreshServer"
#autoRefreshServer
let updateSession' :: AutoRefreshSession -> AutoRefreshSession
updateSession' AutoRefreshSession
session = if Proxy "id" -> AutoRefreshSession -> UUID
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "id" (Proxy "id")
Proxy "id"
#id AutoRefreshSession
session UUID -> UUID -> Bool
forall a. Eq a => a -> a -> Bool
== UUID
sessionId then AutoRefreshSession -> AutoRefreshSession
updateFunction AutoRefreshSession
session else AutoRefreshSession
session
IORef AutoRefreshServer
-> (AutoRefreshServer -> AutoRefreshServer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef AutoRefreshServer
server (\AutoRefreshServer
server -> AutoRefreshServer
server { $sel:sessions:AutoRefreshServer :: [AutoRefreshSession]
sessions = (AutoRefreshSession -> AutoRefreshSession)
-> [AutoRefreshSession] -> [AutoRefreshSession]
forall a b. (a -> b) -> [a] -> [b]
map AutoRefreshSession -> AutoRefreshSession
updateSession' (Proxy "sessions" -> AutoRefreshServer -> [AutoRefreshSession]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sessions" (Proxy "sessions")
Proxy "sessions"
#sessions AutoRefreshServer
server) })
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
gcSessions :: IORef AutoRefreshServer -> IO ()
gcSessions :: IORef AutoRefreshServer -> IO ()
gcSessions IORef AutoRefreshServer
autoRefreshServer = do
UTCTime
now <- IO UTCTime
getCurrentTime
IORef AutoRefreshServer
-> (AutoRefreshServer -> AutoRefreshServer) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef AutoRefreshServer
autoRefreshServer (\AutoRefreshServer
autoRefreshServer -> AutoRefreshServer
autoRefreshServer { $sel:sessions:AutoRefreshServer :: [AutoRefreshSession]
sessions = (AutoRefreshSession -> Bool)
-> [AutoRefreshSession] -> [AutoRefreshSession]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (AutoRefreshSession -> Bool) -> AutoRefreshSession -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UTCTime -> AutoRefreshSession -> Bool
isSessionExpired UTCTime
now) (Proxy "sessions" -> AutoRefreshServer -> [AutoRefreshSession]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "sessions" (Proxy "sessions")
Proxy "sessions"
#sessions AutoRefreshServer
autoRefreshServer) })
isSessionExpired :: UTCTime -> AutoRefreshSession -> Bool
isSessionExpired :: UTCTime -> AutoRefreshSession -> Bool
isSessionExpired UTCTime
now AutoRefreshSession { UTCTime
lastPing :: UTCTime
$sel:lastPing:AutoRefreshSession :: AutoRefreshSession -> UTCTime
lastPing } = (UTCTime
now UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
lastPing) NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> (Pico -> NominalDiffTime
secondsToNominalDiffTime Pico
60)
stopAutoRefreshServer :: IORef AutoRefreshServer -> IO ()
stopAutoRefreshServer :: IORef AutoRefreshServer -> IO ()
stopAutoRefreshServer IORef AutoRefreshServer
autoRefreshServer =
IORef AutoRefreshServer -> IO AutoRefreshServer
forall a. IORef a -> IO a
readIORef IORef AutoRefreshServer
autoRefreshServer IO AutoRefreshServer -> (AutoRefreshServer -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\AutoRefreshServer
autoRefreshServer -> AutoRefreshServer
autoRefreshServer AutoRefreshServer
-> (AutoRefreshServer -> [Async ()]) -> [Async ()]
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> Proxy "subscriptions" -> AutoRefreshServer -> [Async ()]
forall model (name :: Symbol) value.
(KnownSymbol name, HasField name model value) =>
Proxy name -> model -> value
get IsLabel "subscriptions" (Proxy "subscriptions")
Proxy "subscriptions"
#subscriptions [Async ()] -> ([Async ()] -> IO ()) -> IO ()
forall t1 t2. t1 -> (t1 -> t2) -> t2
|> (Async () -> IO ()) -> [Async ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async () -> IO ()
forall a. Async a -> IO ()
uninterruptibleCancel)