{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module Managed.Connectors.HTTPConnector.Internal
  ( ManagedAPI
  , mkServer
  , mkApp
  ) where

import Control.Exception (displayException, try)
import Control.Monad.IO.Class (liftIO)
import Data.Aeson (encode)
import Data.Managed hiding (JSON)
import Data.Managed.Instances.JSON
import Managed.Agent
import Managed.Exception
import Network.Wai
import Servant

type ManagedAPI
   = "probes" :> (Get '[ JSON] [ProbeID] :<|> Capture "probe" ProbeID :> Get '[ JSON] ProbeDescription :<|> Capture "probe" ProbeID :> "invoke" :> ReqBody '[ JSON] [String] :> Post '[ JSON] String)

mkServer :: Agent SR -> Server ManagedAPI
mkServer :: Agent SR -> Server ManagedAPI
mkServer Agent SR
agent =
  Agent SR -> Handler [ProbeID]
handleList Agent SR
agent Handler [ProbeID]
-> ((ProbeID -> Handler ProbeDescription)
    :<|> (ProbeID -> [ProbeID] -> Handler ProbeID))
-> Handler [ProbeID]
   :<|> ((ProbeID -> Handler ProbeDescription)
         :<|> (ProbeID -> [ProbeID] -> Handler ProbeID))
forall a b. a -> b -> a :<|> b
:<|> Agent SR -> ProbeID -> Handler ProbeDescription
handleDescribe Agent SR
agent (ProbeID -> Handler ProbeDescription)
-> (ProbeID -> [ProbeID] -> Handler ProbeID)
-> (ProbeID -> Handler ProbeDescription)
   :<|> (ProbeID -> [ProbeID] -> Handler ProbeID)
forall a b. a -> b -> a :<|> b
:<|> Agent SR -> ProbeID -> [ProbeID] -> Handler ProbeID
handleInvoke Agent SR
agent

handleList :: Agent SR -> Handler [ProbeID]
handleList :: Agent SR -> Handler [ProbeID]
handleList = [ProbeID] -> Handler [ProbeID]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ProbeID] -> Handler [ProbeID])
-> (Agent SR -> [ProbeID]) -> Agent SR -> Handler [ProbeID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Agent SR -> [ProbeID]
forall e. Agent e -> [ProbeID]
ids

handleDescribe :: Agent SR -> [Char] -> Handler ProbeDescription
handleDescribe :: Agent SR -> ProbeID -> Handler ProbeDescription
handleDescribe Agent SR
a ProbeID
p = IO (Either AgentException ProbeDescription)
-> Handler ProbeDescription
forall b. IO (Either AgentException b) -> Handler b
safely (Either AgentException ProbeDescription
-> IO (Either AgentException ProbeDescription)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either AgentException ProbeDescription
 -> IO (Either AgentException ProbeDescription))
-> Either AgentException ProbeDescription
-> IO (Either AgentException ProbeDescription)
forall a b. (a -> b) -> a -> b
$ Agent SR -> ProbeID -> Either AgentException ProbeDescription
forall e.
Agent e -> ProbeID -> Either AgentException ProbeDescription
describeEither Agent SR
a ProbeID
p)

handleInvoke :: Agent SR -> ProbeID -> [String] -> Handler String
handleInvoke :: Agent SR -> ProbeID -> [ProbeID] -> Handler ProbeID
handleInvoke Agent SR
agent ProbeID
probe [ProbeID]
args = IO (Either AgentException ProbeID) -> Handler ProbeID
forall b. IO (Either AgentException b) -> Handler b
safely (Agent SR
-> ProbeID -> [In SR] -> IO (Either AgentException (Out SR))
forall e.
NFData (Out e) =>
Agent e -> ProbeID -> [In e] -> IO (Either AgentException (Out e))
invoke Agent SR
agent ProbeID
probe [ProbeID]
[In SR]
args)

errCode :: AgentException -> ServerError
errCode :: AgentException -> ServerError
errCode (ProbeRuntimeException ProbeID
_) = ServerError
err500
errCode AgentException
_ = ServerError
err400

mkApp :: Agent SR -> Application
mkApp :: Agent SR -> Application
mkApp Agent SR
agent = Proxy ManagedAPI -> Server ManagedAPI -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (Proxy ManagedAPI
forall k (t :: k). Proxy t
Proxy @ManagedAPI) (Agent SR -> Server ManagedAPI
mkServer Agent SR
agent)

safely :: IO (Either AgentException b) -> Handler b
safely :: IO (Either AgentException b) -> Handler b
safely IO (Either AgentException b)
action = do
  Either AgentException b
x <- IO (Either AgentException b) -> Handler (Either AgentException b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either AgentException b)
action
  case Either AgentException b
x of
    Left AgentException
e ->
      ServerError -> Handler b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ServerError -> Handler b) -> ServerError -> Handler b
forall a b. (a -> b) -> a -> b
$
      (AgentException -> ServerError
errCode AgentException
e) {errBody :: ByteString
errBody = ProbeID -> ByteString
forall a. ToJSON a => a -> ByteString
Data.Aeson.encode (ProbeID -> ByteString)
-> (AgentException -> ProbeID) -> AgentException -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AgentException -> ProbeID
forall e. Exception e => e -> ProbeID
displayException (AgentException -> ByteString) -> AgentException -> ByteString
forall a b. (a -> b) -> a -> b
$ AgentException
e}
    Right b
val -> b -> Handler b
forall (m :: * -> *) a. Monad m => a -> m a
return b
val