{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE TemplateHaskell     #-}
module Keter.HostManager
    ( -- * Types
      HostManager
    , Reservations
      -- * Actions
    , reserveHosts
    , forgetReservations
    , activateApp
    , deactivateApp
    , reactivateApp
    , lookupAction
      -- * Initialize
    , start
    ) where

import Keter.Context
import           Control.Applicative
import           Control.Exception   (assert, throwIO)
import           Control.Monad.Logger
import           Control.Monad.IO.Class (liftIO)
import           Control.Monad.Reader    (ask)
import qualified Data.CaseInsensitive as CI
import           Data.Either         (partitionEithers)
import           Data.IORef
import           Data.Text           (pack, unpack)
import qualified Data.Map            as Map
import qualified Data.Set            as Set
import           Data.Text.Encoding  (encodeUtf8)
import           Keter.Config
import           Keter.LabelMap      (LabelMap)
import qualified Keter.LabelMap      as LabelMap
import           Prelude             hiding (log)
import qualified Network.TLS as TLS
import           Keter.Common
import           System.FilePath            (FilePath)
import           Data.Set                   (Set)
import           Data.Map                   (Map)

data HostValue = HVActive   !AppId !ProxyAction !TLS.Credentials
               | HVReserved !AppId

newtype HostManager = HostManager (IORef (LabelMap HostValue))

type Reservations = Set.Set Host

start :: IO HostManager
start :: IO HostManager
start = IORef (LabelMap HostValue) -> HostManager
HostManager forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall a. LabelMap a
LabelMap.empty

-- | Reserve the given hosts so that no other application may use them. Does
-- not yet enable any action. The semantics are:
--
-- 1. If a requested host is currently actively used or by an app of the same name, it is
--    considered reserved.
--
-- 2. If a requested host is currently reserved by an app of the same name, it
--    is considered an error in calling this API. Only one app reservation can
--    happen at a time.
--
-- 3. If any requested host is currently used or reserved by an app with a
--    different name, then those values are returned as @Left@.
--
-- 4. Otherwise, the hosts which were reserved are returned as @Right@. This
--    does /not/ include previously active hosts.
reserveHosts :: AppId
             -> Set.Set Host
             -> KeterM HostManager Reservations
reserveHosts :: AppId -> Set (CI Text) -> KeterM HostManager (Set (CI Text))
reserveHosts AppId
aid Set (CI Text)
hosts = do
  (HostManager IORef (LabelMap HostValue)
mstate) <- forall r (m :: * -> *). MonadReader r m => m r
ask
  $Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> KeterM HostManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: [Char] -> Text
logInfo forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ 
      [Char]
"Reserving hosts for app " 
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AppId
aid
      forall a. [a] -> [a] -> [a]
++ [Char]
": " 
      forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
CI.original) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (CI Text)
hosts)
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppId -> Map (CI Text) AppId -> KeterException
CannotReserveHosts AppId
aid) forall (m :: * -> *) a. Monad m => a -> m a
return 
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (LabelMap HostValue)
mstate (\LabelMap HostValue
entries0 ->
      case forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (LabelMap HostValue
-> CI Text -> Either (CI Text, AppId) (Set (CI Text))
checkHost LabelMap HostValue
entries0) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (CI Text)
hosts of
          ([], forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions -> Set (CI Text)
toReserve) ->
              (forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr CI Text -> LabelMap HostValue -> LabelMap HostValue
reserve LabelMap HostValue
entries0 Set (CI Text)
toReserve, forall a b. b -> Either a b
Right Set (CI Text)
toReserve)
          ([(CI Text, AppId)]
conflicts, [Set (CI Text)]
_) -> (LabelMap HostValue
entries0, forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(CI Text, AppId)]
conflicts))
  where
    checkHost :: LabelMap HostValue
