diff options
Diffstat (limited to 'fig-web/src/Fig')
| -rw-r--r-- | fig-web/src/Fig/Web/Module/Debt.hs | 1 | ||||
| -rw-r--r-- | fig-web/src/Fig/Web/Module/ShindigsSorting.hs | 31 | ||||
| -rw-r--r-- | fig-web/src/Fig/Web/Public.hs | 3 | ||||
| -rw-r--r-- | fig-web/src/Fig/Web/Types.hs | 14 | ||||
| -rw-r--r-- | fig-web/src/Fig/Web/Utils.hs | 7 |
5 files changed, 54 insertions, 2 deletions
diff --git a/fig-web/src/Fig/Web/Module/Debt.hs b/fig-web/src/Fig/Web/Module/Debt.hs index 31731b9..883a394 100644 --- a/fig-web/src/Fig/Web/Module/Debt.hs +++ b/fig-web/src/Fig/Web/Module/Debt.hs @@ -6,7 +6,6 @@ import Fig.Prelude import Data.Maybe (mapMaybe) import qualified Data.Map.Strict as Map -import qualified Data.ByteString as BS import Fig.Web.Utils import Fig.Web.Types diff --git a/fig-web/src/Fig/Web/Module/ShindigsSorting.hs b/fig-web/src/Fig/Web/Module/ShindigsSorting.hs new file mode 100644 index 0000000..516f2a2 --- /dev/null +++ b/fig-web/src/Fig/Web/Module/ShindigsSorting.hs @@ -0,0 +1,31 @@ +module Fig.Web.Module.ShindigsSorting + ( public + , publicWebsockets + ) where + +import Fig.Prelude + +import qualified Control.Concurrent.Chan as Chan + +import qualified Data.Aeson as Aeson + +import qualified Network.WebSockets as WS + +import Fig.Web.Utils +import Fig.Web.Types + +public :: PublicModule +public a = do + onPost "/api/shindigssort" do + b :: ShindigsSort <- bodyJSON + liftIO $ Chan.writeChan a.channels.shindigssort b + +publicWebsockets :: PublicWebsockets +publicWebsockets a = + [ ( "/api/shindigssort/events", \conn -> do + c <- Chan.dupChan a.channels.shindigssort + forever do + ev <- liftIO $ Chan.readChan c + WS.sendTextData conn $ Aeson.encode ev + ) + ] diff --git a/fig-web/src/Fig/Web/Public.hs b/fig-web/src/Fig/Web/Public.hs index 89602bb..975a161 100644 --- a/fig-web/src/Fig/Web/Public.hs +++ b/fig-web/src/Fig/Web/Public.hs @@ -27,6 +27,7 @@ import qualified Fig.Web.Module.Shader as Shader import qualified Fig.Web.Module.HLS as HLS import qualified Fig.Web.Module.TCG as TCG import qualified Fig.Web.Module.Debt as Debt +import qualified Fig.Web.Module.ShindigsSorting as ShindigsSorting allBusEvents :: PublicModuleArgs -> BusEventHandlers allBusEvents args = busEvents . mconcat $ fmap ($ args) @@ -98,10 +99,12 @@ app args = do HLS.public args TCG.public args Debt.public args + ShindigsSorting.public args websocket $ mconcat [ Gizmo.publicWebsockets args , Circle.publicWebsockets args , Model.publicWebsockets args + , ShindigsSorting.publicWebsockets args ] Sc.notFound do respondText "not found" diff --git a/fig-web/src/Fig/Web/Types.hs b/fig-web/src/Fig/Web/Types.hs index 94a3a65..3390d88 100644 --- a/fig-web/src/Fig/Web/Types.hs +++ b/fig-web/src/Fig/Web/Types.hs @@ -1,5 +1,5 @@ module Fig.Web.Types - ( LiveEvent(..) + ( LiveEvent(..), ShindigsSort(..) , Commands(..) , Channels(..) , newChannels @@ -19,6 +19,7 @@ import Fig.Prelude import qualified Control.Concurrent.Chan as Chan import qualified Control.Concurrent.MVar as MVar +import Data.Word (Word32) import qualified Data.Set as Set import qualified Network.WebSockets as WS @@ -27,6 +28,8 @@ import qualified Web.Scotty as Sc import qualified Database.Redis as Redis +import qualified Data.Aeson as Aeson + import Fig.Bus.Binary.Client import Fig.Web.Utils @@ -35,10 +38,18 @@ data LiveEvent | LiveEventOffline !(Set.Set Text) deriving (Show, Eq, Ord) +data ShindigsSort = ShindigsSort + { name :: Text + , numbers :: [Word32] + } deriving (Show, Eq, Ord, Generic) +instance Aeson.FromJSON ShindigsSort where +instance Aeson.ToJSON ShindigsSort where + data Channels = Channels { live :: !(Chan.Chan LiveEvent) , gizmo :: !(Chan.Chan Text) , model :: !(Chan.Chan WS.DataMessage) + , shindigssort :: !(Chan.Chan ShindigsSort) } newChannels :: IO Channels @@ -46,6 +57,7 @@ newChannels = do live <- Chan.newChan gizmo <- Chan.newChan model <- Chan.newChan + shindigssort <- Chan.newChan pure Channels {..} newtype Globals = Globals diff --git a/fig-web/src/Fig/Web/Utils.hs b/fig-web/src/Fig/Web/Utils.hs index 59781cd..db449ee 100644 --- a/fig-web/src/Fig/Web/Utils.hs +++ b/fig-web/src/Fig/Web/Utils.hs @@ -9,6 +9,7 @@ module Fig.Web.Utils , module Network.HTTP.Types.Status , onGet, onPost, onPut, onDelete , status + , body, bodyJSON , queryParam, queryParamMaybe, formParam, formParamMaybe, pathParam , header, addHeader , respondBytes, respondText, respondJSON, respondHTMLText, respondHTML, redirect @@ -129,6 +130,12 @@ onDelete = Sc.delete status :: Status -> Sc.ActionM () status = Sc.status +body :: Sc.ActionM ByteString +body = BS.L.toStrict <$> Sc.body + +bodyJSON :: Aeson.FromJSON a => Sc.ActionM a +bodyJSON = Sc.jsonData + queryParam :: Sc.Parsable a => Text -> Sc.ActionM a queryParam = Sc.queryParam . Text.L.fromStrict queryParamMaybe :: Sc.Parsable a => Text -> Sc.ActionM (Maybe a) |
