plotserver-api-0.1: Plotserver/Api.hs

{-# LANGUAGE NamedFieldPuns  #-}

module Plotserver.Api (
	plotUrl, plotCat, plotUpdate, plotDelete
	) where

import Network.Curl
import Control.Applicative ((<$>))

import Plotserver.Types

------ API ------

plotUrl :: PlotConfig -> String -> String
plotUrl (PlotConfig {server}) dataset = server ++ "/" ++ dataset

plotCat :: PlotConfig -> String -> IO (Either String PlotData)
plotCat config dataset = response2either <$> curlGetResponse_ url_ opts where
	url_ = actionUrl config dataset "download"
	opts = defaultOpts config

plotUpdate :: PlotConfig -> String -> PlotDataRow -> IO (Either String PlotData)
plotUpdate config dataset row = response2either <$> curlGetResponse_ url_ opts where
	postData = show $ PlotData [row]
	url_ = actionUrl config dataset "update"
	opts = defaultOpts config ++ [
		CurlPost True,
		CurlPostFields [postData]
		]

plotDelete :: PlotConfig -> String -> IO (Either String PlotData)
plotDelete config dataset = response2either <$> curlGetResponse_ url_ opts where
	url_ = actionUrl config dataset "delete"
	opts = defaultOpts config

------ helpers ------

defaultOpts :: PlotConfig -> [CurlOption]
defaultOpts PlotConfig {username, password} = [
		CurlUserPwd (username ++ ":" ++ password)
	]

actionUrl :: PlotConfig -> String -> String -> String
actionUrl config dataset action = plotUrl config dataset ++ "?" ++ action

response2either :: CurlResponse_ [(String, String)] String -> Either String PlotData
response2either response 
	| respStatus response == 200 = Right $ (read (respBody response) :: PlotData)
	| otherwise = Left err where
		err = "Error: " ++ show (respStatus response)