module Network.Legion.Admin (
runAdmin,
) where
import Control.Concurrent (forkIO, newChan, newEmptyMVar, writeChan,
putMVar, takeMVar, Chan)
import Control.Monad (void)
import Control.Monad.Logger (askLoggerIO, runLoggingT)
import Control.Monad.Trans.Class (lift)
import Data.Conduit (Source)
import Data.Default.Class (def)
import Data.Text.Lazy (Text, pack)
import Network.Legion.Application (LegionConstraints)
import Network.Legion.Conduit (chanToSource)
import Network.Legion.LIO (LIO)
import Network.Legion.PartitionKey (PartitionKey(K))
import Network.Legion.StateMachine (AdminMessage(GetState, GetPart))
import Network.Wai.Handler.Warp (HostPreference, defaultSettings, Port,
setHost, setPort)
import Web.Scotty.Resource.Trans (resource, get)
import Web.Scotty.Trans (Options, scottyOptsT, settings, ScottyT, text,
ActionT, param)
runAdmin :: (LegionConstraints i o s)
=> Port
-> HostPreference
-> LIO (Source LIO (AdminMessage i o s))
runAdmin addr host = do
logging <- askLoggerIO
chan <- lift newChan
void . lift . forkIO . (`runLoggingT` logging) $
let
website :: ScottyT Text LIO ()
website = do
resource "/clusterstate" $
get $ do
val <- send chan GetState
text (pack (show val))
resource "/propstate/:key" $
get $ do
key <- K . read <$> param "key"
val <- send chan (GetPart key)
text (pack (show val))
in scottyOptsT (options addr host) (`runLoggingT` logging) website
return (chanToSource chan)
where
send
:: Chan (AdminMessage i o s)
-> ((a -> LIO ()) -> AdminMessage i o s)
-> ActionT Text LIO a
send chan msg = lift . lift $ do
mvar <- newEmptyMVar
writeChan chan (msg (lift . putMVar mvar))
takeMVar mvar
options :: Port -> HostPreference -> Options
options port host = def {
settings =
setPort port
. setHost host
$ defaultSettings
}