{-# LANGUAGE DuplicateRecordFields #-}

module Cachix.API.WebSocketSubprotocol where

import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.STM.TMQueue as TMQueue
import qualified Control.Exception.Safe as Safe
import qualified Data.Aeson as Aeson
import Data.Time (UTCTime)
import Data.UUID (UUID)
import qualified Network.WebSockets as WS
import Protolude

data Message cmd = Message
  { forall cmd. Message cmd -> Text
method :: Text,
    forall cmd. Message cmd -> cmd
command :: cmd,
    forall cmd. Message cmd -> Maybe UUID
agent :: Maybe UUID,
    forall cmd. Message cmd -> UUID
id :: UUID
  }
  deriving (Int -> Message cmd -> ShowS
[Message cmd] -> ShowS
Message cmd -> String
(Int -> Message cmd -> ShowS)
-> (Message cmd -> String)
-> ([Message cmd] -> ShowS)
-> Show (Message cmd)
forall cmd. Show cmd => Int -> Message cmd -> ShowS
forall cmd. Show cmd => [Message cmd] -> ShowS
forall cmd. Show cmd => Message cmd -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall cmd. Show cmd => Int -> Message cmd -> ShowS
showsPrec :: Int -> Message cmd -> ShowS
$cshow :: forall cmd. Show cmd => Message cmd -> String
show :: Message cmd -> String
$cshowList :: forall cmd. Show cmd => [Message cmd] -> ShowS
showList :: [Message cmd] -> ShowS
Show, Message cmd -> Message cmd -> Bool
(Message cmd -> Message cmd -> Bool)
-> (Message cmd -> Message cmd -> Bool) -> Eq (Message cmd)
forall cmd. Eq cmd => Message cmd -> Message cmd -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall cmd. Eq cmd => Message cmd -> Message cmd -> Bool
== :: Message cmd -> Message cmd -> Bool
$c/= :: forall cmd. Eq cmd => Message cmd -> Message cmd -> Bool
/= :: Message cmd -> Message cmd -> Bool
Eq, (forall x. Message cmd -> Rep (Message cmd) x)
-> (forall x. Rep (Message cmd) x -> Message cmd)
-> Generic (Message cmd)
forall x. Rep (Message cmd) x -> Message cmd
forall x. Message cmd -> Rep (Message cmd) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall cmd x. Rep (Message cmd) x -> Message cmd
forall cmd x. Message cmd -> Rep (Message cmd) x
$cfrom :: forall cmd x. Message cmd -> Rep (Message cmd) x
from :: forall x. Message cmd -> Rep (Message cmd) x
$cto :: forall cmd x. Rep (Message cmd) x -> Message cmd
to :: forall x. Rep (Message cmd) x -> Message cmd
Generic, Maybe (Message cmd)
Value -> Parser [Message cmd]
Value -> Parser (Message cmd)
(Value -> Parser (Message cmd))
-> (Value -> Parser [Message cmd])
-> Maybe (Message cmd)
-> FromJSON (Message cmd)
forall cmd. FromJSON cmd => Maybe (Message cmd)
forall cmd. FromJSON cmd => Value -> Parser [Message cmd]
forall cmd. FromJSON cmd => Value -> Parser (Message cmd)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall cmd. FromJSON cmd => Value -> Parser (Message cmd)
parseJSON :: Value -> Parser (Message cmd)
$cparseJSONList :: forall cmd. FromJSON cmd => Value -> Parser [Message cmd]
parseJSONList :: Value -> Parser [Message cmd]
$comittedField :: forall cmd. FromJSON cmd => Maybe (Message cmd)
omittedField :: Maybe (Message cmd)
Aeson.FromJSON, [Message cmd] -> Value
[Message cmd] -> Encoding
Message cmd -> Bool
Message cmd -> Value
Message cmd -> Encoding
(Message cmd -> Value)
-> (Message cmd -> Encoding)
-> ([Message cmd] -> Value)
-> ([Message cmd] -> Encoding)
-> (Message cmd -> Bool)
-> ToJSON (Message cmd)
forall cmd. ToJSON cmd => [Message cmd] -> Value
forall cmd. ToJSON cmd => [Message cmd] -> Encoding
forall cmd. ToJSON cmd => Message cmd -> Bool
forall cmd. ToJSON cmd => Message cmd -> Value
forall cmd. ToJSON cmd => Message cmd -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall cmd. ToJSON cmd => Message cmd -> Value
toJSON :: Message cmd -> Value
$ctoEncoding :: forall cmd. ToJSON cmd => Message cmd -> Encoding
toEncoding :: Message cmd -> Encoding
$ctoJSONList :: forall cmd. ToJSON cmd => [Message cmd] -> Value
toJSONList :: [Message cmd] -> Value
$ctoEncodingList :: forall cmd. ToJSON cmd => [Message cmd] -> Encoding
toEncodingList :: [Message cmd] -> Encoding
$comitField :: forall cmd. ToJSON cmd => Message cmd -> Bool
omitField :: Message cmd -> Bool
Aeson.ToJSON)

data Cache = Cache
  { Cache -> Text
cacheName :: Text,
    Cache -> Text
publicKey :: Text,
    Cache -> Bool
isPublic :: Bool
  }
  deriving (Int -> Cache -> ShowS
[Cache] -> ShowS
Cache -> String
(Int -> Cache -> ShowS)
-> (Cache -> String) -> ([Cache] -> ShowS) -> Show Cache
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cache -> ShowS
showsPrec :: Int -> Cache -> ShowS
$cshow :: Cache -> String
show :: Cache -> String
$cshowList :: [Cache] -> ShowS
showList :: [Cache] -> ShowS
Show, Cache -> Cache -> Bool
(Cache -> Cache -> Bool) -> (Cache -> Cache -> Bool) -> Eq Cache
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cache -> Cache -> Bool
== :: Cache -> Cache -> Bool
$c/= :: Cache -> Cache -> Bool
/= :: Cache -> Cache -> Bool
Eq, (forall x. Cache -> Rep Cache x)
-> (forall x. Rep Cache x -> Cache) -> Generic Cache
forall x. Rep Cache x -> Cache
forall x. Cache -> Rep Cache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Cache -> Rep Cache x
from :: forall x. Cache -> Rep Cache x
$cto :: forall x. Rep Cache x -> Cache
to :: forall x. Rep Cache x -> Cache
Generic, Maybe Cache
Value -> Parser [Cache]
Value -> Parser Cache
(Value -> Parser Cache)
-> (Value -> Parser [Cache]) -> Maybe Cache -> FromJSON Cache
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Cache
parseJSON :: Value -> Parser Cache
$cparseJSONList :: Value -> Parser [Cache]
parseJSONList :: Value -> Parser [Cache]
$comittedField :: Maybe Cache
omittedField :: Maybe Cache
Aeson.FromJSON, [Cache] -> Value
[Cache] -> Encoding
Cache -> Bool
Cache -> Value
Cache -> Encoding
(Cache -> Value)
-> (Cache -> Encoding)
-> ([Cache] -> Value)
-> ([Cache] -> Encoding)
-> (Cache -> Bool)
-> ToJSON Cache
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Cache -> Value
toJSON :: Cache -> Value
$ctoEncoding :: Cache -> Encoding
toEncoding :: Cache -> Encoding
$ctoJSONList :: [Cache] -> Value
toJSONList :: [Cache] -> Value
$ctoEncodingList :: [Cache] -> Encoding
toEncodingList :: [Cache] -> Encoding
$comitField :: Cache -> Bool
omitField :: Cache -> Bool
Aeson.ToJSON)

data AgentInformation = AgentInformation
  { AgentInformation -> Maybe Cache
cache :: Maybe Cache,
    AgentInformation -> UUID
id :: UUID
  }
  deriving (Int -> AgentInformation -> ShowS
[AgentInformation] -> ShowS
AgentInformation -> String
(Int -> AgentInformation -> ShowS)
-> (AgentInformation -> String)
-> ([AgentInformation] -> ShowS)
-> Show AgentInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentInformation -> ShowS
showsPrec :: Int -> AgentInformation -> ShowS
$cshow :: AgentInformation -> String
show :: AgentInformation -> String
$cshowList :: [AgentInformation] -> ShowS
showList :: [AgentInformation] -> ShowS
Show, AgentInformation -> AgentInformation -> Bool
(AgentInformation -> AgentInformation -> Bool)
-> (AgentInformation -> AgentInformation -> Bool)
-> Eq AgentInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgentInformation -> AgentInformation -> Bool
== :: AgentInformation -> AgentInformation -> Bool
$c/= :: AgentInformation -> AgentInformation -> Bool
/= :: AgentInformation -> AgentInformation -> Bool
Eq, (forall x. AgentInformation -> Rep AgentInformation x)
-> (forall x. Rep AgentInformation x -> AgentInformation)
-> Generic AgentInformation
forall x. Rep AgentInformation x -> AgentInformation
forall x. AgentInformation -> Rep AgentInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AgentInformation -> Rep AgentInformation x
from :: forall x. AgentInformation -> Rep AgentInformation x
$cto :: forall x. Rep AgentInformation x -> AgentInformation
to :: forall x. Rep AgentInformation x -> AgentInformation
Generic, Maybe AgentInformation
Value -> Parser [AgentInformation]
Value -> Parser AgentInformation
(Value -> Parser AgentInformation)
-> (Value -> Parser [AgentInformation])
-> Maybe AgentInformation
-> FromJSON AgentInformation
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AgentInformation
parseJSON :: Value -> Parser AgentInformation
$cparseJSONList :: Value -> Parser [AgentInformation]
parseJSONList :: Value -> Parser [AgentInformation]
$comittedField :: Maybe AgentInformation
omittedField :: Maybe AgentInformation
Aeson.FromJSON, [AgentInformation] -> Value
[AgentInformation] -> Encoding
AgentInformation -> Bool
AgentInformation -> Value
AgentInformation -> Encoding
(AgentInformation -> Value)
-> (AgentInformation -> Encoding)
-> ([AgentInformation] -> Value)
-> ([AgentInformation] -> Encoding)
-> (AgentInformation -> Bool)
-> ToJSON AgentInformation
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: AgentInformation -> Value
toJSON :: AgentInformation -> Value
$ctoEncoding :: AgentInformation -> Encoding
toEncoding :: AgentInformation -> Encoding
$ctoJSONList :: [AgentInformation] -> Value
toJSONList :: [AgentInformation] -> Value
$ctoEncodingList :: [AgentInformation] -> Encoding
toEncodingList :: [AgentInformation] -> Encoding
$comitField :: AgentInformation -> Bool
omitField :: AgentInformation -> Bool
Aeson.ToJSON)

data DeploymentDetails = DeploymentDetails
  { DeploymentDetails -> Text
storePath :: Text,
    DeploymentDetails -> UUID
id :: UUID,
    DeploymentDetails -> Int64
index :: Int64,
    DeploymentDetails -> Maybe Text
rollbackScript :: Maybe Text
  }
  deriving (Int -> DeploymentDetails -> ShowS
[DeploymentDetails] -> ShowS
DeploymentDetails -> String
(Int -> DeploymentDetails -> ShowS)
-> (DeploymentDetails -> String)
-> ([DeploymentDetails] -> ShowS)
-> Show DeploymentDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeploymentDetails -> ShowS
showsPrec :: Int -> DeploymentDetails -> ShowS
$cshow :: DeploymentDetails -> String
show :: DeploymentDetails -> String
$cshowList :: [DeploymentDetails] -> ShowS
showList :: [DeploymentDetails] -> ShowS
Show, DeploymentDetails -> DeploymentDetails -> Bool
(DeploymentDetails -> DeploymentDetails -> Bool)
-> (DeploymentDetails -> DeploymentDetails -> Bool)
-> Eq DeploymentDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeploymentDetails -> DeploymentDetails -> Bool
== :: DeploymentDetails -> DeploymentDetails -> Bool
$c/= :: DeploymentDetails -> DeploymentDetails -> Bool
/= :: DeploymentDetails -> DeploymentDetails -> Bool
Eq, (forall x. DeploymentDetails -> Rep DeploymentDetails x)
-> (forall x. Rep DeploymentDetails x -> DeploymentDetails)
-> Generic DeploymentDetails
forall x. Rep DeploymentDetails x -> DeploymentDetails
forall x. DeploymentDetails -> Rep DeploymentDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeploymentDetails -> Rep DeploymentDetails x
from :: forall x. DeploymentDetails -> Rep DeploymentDetails x
$cto :: forall x. Rep DeploymentDetails x -> DeploymentDetails
to :: forall x. Rep DeploymentDetails x -> DeploymentDetails
Generic, Maybe DeploymentDetails
Value -> Parser [DeploymentDetails]
Value -> Parser DeploymentDetails
(Value -> Parser DeploymentDetails)
-> (Value -> Parser [DeploymentDetails])
-> Maybe DeploymentDetails
-> FromJSON DeploymentDetails
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DeploymentDetails
parseJSON :: Value -> Parser DeploymentDetails
$cparseJSONList :: Value -> Parser [DeploymentDetails]
parseJSONList :: Value -> Parser [DeploymentDetails]
$comittedField :: Maybe DeploymentDetails
omittedField :: Maybe DeploymentDetails
Aeson.FromJSON, [DeploymentDetails] -> Value
[DeploymentDetails] -> Encoding
DeploymentDetails -> Bool
DeploymentDetails -> Value
DeploymentDetails -> Encoding
(DeploymentDetails -> Value)
-> (DeploymentDetails -> Encoding)
-> ([DeploymentDetails] -> Value)
-> ([DeploymentDetails] -> Encoding)
-> (DeploymentDetails -> Bool)
-> ToJSON DeploymentDetails
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DeploymentDetails -> Value
toJSON :: DeploymentDetails -> Value
$ctoEncoding :: DeploymentDetails -> Encoding
toEncoding :: DeploymentDetails -> Encoding
$ctoJSONList :: [DeploymentDetails] -> Value
toJSONList :: [DeploymentDetails] -> Value
$ctoEncodingList :: [DeploymentDetails] -> Encoding
toEncodingList :: [DeploymentDetails] -> Encoding
$comitField :: DeploymentDetails -> Bool
omitField :: DeploymentDetails -> Bool
Aeson.ToJSON)

data BackendCommand
  = Deployment DeploymentDetails
  | AgentRegistered AgentInformation
  deriving (Int -> BackendCommand -> ShowS
[BackendCommand] -> ShowS
BackendCommand -> String
(Int -> BackendCommand -> ShowS)
-> (BackendCommand -> String)
-> ([BackendCommand] -> ShowS)
-> Show BackendCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackendCommand -> ShowS
showsPrec :: Int -> BackendCommand -> ShowS
$cshow :: BackendCommand -> String
show :: BackendCommand -> String
$cshowList :: [BackendCommand] -> ShowS
showList :: [BackendCommand] -> ShowS
Show, BackendCommand -> BackendCommand -> Bool
(BackendCommand -> BackendCommand -> Bool)
-> (BackendCommand -> BackendCommand -> Bool) -> Eq BackendCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackendCommand -> BackendCommand -> Bool
== :: BackendCommand -> BackendCommand -> Bool
$c/= :: BackendCommand -> BackendCommand -> Bool
/= :: BackendCommand -> BackendCommand -> Bool
Eq, (forall x. BackendCommand -> Rep BackendCommand x)
-> (forall x. Rep BackendCommand x -> BackendCommand)
-> Generic BackendCommand
forall x. Rep BackendCommand x -> BackendCommand
forall x. BackendCommand -> Rep BackendCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BackendCommand -> Rep BackendCommand x
from :: forall x. BackendCommand -> Rep BackendCommand x
$cto :: forall x. Rep BackendCommand x -> BackendCommand
to :: forall x. Rep BackendCommand x -> BackendCommand
Generic, Maybe BackendCommand
Value -> Parser [BackendCommand]
Value -> Parser BackendCommand
(Value -> Parser BackendCommand)
-> (Value -> Parser [BackendCommand])
-> Maybe BackendCommand
-> FromJSON BackendCommand
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser BackendCommand
parseJSON :: Value -> Parser BackendCommand
$cparseJSONList :: Value -> Parser [BackendCommand]
parseJSONList :: Value -> Parser [BackendCommand]
$comittedField :: Maybe BackendCommand
omittedField :: Maybe BackendCommand
Aeson.FromJSON, [BackendCommand] -> Value
[BackendCommand] -> Encoding
BackendCommand -> Bool
BackendCommand -> Value
BackendCommand -> Encoding
(BackendCommand -> Value)
-> (BackendCommand -> Encoding)
-> ([BackendCommand] -> Value)
-> ([BackendCommand] -> Encoding)
-> (BackendCommand -> Bool)
-> ToJSON BackendCommand
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: BackendCommand -> Value
toJSON :: BackendCommand -> Value
$ctoEncoding :: BackendCommand -> Encoding
toEncoding :: BackendCommand -> Encoding
$ctoJSONList :: [BackendCommand] -> Value
toJSONList :: [BackendCommand] -> Value
$ctoEncodingList :: [BackendCommand] -> Encoding
toEncodingList :: [BackendCommand] -> Encoding
$comitField :: BackendCommand -> Bool
omitField :: BackendCommand -> Bool
Aeson.ToJSON)

data AgentCommand
  = DeploymentStarted {AgentCommand -> UUID
id :: UUID, AgentCommand -> UTCTime
time :: UTCTime, AgentCommand -> Maybe Int64
closureSize :: Maybe Int64}
  | DeploymentFinished {id :: UUID, time :: UTCTime, AgentCommand -> Bool
hasSucceeded :: Bool}
  deriving (Int -> AgentCommand -> ShowS
[AgentCommand] -> ShowS
AgentCommand -> String
(Int -> AgentCommand -> ShowS)
-> (AgentCommand -> String)
-> ([AgentCommand] -> ShowS)
-> Show AgentCommand
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AgentCommand -> ShowS
showsPrec :: Int -> AgentCommand -> ShowS
$cshow :: AgentCommand -> String
show :: AgentCommand -> String
$cshowList :: [AgentCommand] -> ShowS
showList :: [AgentCommand] -> ShowS
Show, AgentCommand -> AgentCommand -> Bool
(AgentCommand -> AgentCommand -> Bool)
-> (AgentCommand -> AgentCommand -> Bool) -> Eq AgentCommand
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AgentCommand -> AgentCommand -> Bool
== :: AgentCommand -> AgentCommand -> Bool
$c/= :: AgentCommand -> AgentCommand -> Bool
/= :: AgentCommand -> AgentCommand -> Bool
Eq, (forall x. AgentCommand -> Rep AgentCommand x)
-> (forall x. Rep AgentCommand x -> AgentCommand)
-> Generic AgentCommand
forall x. Rep AgentCommand x -> AgentCommand
forall x. AgentCommand -> Rep AgentCommand x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AgentCommand -> Rep AgentCommand x
from :: forall x. AgentCommand -> Rep AgentCommand x
$cto :: forall x. Rep AgentCommand x -> AgentCommand
to :: forall x. Rep AgentCommand x -> AgentCommand
Generic, Maybe AgentCommand
Value -> Parser [AgentCommand]
Value -> Parser AgentCommand
(Value -> Parser AgentCommand)
-> (Value -> Parser [AgentCommand])
-> Maybe AgentCommand
-> FromJSON AgentCommand
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser AgentCommand
parseJSON :: Value -> Parser AgentCommand
$cparseJSONList :: Value -> Parser [AgentCommand]
parseJSONList :: Value -> Parser [AgentCommand]
$comittedField :: Maybe AgentCommand
omittedField :: Maybe AgentCommand
Aeson.FromJSON, [AgentCommand] -> Value
[AgentCommand] -> Encoding
AgentCommand -> Bool
AgentCommand -> Value
AgentCommand -> Encoding
(AgentCommand -> Value)
-> (AgentCommand -> Encoding)
-> ([AgentCommand] -> Value)
-> ([AgentCommand] -> Encoding)
-> (AgentCommand -> Bool)
-> ToJSON AgentCommand
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: AgentCommand -> Value
toJSON :: AgentCommand -> Value
$ctoEncoding :: AgentCommand -> Encoding
toEncoding :: AgentCommand -> Encoding
$ctoJSONList :: [AgentCommand] -> Value
toJSONList :: [AgentCommand] -> Value
$ctoEncodingList :: [AgentCommand] -> Encoding
toEncodingList :: [AgentCommand] -> Encoding
$comitField :: AgentCommand -> Bool
omitField :: AgentCommand -> Bool
Aeson.ToJSON)

parseMessage :: (Aeson.FromJSON cmd) => ByteString -> Either Text (Message cmd)
parseMessage :: forall cmd. FromJSON cmd => ByteString -> Either Text (Message cmd)
parseMessage = (String -> Text)
-> Either String (Message cmd) -> Either Text (Message cmd)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> Text
forall a b. ConvertText a b => a -> b
toS (Either String (Message cmd) -> Either Text (Message cmd))
-> (ByteString -> Either String (Message cmd))
-> ByteString
-> Either Text (Message cmd)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (Message cmd)
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict'

sendMessage :: (Aeson.ToJSON cmd) => WS.Connection -> Message cmd -> IO ()
sendMessage :: forall cmd. ToJSON cmd => Connection -> Message cmd -> IO ()
sendMessage Connection
connection Message cmd
cmd =
  Connection -> ByteString -> IO ()
forall a. WebSocketsData a => Connection -> a -> IO ()
WS.sendTextData Connection
connection (Message cmd -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode Message cmd
cmd)

-- | Receive and process messages in parallel.
--
-- Note: This will not rethrow the 'CloseRequest' exception!
--
-- TODO: use Async.replicateConcurrently
receiveDataConcurrently :: WS.Connection -> (ByteString -> IO ()) -> IO ()
receiveDataConcurrently :: Connection -> (ByteString -> IO ()) -> IO ()
receiveDataConcurrently Connection
connection ByteString -> IO ()
action =
  do
    TMQueue ByteString
queue <- STM (TMQueue ByteString) -> IO (TMQueue ByteString)
forall a. STM a -> IO a
atomically STM (TMQueue ByteString)
forall a. STM (TMQueue a)
TMQueue.newTMQueue
    IO () -> (Async () -> IO ()) -> IO ()
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (TMQueue ByteString -> IO ()
consumer TMQueue ByteString
queue) (TMQueue ByteString -> Async () -> IO ()
forall {a}. WebSocketsData a => TMQueue a -> Async () -> IO ()
producer TMQueue ByteString
queue)
  where
    producer :: TMQueue a -> Async () -> IO ()
producer TMQueue a
queue Async ()
consumerThread =
      IO ()
forall {b}. IO b
loop
        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` TMQueue a -> Async () -> IO ()
forall a. TMQueue a -> Async () -> IO ()
closeGracefully TMQueue a
queue Async ()
consumerThread
        IO () -> (ConnectionException -> IO ()) -> IO ()
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`Safe.catch` ConnectionException -> IO ()
closeRequest
      where
        loop :: IO b
loop = do
          a
payload <- Connection -> IO a
forall a. WebSocketsData a => Connection -> IO a
WS.receiveData Connection
connection
          STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMQueue a -> a -> STM ()
forall a. TMQueue a -> a -> STM ()
TMQueue.writeTMQueue TMQueue a
queue a
payload
          IO b
loop

    consumer :: TMQueue ByteString -> IO ()
consumer TMQueue ByteString
queue = IO ()
loop
      where
        loop :: IO ()
loop = do
          Maybe ByteString
payload <- STM (Maybe ByteString) -> IO (Maybe ByteString)
forall a. STM a -> IO a
atomically (STM (Maybe ByteString) -> IO (Maybe ByteString))
-> STM (Maybe ByteString) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ TMQueue ByteString -> STM (Maybe ByteString)
forall a. TMQueue a -> STM (Maybe a)
TMQueue.readTMQueue TMQueue ByteString
queue
          case Maybe ByteString
payload of
            Maybe ByteString
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ByteString
msg -> ByteString -> IO ()
action ByteString
msg IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO ()
loop

    -- Close the queue and wait for the consumer finish processing messages.
    closeGracefully :: TMQueue.TMQueue a -> Async.Async () -> IO ()
    closeGracefully :: forall a. TMQueue a -> Async () -> IO ()
closeGracefully TMQueue a
queue Async ()
consumerThread = do
      STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMQueue a -> STM ()
forall a. TMQueue a -> STM ()
TMQueue.closeTMQueue TMQueue a
queue
      Async () -> IO ()
forall a. Async a -> IO a
Async.wait Async ()
consumerThread

    closeRequest :: WS.ConnectionException -> IO ()
    closeRequest :: ConnectionException -> IO ()
closeRequest (WS.CloseRequest Word16
_ ByteString
_) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    closeRequest ConnectionException
e = ConnectionException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ConnectionException
e

data Log = Log
  { Log -> Text
line :: Text,
    Log -> UTCTime
time :: UTCTime
  }
  deriving ((forall x. Log -> Rep Log x)
-> (forall x. Rep Log x -> Log) -> Generic Log
forall x. Rep Log x -> Log
forall x. Log -> Rep Log x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Log -> Rep Log x
from :: forall x. Log -> Rep Log x
$cto :: forall x. Rep Log x -> Log
to :: forall x. Rep Log x -> Log
Generic, Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
(Int -> Log -> ShowS)
-> (Log -> String) -> ([Log] -> ShowS) -> Show Log
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Log -> ShowS
showsPrec :: Int -> Log -> ShowS
$cshow :: Log -> String
show :: Log -> String
$cshowList :: [Log] -> ShowS
showList :: [Log] -> ShowS
Show, [Log] -> Value
[Log] -> Encoding
Log -> Bool
Log -> Value
Log -> Encoding
(Log -> Value)
-> (Log -> Encoding)
-> ([Log] -> Value)
-> ([Log] -> Encoding)
-> (Log -> Bool)
-> ToJSON Log
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Log -> Value
toJSON :: Log -> Value
$ctoEncoding :: Log -> Encoding
toEncoding :: Log -> Encoding
$ctoJSONList :: [Log] -> Value
toJSONList :: [Log] -> Value
$ctoEncodingList :: [Log] -> Encoding
toEncodingList :: [Log] -> Encoding
$comitField :: Log -> Bool
omitField :: Log -> Bool
Aeson.ToJSON, Maybe Log
Value -> Parser [Log]
Value -> Parser Log
(Value -> Parser Log)
-> (Value -> Parser [Log]) -> Maybe Log -> FromJSON Log
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Log
parseJSON :: Value -> Parser Log
$cparseJSONList :: Value -> Parser [Log]
parseJSONList :: Value -> Parser [Log]
$comittedField :: Maybe Log
omittedField :: Maybe Log
Aeson.FromJSON)