-> CI Text -> Either (CI Text, AppId) (Set (CI Text))
checkHost LabelMap HostValue
entries0 CI Text
host =
        case forall a. ByteString -> LabelMap a -> Bool
LabelMap.labelAssigned ByteString
hostBS LabelMap HostValue
entries0 of
            Bool
False -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton CI Text
host
            Bool
True  -> 
              case forall a. ByteString -> LabelMap a -> Maybe a
LabelMap.lookup ByteString
hostBS LabelMap HostValue
entries0 of
                Maybe HostValue
Nothing -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. a -> Set a
Set.singleton CI Text
host
                Just (HVReserved AppId
aid') -> forall a. (?callStack::CallStack) => Bool -> a -> a
assert (AppId
aid forall a. Eq a => a -> a -> Bool
/= AppId
aid')
                                        forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (CI Text
host, AppId
aid')
                Just (HVActive AppId
aid' ProxyAction
_ Credentials
_)
                    | AppId
aid forall a. Eq a => a -> a -> Bool
== AppId
aid' -> forall a b. b -> Either a b
Right forall a. Set a
Set.empty
                    | Bool
otherwise   -> forall a b. a -> Either a b
Left (CI Text
host, AppId
aid')
      where hostBS :: ByteString
hostBS = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
CI.original CI Text
host

    hvres :: HostValue
hvres = AppId -> HostValue
HVReserved AppId
aid
    reserve :: CI Text -> LabelMap HostValue -> LabelMap HostValue
reserve CI Text
host LabelMap HostValue
es =
        forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> LabelMap a -> Bool
LabelMap.labelAssigned ByteString
hostBS LabelMap HostValue
es) forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> a -> LabelMap a -> LabelMap a
LabelMap.insert ByteString
hostBS HostValue
hvres LabelMap HostValue
es
      where
        hostBS :: ByteString
hostBS = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
CI.original CI Text
host

-- | Forget previously made reservations.
forgetReservations :: AppId
                   -> Reservations
                   -> KeterM HostManager ()
forgetReservations :: AppId -> Set (CI Text) -> KeterM HostManager ()
forgetReservations AppId
app Set (CI Text)
hosts = do
    (HostManager IORef (LabelMap HostValue)
mstate) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    $Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> KeterM HostManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: [Char] -> Text
logInfo forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ 
        [Char]
"Forgetting host reservations for app " 
        forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AppId
app 
        forall a. [a] -> [a] -> [a]
++ [Char]
": " 
        forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
CI.original) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (CI Text)
hosts)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (LabelMap HostValue)
mstate forall a b. (a -> b) -> a -> b
$ \LabelMap HostValue
state0 ->
        (forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr CI Text -> LabelMap HostValue -> LabelMap HostValue
forget LabelMap HostValue
state0 Set (CI Text)
hosts, ())
  where
    forget :: CI Text -> LabelMap HostValue -> LabelMap HostValue
forget CI Text
host LabelMap HostValue
state =
        forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
isReservedByMe forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> LabelMap a -> LabelMap a
LabelMap.delete ByteString
hostBS LabelMap HostValue
state
      where
        hostBS :: ByteString
hostBS = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
CI.original CI Text
host
        isReservedByMe :: Bool
isReservedByMe = forall a. ByteString -> LabelMap a -> Bool
LabelMap.labelAssigned ByteString
hostBS LabelMap HostValue
state Bool -> Bool -> Bool
&&
            case forall a. ByteString -> LabelMap a -> Maybe a
LabelMap.lookup ByteString
hostBS LabelMap HostValue
state of
                Maybe HostValue
Nothing -> Bool
False
                Just (HVReserved AppId
app') -> AppId
app forall a. Eq a => a -> a -> Bool
== AppId
app'
                Just HVActive{} -> Bool
False

-- | Activate a new app. Note that you /must/ first reserve the hostnames you'll be using.
activateApp :: AppId
            -> Map.Map Host (ProxyAction, TLS.Credentials)
            -> KeterM HostManager ()
activateApp :: AppId
-> Map (CI Text) (ProxyAction, Credentials)
-> KeterM HostManager ()
activateApp AppId
app Map (CI Text) (ProxyAction, Credentials)
actions = do
    (HostManager IORef (LabelMap HostValue)
mstate) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    $Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> KeterM HostManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: [Char] -> Text
logInfo forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Activating app "
        , forall a. Show a => a -> [Char]
show AppId
app
        , [Char]
" with hosts: "
        , [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
CI.original) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList (forall k a. Map k a -> Set k
Map.keysSet Map (CI Text) (ProxyAction, Credentials)
actions))
        ]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (LabelMap HostValue)
