haskell-admin-health (empty) → 1.0.0.0

raw patch · 9 files changed

+206/−0 lines, 9 filesdep +aesondep +asyncdep +basesetup-changed

Dependencies added: aeson, async, base, haskell-admin-core, haskell-admin-health, hspec, hspec-wai, servant, servant-server

Files

• ChangeLog.md +3/−0
• LICENSE +20/−0
• README.md +11/−0
• Setup.hs +3/−0
• haskell-admin-health.cabal +65/−0
• src/Admin/Component/Health.hs +28/−0
• src/Data/ApplicationState.hs +33/−0
• test/Spec.hs +11/−0
• test/Spec/Admin/Component/Health.hs +32/−0

@@ -0,0 +1,3 @@+# Changelog for haskell-admin-health++## Unreleased changes

@@ -0,0 +1,20 @@+Copyright Martin Bednar (c) 2022++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,11 @@+# haskell-admin-health++_A server component for [Haskell Admin](https://github.com/martin-bednar/haskell-admin)_++This components reports application health.+Currently, its only endpoint is `/status`, which yields the current health status of the application (Running / Finished / Error).++Desired future features:++- Recover from an error (e. g. by restarting the application)+- Forcibly stop the application

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

@@ -0,0 +1,65 @@+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:           haskell-admin-health+version:        1.0.0.0+synopsis:       Application Health Component for Haskell Admin+description:    Please see the README on GitHub at <https://github.com/martin-bednar/haskell-admin#readme>+category:       Haskell Admin, Remote Management+homepage:       https://github.com/martin-bednar/haskell-admin#readme+bug-reports:    https://github.com/martin-bednar/haskell-admin/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+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/martin-bednar/haskell-admin++library+  exposed-modules:+      Admin.Component.Health+      Data.ApplicationState+  other-modules:+      Paths_haskell_admin_health+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints+  build-depends:+      aeson+    , async+    , base >=4.7 && <5+    , haskell-admin-core+    , servant+    , servant-server+  default-language: Haskell2010++test-suite haskell-admin-health-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Spec.Admin.Component.Health+      Paths_haskell_admin_health+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , async+    , base >=4.7 && <5+    , haskell-admin-core+    , haskell-admin-health+    , hspec+    , hspec-wai+    , servant+    , servant-server+  default-language: Haskell2010

@@ -0,0 +1,28 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++module Admin.Component.Health+  ( HealthAPI+  , HealthComponent+  , health+  , serveHealth+  , Control.Concurrent.Async.async+  , Control.Concurrent.Async.Async+  ) where++import Admin.Components+import Control.Concurrent.Async (Async, async)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.ApplicationState+import Data.Version (makeVersion)+import Servant.API++type HealthAPI = "status" :> Get '[ JSON] ApplicationState++type HealthComponent = Component "health" HealthAPI++health :: (Show a) => Async a -> HealthComponent+health as = Component {server = serveHealth as, version = makeVersion [1]}++serveHealth :: (MonadIO m, Show a) => Async a -> m ApplicationState+serveHealth as = liftIO $ stateOf as

@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE LambdaCase #-}++module Data.ApplicationState+  ( ApplicationState(..)+  , stateOf+  ) where++import Control.Concurrent.Async (Async, poll)+import Control.Exception (SomeException)+import Data.Aeson (FromJSON, ToJSON)+import GHC.Generics (Generic)++-- | The state of a running Haskell application+-- or an running 'Async' action+data ApplicationState+  = Running -- ^ Application (action) is running+  | Finished String -- ^ Result of the async action+  | Error String -- ^ Description of the error (exception)+  deriving (Read, Show, Eq, Generic, ToJSON, FromJSON)++-- | Yields the 'ApplicationState' of an 'Async'+stateOf :: (Show a) => Async a -> IO ApplicationState+stateOf x = fromPollResult <$> poll x++-- | Converts the result of a 'Control.Concurrent.Async.poll' call to 'ApplicationState'+fromPollResult :: (Show a) => Maybe (Either SomeException a) -> ApplicationState+fromPollResult =+  \case+    Nothing -> Running+    Just (Left err) -> Error (show err)+    Just (Right val) -> Finished (show val)

@@ -0,0 +1,11 @@+module Main where++import Test.Hspec++import qualified Spec.Admin.Component.Health++main :: IO ()+main = hspec spec++spec :: Spec+spec = describe "Spec.Admin.Component.Health" Spec.Admin.Component.Health.spec

@@ -0,0 +1,32 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}++module Spec.Admin.Component.Health+  ( spec+  ) where++import Admin.Component.Health+import Control.Concurrent+import Servant+import Test.Hspec+import Test.Hspec.Wai++myProgram :: IO Int+myProgram = threadDelay 10000 >> return 5++app :: IO Application+app = do+  as <- async myProgram+  return $ serve (Proxy @HealthAPI) $ serveHealth as++spec :: Spec+spec =+  with app $ do+    describe "GET /status" $ do+      it "yields the correct status" $ do+        get "/status" `shouldRespondWith`+          200 {matchBody = "{\"tag\":\"Running\"}"}+        liftIO $ threadDelay 20000 -- Wait until myProgram stops+        get "/status" `shouldRespondWith`+          200 {matchBody = "{\"contents\":\"5\",\"tag\":\"Finished\"}"}