Move http to separate module

src/HomeAssistant/Runtime/Graphing.hs

@@ -12,31 +12,18 @@ module HomeAssistant.Runtime.Graphing
   , buildGraphArgs
   , readProcessBytes
   , Graph(..)
-  , servantGraphAction
+  , renderGraph
   ) where
 
 import Control.Exception (evaluate)
-import Control.Monad (forever)
 import Control.Monad.IO.Class (liftIO, MonadIO)
 import qualified Data.ByteString as BS
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Void (Void)
-import Network.Wai.Handler.Warp (run)
 import System.Exit (ExitCode (..))
 import System.IO (hGetContents)
 import System.Process (CreateProcess (..), StdStream (..), proc, waitForProcess, withCreateProcess)
-import Servant.API ((:>), Capture, Get, FromHttpApiData (..), ToHttpApiData (..), QueryParam, (:-), MimeRender (..), Accept (..))
-import Data.ByteString (ByteString)
-import GHC.Generics (Generic)
-import Servant (Handler, err404)
-import Control.Monad.Catch (throwM)
-import Servant.Server (err500)
-import Data.Maybe (fromMaybe)
-import Control.Exception.Annotated (checkpoint, Annotation (Annotation))
-import Servant.Server.Generic (AsServer, genericServe)
-import Network.Wai (Application)
-import Network.HTTP.Media ((//))
+import Servant.API (FromHttpApiData (..), ToHttpApiData (..))
 
 data Range = TenMinutes | OneHour | OneDay | OneWeek | OneMonth
   deriving (Eq, Show, Bounded, Enum)
@@ -292,37 +279,3 @@ instance FromHttpApiData Graph where
   parseQueryParam "ratelimit.png" = Right RateLimit
   parseQueryParam x = Left ("Can't parse '" <> x <> "' as Graph")
 
-data ImagePng
-
-instance MimeRender ImagePng ByteString where
-  mimeRender _ = BS.fromStrict
-
-instance Accept ImagePng where
-  contentType _ = "image" // "png"
-
-
-newtype API mode = API
-  { getMetrics :: mode :- "metrics" :> Capture "graph" Graph :> QueryParam "range" Range :> Get '[ImagePng] ByteString
-  }
-  deriving Generic
-
-
-getMetricsHandler :: FilePath -> FilePath -> Graph -> Maybe Range -> Handler ByteString
-getMetricsHandler rrdPath rrdtool graphMode mRange = checkpoint (Annotation (graphMode, mRange)) $ do
-  case lookupGraph graphs graphMode of
-    Nothing -> throwM err404
-    Just spec -> do
-      let range = fromMaybe OneDay mRange
-      g <- renderGraph rrdPath rrdtool spec range
-      -- XXX: Want logging for the error (not expose to response body)
-      -- but I don't have logging context yet
-      either (\_ -> throwM err500) pure g
-
-server :: FilePath -> FilePath -> API AsServer
-server rrdPath rrdtool = API { getMetrics = getMetricsHandler rrdPath rrdtool }
-
-servantApp :: FilePath -> FilePath -> Application
-servantApp rrdPath rrdtool = genericServe (server rrdPath rrdtool)
-
-servantGraphAction :: MonadIO m => FilePath -> FilePath -> Int -> m Void
-servantGraphAction rrdPath rrdtool port = liftIO $ forever $ run port (servantApp rrdPath rrdtool)