module Web.Harvest.API
(
module Web.Harvest.API.Type
, getUsers
, getTimeEntries )
where
import Control.Monad.Except
import Data.Monoid (Sum (..))
import Data.Proxy
import Data.Time (Day)
import Data.Void
import Network.HTTP.Client (Manager)
import Servant.API
import Servant.Client
import Web.Harvest.API.Type
import qualified Data.ByteString.Char8 as BC8
import qualified Data.Time as Time
type Auth = BasicAuth "" Void
type HarvestAPI =
"people" :> Auth :> Get '[JSON] [User]
:<|> "daily" :> Capture "day" Word :> Capture "year" Word
:> QueryParam "of_user" UserId
:> Auth :> Get '[JSON] TimeEntries
type Query a = BasicAuthData -> Manager -> BaseUrl -> ClientM a
getUsers_ :: Query [User]
getTimeEntries_ :: Word -> Word -> Maybe UserId -> Query TimeEntries
getUsers_ :<|> getTimeEntries_ = client (Proxy :: Proxy HarvestAPI)
getUsers :: MonadIO m
=> Manager
-> Credentials
-> m (Either ServantError [User])
getUsers = runHarvestQuery getUsers_
getTimeEntries :: MonadIO m
=> Manager
-> Credentials
-> Day
-> UserId
-> m (Either ServantError TimeEntries)
getTimeEntries manager creds date uid =
runHarvestQuery (getTimeEntries_ day year (Just uid)) manager creds
where (day, year) = getDayAndYear date
runHarvestQuery :: MonadIO m
=> (BasicAuthData -> Manager -> BaseUrl -> ClientM a)
-> Manager
-> Credentials
-> m (Either ServantError a)
runHarvestQuery action manager Credentials {..} = liftIO $ do
let host = BC8.unpack credentialsAccount ++ ".harvestapp.com"
authData = BasicAuthData credentialsUsername credentialsPassword
runExceptT (action authData manager (BaseUrl Https host 443 ""))
getDayAndYear :: Day -> (Word, Word)
getDayAndYear date = (day, fromIntegral year)
where
(year, month, day') = Time.toGregorian date
day = fromIntegral . (+ day') . getSum . foldMap
(Sum . Time.gregorianMonthLength year) $ [1..pred month]