mstate forall a b. (a -> b) -> a -> b
$ \LabelMap HostValue
state0 ->
        (AppId
-> LabelMap HostValue
-> Map (CI Text) (ProxyAction, Credentials)
-> LabelMap HostValue
activateHelper AppId
app LabelMap HostValue
state0 Map (CI Text) (ProxyAction, Credentials)
actions, ())

activateHelper :: AppId -> LabelMap HostValue -> Map Host (ProxyAction, TLS.Credentials) -> LabelMap HostValue
activateHelper :: AppId
-> LabelMap HostValue
-> Map (CI Text) (ProxyAction, Credentials)
-> LabelMap HostValue
activateHelper AppId
app =
    forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey CI Text
-> (ProxyAction, Credentials)
-> LabelMap HostValue
-> LabelMap HostValue
activate
  where
    activate :: CI Text
-> (ProxyAction, Credentials)
-> LabelMap HostValue
-> LabelMap HostValue
activate CI Text
host (ProxyAction
action, Credentials
cr) LabelMap HostValue
state =
        forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
isOwnedByMe forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> a -> LabelMap a -> LabelMap a
LabelMap.insert ByteString
hostBS (AppId -> ProxyAction -> Credentials -> HostValue
HVActive AppId
app ProxyAction
action Credentials
cr) LabelMap HostValue
state
      where
        hostBS :: ByteString
hostBS = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
CI.original CI Text
host
        isOwnedByMe :: Bool
isOwnedByMe = forall a. ByteString -> LabelMap a -> Bool
LabelMap.labelAssigned ByteString
hostBS LabelMap HostValue
state Bool -> Bool -> Bool
&&
            case forall a. ByteString -> LabelMap a -> Maybe a
LabelMap.lookup ByteString
hostBS LabelMap HostValue
state of
                Maybe HostValue
Nothing -> Bool
False
                Just (HVReserved AppId
app') -> AppId
app forall a. Eq a => a -> a -> Bool
== AppId
app'
                Just (HVActive AppId
app' ProxyAction
_ Credentials
_) -> AppId
app forall a. Eq a => a -> a -> Bool
== AppId
app'

deactivateApp :: AppId
              -> Set Host
              -> KeterM HostManager ()
deactivateApp :: AppId -> Set (CI Text) -> KeterM HostManager ()
deactivateApp AppId
app Set (CI Text)
hosts = do
    $Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> KeterM HostManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: [Char] -> Text
logInfo forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ [Char]
"Deactivating app " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AppId
app forall a. [a] -> [a] -> [a]
++ [Char]
" with hosts: " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
CI.original) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (CI Text)
hosts)
    (HostManager IORef (LabelMap HostValue)
mstate) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (LabelMap HostValue)
mstate forall a b. (a -> b) -> a -> b
$ \LabelMap HostValue
state0 ->
        (AppId -> LabelMap HostValue -> Set (CI Text) -> LabelMap HostValue
deactivateHelper AppId
app LabelMap HostValue
state0 Set (CI Text)
hosts, ())

deactivateHelper :: AppId -> LabelMap HostValue -> Set Host -> LabelMap HostValue
deactivateHelper :: AppId -> LabelMap HostValue -> Set (CI Text) -> LabelMap HostValue
deactivateHelper AppId
app =
    forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr CI Text -> LabelMap HostValue -> LabelMap HostValue
