managed-functions-http-connector (empty) → 1.0.0

raw patch · 6 files changed

+144/−0 lines, 6 filesdep +aesondep +basedep +managed-functionssetup-changed

Dependencies added: aeson, base, managed-functions, managed-functions-json, servant-server, wai, warp

Files

• LICENSE +21/−0
• README.md +3/−0
• Setup.hs +3/−0
• managed-functions-http-connector.cabal +44/−0
• src/Managed/Connectors/HTTPConnector.hs +19/−0
• src/Managed/Connectors/HTTPConnector/Internal.hs +54/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2022 Martin Bednář++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,3 @@+# managed-functions-http-connector++_A simple HTTP-based Connector for Managed Functions_

@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain

@@ -0,0 +1,44 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           managed-functions-http-connector+version:        1.0.0+synopsis:       Simple HTTP-Based Connector for Managed Functions+description:    Please see the README on GitHub at <https://github.com/martin-bednar/managed-functions#readme>+category:       Remote Management, HTTP+homepage:       https://github.com/martin-bednar/managed-functions#readme+bug-reports:    https://github.com/martin-bednar/managed-functions/issues+author:         Martin Bednar+maintainer:     bednam17@fit.cvut.cz+copyright:      2022 Martin Bednar+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md++source-repository head+  type: git+  location: https://github.com/martin-bednar/managed-functions++library+  exposed-modules:+      Managed.Connectors.HTTPConnector+      Managed.Connectors.HTTPConnector.Internal+  other-modules:+      Paths_managed_functions_http_connector+  hs-source-dirs:+      src+  ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wpartial-fields -Wmonomorphism-restriction -Wmissing-home-modules -Widentities -Wredundant-constraints+  build-depends:+      aeson+    , base >=4.7 && <5+    , managed-functions+    , managed-functions-json+    , servant-server+    , wai+    , warp+  default-language: Haskell2010

@@ -0,0 +1,19 @@+module Managed.Connectors.HTTPConnector+  ( httpConnector+  , HTTPConnectorAPI+  , httpConnectorServer+  ) where++import Data.Managed (Agent, Connector(..))+import Data.Managed.Encodings.ShowRead+import Managed.Connectors.HTTPConnector.Internal+import qualified Network.Wai.Handler.Warp as Warp+import Servant (Server)++httpConnector :: Connector SR+httpConnector = Connector {run = Warp.run 3000 . mkApp}++type HTTPConnectorAPI = ManagedAPI++httpConnectorServer :: Agent SR -> Server ManagedAPI+httpConnectorServer = mkServer

@@ -0,0 +1,54 @@+{-# 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 =+  handleList agent :<|> handleDescribe agent :<|> handleInvoke agent++handleList :: Agent SR -> Handler [ProbeID]+handleList = return . ids++handleDescribe :: Agent SR -> [Char] -> Handler ProbeDescription+handleDescribe a p = safely (return $ describeEither a p)++handleInvoke :: Agent SR -> ProbeID -> [String] -> Handler String+handleInvoke agent probe args = safely (invoke agent probe args)++errCode :: AgentException -> ServerError+errCode (ProbeRuntimeException _) = err500+errCode _ = err400++mkApp :: Agent SR -> Application+mkApp agent = serve (Proxy @ManagedAPI) (mkServer agent)++safely :: IO (Either AgentException b) -> Handler b+safely action = do+  x <- liftIO action+  case x of+    Left e ->+      throwError $+      (errCode e) {errBody = Data.Aeson.encode . displayException $ e}+    Right val -> return val