deactivate
  where
    deactivate :: CI Text -> LabelMap HostValue -> LabelMap HostValue
deactivate CI Text
host LabelMap HostValue
state =
        forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
isOwnedByMe forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> LabelMap a -> LabelMap a
LabelMap.delete ByteString
hostBS LabelMap HostValue
state
      where
        hostBS :: ByteString
hostBS = Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ forall s. CI s -> s
CI.original CI Text
host
        isOwnedByMe :: Bool
isOwnedByMe = forall a. ByteString -> LabelMap a -> Bool
LabelMap.labelAssigned ByteString
hostBS LabelMap HostValue
state Bool -> Bool -> Bool
&&
            case forall a. ByteString -> LabelMap a -> Maybe a
LabelMap.lookup ByteString
hostBS LabelMap HostValue
state of
                Maybe HostValue
Nothing -> Bool
False
                Just (HVActive AppId
app' ProxyAction
_ Credentials
_) -> AppId
app forall a. Eq a => a -> a -> Bool
== AppId
app'
                Just HVReserved {} -> Bool
False

reactivateApp :: AppId
              -> Map Host (ProxyAction, TLS.Credentials)
              -> Set Host
              -> KeterM HostManager ()
reactivateApp :: AppId
-> Map (CI Text) (ProxyAction, Credentials)
-> Set (CI Text)
-> KeterM HostManager ()
reactivateApp AppId
app Map (CI Text) (ProxyAction, Credentials)
actions Set (CI Text)
hosts = do
    (HostManager IORef (LabelMap HostValue)
mstate) <- forall r (m :: * -> *). MonadReader r m => m r
ask
    $Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> KeterM HostManager ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: [Char] -> Text
logInfo forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Reactivating app "
        , forall a. Show a => a -> [Char]
show AppId
app
        , [Char]
".  Old hosts: "
        , [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
CI.original) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (CI Text)
hosts)
        , [Char]
". New hosts: "
        , [[Char]] -> [Char]
unwords (forall a b. (a -> b) -> [a] -> [b]
map (Text -> [Char]
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
CI.original) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList (forall k a. Map k a -> Set k
Map.keysSet Map (CI Text) (ProxyAction, Credentials)
actions))
        , [Char]
"."
        ]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef (LabelMap HostValue)
mstate forall a b. (a -> b) -> a -> b
$ \LabelMap HostValue
state0 ->
        (AppId
-> LabelMap HostValue
-> Map (CI Text) (ProxyAction, Credentials)
-> LabelMap HostValue
activateHelper AppId
app (AppId -> LabelMap HostValue -> Set (CI Text) -> LabelMap HostValue
deactivateHelper AppId
app LabelMap HostValue
state0 Set (CI Text)
hosts) Map (CI Text) (ProxyAction, Credentials)
actions, ())

lookupAction :: HostManager
             -> HostBS
             -> IO (Maybe (ProxyAction, TLS.Credentials))
lookupAction :: HostManager -> HostBS -> IO (Maybe (ProxyAction, Credentials))
lookupAction (HostManager IORef (LabelMap HostValue)
mstate) HostBS
host = do
    LabelMap HostValue
state <- forall a. IORef a -> IO a
readIORef IORef (LabelMap HostValue)
mstate
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall a. ByteString -> LabelMap a -> Maybe a
LabelMap.lookup (forall s. CI s -> s
CI.original HostBS
host) LabelMap HostValue
state of
        Maybe HostValue
Nothing -> forall a. Maybe a
Nothing
        Just (HVActive AppId
_ ProxyAction
action Credentials
cert) -> forall a. a -> Maybe a
Just (ProxyAction
action, Credentials
cert)
        Just (HVReserved AppId
_) -> forall a. Maybe a
Nothing