packages feed

harvest-api (empty) → 0.1.0

raw patch · 9 files changed

+481/−0 lines, 9 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, file-embed, harvest-api, hspec, http-client, mtl, servant, servant-client, text, time, transformers

Files

+ CHANGELOG.md view
+ LICENSE.md view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Stack Builders++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.
+ README.md view
@@ -0,0 +1,15 @@+# Harvest API++[![CircleCI](https://circleci.com/gh/stackbuilders/harvest-api.svg?style=svg&circle-token=1f9cf54be4f5b977dddf02e5398d8ce2c66ffd87)](https://circleci.com/gh/stackbuilders/harvest-api)++Haskell bindings to [Harvest API](http://help.getharvest.com/api/).++## Quick start++*Coming soon…*++## License++Copyright © 2016 Stack Builders++Distributed under MIT license.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ Web/Harvest/API.hs view
@@ -0,0 +1,100 @@+-- |+-- Module      :  Web.Harvest.API+-- Copyright   :  © 2016 Stack Builders+-- License     :  MIT+--+-- Maintainer  :  Mark Karpov <mkarpov@stackbuilders.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- High-level bindings to the Harvest web API.++{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TypeOperators     #-}++module Web.Harvest.API+  ( -- * Types+    module Web.Harvest.API.Type+    -- * Users+  , getUsers+    -- * Timesheets+  , 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 representation of Basic Auth. We don't serve the API, so user type+-- is just 'Void'.++type Auth = BasicAuth "" Void++-- | Entire Harvest API as a type.++type HarvestAPI =+       "people" :> Auth :> Get '[JSON] [User]+  :<|> "daily"  :> Capture "day" Word :> Capture "year" Word+                :> QueryParam "of_user" UserId+                :> Auth :> Get '[JSON] TimeEntries++-- | A shortcut for the boilerplate arguments.++type Query a = BasicAuthData -> Manager -> BaseUrl -> ClientM a++getUsers_       :: Query [User]+getTimeEntries_ :: Word -> Word -> Maybe UserId -> Query TimeEntries++getUsers_ :<|> getTimeEntries_ = client (Proxy :: Proxy HarvestAPI)++-- | Get list of all users for specific account.++getUsers :: MonadIO m+  => Manager           -- ^ HTTPS manager+  -> Credentials       -- ^ Credentials+  -> m (Either ServantError [User]) -- ^ Result of request+getUsers = runHarvestQuery getUsers_++-- | Get time entries for specific date and user.++getTimeEntries :: MonadIO m+  => Manager           -- ^ HTTPS manager+  -> Credentials       -- ^ Credentials+  -> Day               -- ^ Date of interest+  -> UserId            -- ^ User id+  -> m (Either ServantError TimeEntries)+getTimeEntries manager creds date uid =+  runHarvestQuery (getTimeEntries_ day year (Just uid)) manager creds+  where (day, year) = getDayAndYear date++-- | A helper to run a query against Harvest API.++runHarvestQuery :: MonadIO m+  => (BasicAuthData -> Manager -> BaseUrl -> ClientM a) -- ^ Query function+  -> Manager           -- ^ HTTPS Manager+  -> Credentials       -- ^ Credentials+  -> m (Either ServantError a) -- ^ The result+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 ""))++-- | Extract day and year from given date. Days are in the range from 1 to+-- 366.++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]
+ Web/Harvest/API/Type.hs view
@@ -0,0 +1,151 @@+-- |+-- Module      :  Web.Harvest.API.Type+-- Copyright   :  © 2016 Stack Builders+-- License     :  MIT+--+-- Maintainer  :  Mark Karpov <mkarpov@stackbuilders.com>+-- Stability   :  experimental+-- Portability :  portable+--+-- Used types, they are re-exported in "Web.Harvest.API", so you can import+-- just that module.++{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE RecordWildCards            #-}++module Web.Harvest.API.Type+  ( Credentials (..)+  , UserId (..)+  , User (..)+  , TimeEntryId (..)+  , TimeEntries (..)+  , TimeEntry (..) )+where++import Data.Aeson+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Time (UTCTime, Day)+import Servant.API++-- | Information that is necessary for interaction with Harvest API.++data Credentials = Credentials+  { credentialsUsername :: ByteString -- ^ Username+  , credentialsPassword :: ByteString -- ^ Password+  , credentialsAccount  :: ByteString -- ^ Account (name of your organization)+  } deriving (Eq, Ord, Show)++-- | User identifier.++newtype UserId = UserId { unUserId :: Word }+  deriving (Eq, Ord, Show, FromJSON, ToHttpApiData)++-- | User record.++data User = User+  { userId           :: UserId -- ^ User id+  , userEmail        :: Text -- ^ Email address+  , userCreatedAt    :: UTCTime -- ^ When the user was created+  , userIsAdmin      :: Bool -- ^ Is the user admin?+  , userFirstName    :: Text -- ^ The user's first name+  , userLastName     :: Text -- ^ The user's last name+  , userTimeZone     :: Text -- ^ The user's time zone ('Text' for now)+  , userIsContractor :: Bool -- ^ Is the user contractor?+  , userTelephone    :: Text -- ^ User's telephone+  , userIsActive     :: Bool -- ^ Is it an active user?+  , userAccessFuture :: Bool+    -- ^ Does he\/she have access to all future projects?+  , userDefaultHourlyRate :: Word -- ^ Default hourly rate+  , userDepartment   :: Maybe Text -- ^ User's department+  , userWantsNewsletter :: Bool+    -- ^ Does he\/she want to recieve newsletter?+  , userUpdatedAt    :: UTCTime -- ^ Time of last update of account+  , userCostRate     :: Maybe Word -- ^ User's cost rate+  , userIdentityAccountId :: Maybe Word -- ^ Identity account id+  , userIdentityUserId :: Maybe Word -- ^ Identity user id+  } deriving (Eq, Ord, Show)++instance FromJSON User where+  parseJSON = withObject "User" $ \o -> do+    u                <- o .: "user"+    userId           <- u .: "id"+    userEmail        <- u .: "email"+    userCreatedAt    <- u .: "created_at"+    userIsAdmin      <- u .: "is_admin"+    userFirstName    <- u .: "first_name"+    userLastName     <- u .: "last_name"+    userTimeZone     <- u .: "timezone"+    userIsContractor <- u .: "is_contractor"+    userTelephone    <- u .: "telephone"+    userIsActive     <- u .: "is_active"+    userAccessFuture <- u .: "has_access_to_all_future_projects"+    userDefaultHourlyRate <- u .: "default_hourly_rate"+    userDepartment   <- u .: "department"+    userWantsNewsletter <- u .: "wants_newsletter"+    userUpdatedAt    <- u .: "updated_at"+    userCostRate     <- u .: "cost_rate"+    userIdentityAccountId <- u .:? "identity_account_id"+    userIdentityUserId <- u .:? "identity_user_id"+    return User {..}++-- | Collection of entries for specific day.++-- TODO This response also contains the "projects" field with some stuff,+-- we could parse it as well, but let's skip it for now.++data TimeEntries = TimeEntries+  { teForDay     :: Day -- ^ That collection is for this day+  , teDayEntries :: [TimeEntry] -- ^ Collection of time entries+  } deriving (Eq, Ord, Show)++instance FromJSON TimeEntries where+  parseJSON = withObject "TimeEntries" $ \o -> do+    teDayEntries <- o .: "day_entries"+    teForDay     <- o .: "for_day"+    return TimeEntries {..}++-- | Time entry identifier.++newtype TimeEntryId = TimeEntryId+  { unTimeEntryId :: Word }+  deriving (Eq, Ord, Show, FromJSON)++-- | A time entry.++data TimeEntry = TimeEntry+  { teProjectId :: Text -- ^ Project id+  , teProject   :: Text -- ^ Project+  , teUserId    :: UserId -- ^ User id+  , teSpentAt   :: Day  -- ^ The day this time is spent on+  , teTaskId    :: Text -- ^ Task id+  , teTask      :: Text -- ^ Task name+  , teClient    :: Text -- ^ Client name+  , teId        :: TimeEntryId -- ^ Time entry id+  , teNotes     :: Maybe Text -- ^ Notes+  , teTimerStartedAt :: Maybe UTCTime+    -- ^ When the task was started, if 'Nothing' — timer is not running+  , teCreatedAt :: UTCTime -- ^ When the task was created+  , teUpdatedAt :: UTCTime -- ^ When the task was updated+  , teHoursWithoutTimer :: Double -- ^ Hours without timer+  , teHours     :: Double -- ^ Hours+  } deriving (Eq, Ord, Show)++instance FromJSON TimeEntry where+  parseJSON = withObject "TimeEntry" $ \o -> do+    teProjectId      <- o .: "project_id"+    teProject        <- o .: "project"+    teUserId         <- o .: "user_id"+    teSpentAt        <- o .: "spent_at"+    teTaskId         <- o .: "task_id"+    teTask           <- o .: "task"+    teClient         <- o .: "client"+    teId             <- o .: "id"+    teNotes          <- o .: "notes"+    teTimerStartedAt <- o .:? "timer_started_at"+    teCreatedAt      <- o .: "created_at"+    teUpdatedAt      <- o .: "updated_at"+    teHoursWithoutTimer <- o .: "hours_without_timer"+    teHours          <- o .: "hours"+    return TimeEntry {..}
+ harvest-api.cabal view
@@ -0,0 +1,61 @@+name:                 harvest-api+version:              0.1.0+cabal-version:        >= 1.10+license:              MIT+license-file:         LICENSE.md+author:               Stack Builders+maintainer:           Mark Karpov <mkarpov@stackbuilders.com>+homepage:             https://github.com/stackbuilders/harvest-api+bug-reports:          https://github.com/stackbuilders/harvest-api/issues+category:             Web+synopsis:             Bindings for Harvest API+build-type:           Simple+description:          Bindings for Harvest API.+extra-source-files:   CHANGELOG.md+                    , README.md++source-repository head+  type:               git+  location:           https://github.com/stackbuilders/harvest-api.git++flag dev+  description:        Turn on development settings.+  manual:             True+  default:            False++library+  build-depends:      aeson            >= 0.11+                    , base             >= 4.8 && < 5+                    , bytestring       >= 0.10.4.1+                    , http-client      >= 0.4.26+                    , mtl              >= 2.2.0.1+                    , servant          >= 0.7+                    , servant-client   >= 0.7+                    , text             >= 1.2+                    , time             >= 1.5.0.1+                    , transformers     >= 0.4 && < 0.6+  exposed-modules:    Web.Harvest.API+                    , Web.Harvest.API.Type+  if flag(dev)+    ghc-options:      -Wall -Werror+  else+    ghc-options:      -O2 -Wall+  default-language:   Haskell2010++test-suite tests+  main-is:            Spec.hs+  hs-source-dirs:     tests+  type:               exitcode-stdio-1.0+  build-depends:      aeson            >= 0.11+                    , base             >= 4.8 && < 5+                    , bytestring       >= 0.10.4.1+                    , file-embed+                    , harvest-api      >= 0.1.0+                    , hspec            >= 2.0+                    , time             >= 1.5.0.1+  other-modules:      Web.Harvest.APISpec+  if flag(dev)+    ghc-options:      -Wall -Werror+  else+    ghc-options:      -O2 -Wall+  default-language:   Haskell2010
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/Web/Harvest/APISpec.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell   #-}++module Web.Harvest.APISpec+  ( main+  , spec )+where++import Data.FileEmbed+import Data.Time+import Test.Hspec+import Web.Harvest.API+import qualified Data.Aeson as A++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+  describe "getUsers (JSON parsing)"       getUsersJsonSpec+  describe "getTimeEntries (JSON parsing)" getTimeEntriesJsonSpec++getUsersJsonSpec :: Spec+getUsersJsonSpec =+  context "when parsing API response" $+    it "returns correct data" $+      result `shouldBe` Just+        [ User+          { userId        = UserId 508343+          , userEmail     = "user@example.com"+          , userCreatedAt = UTCTime+            { utctDay = ModifiedJulianDay 56412+            , utctDayTime = secondsToDiffTime 73692 }+          , userIsAdmin   = True+          , userFirstName = "Harvest"+          , userLastName  = "User"+          , userTimeZone  = "Eastern Time (US & Canada)"+          , userIsContractor = False+          , userTelephone = ""+          , userIsActive  = True+          , userAccessFuture = True+          , userDefaultHourlyRate = 0+          , userDepartment = Just ""+          , userWantsNewsletter = True+          , userUpdatedAt  = UTCTime+            { utctDay = ModifiedJulianDay 57141+            , utctDayTime = secondsToDiffTime 53659 }+          , userCostRate = Nothing+          , userIdentityAccountId = Nothing+          , userIdentityUserId = Nothing }+        , User+          { userId        = UserId 508343+          , userEmail     = "user@example.com"+          , userCreatedAt = UTCTime+            { utctDay = ModifiedJulianDay 56412+            , utctDayTime = secondsToDiffTime 73692 }+          , userIsAdmin   = True+          , userFirstName = "John"+          , userLastName  = "Smith"+          , userTimeZone  = "Eastern Time (US & Canada)"+          , userIsContractor = False+          , userTelephone = ""+          , userIsActive  = True+          , userAccessFuture = True+          , userDefaultHourlyRate = 0+          , userDepartment = Nothing+          , userWantsNewsletter = False+          , userUpdatedAt  = UTCTime+            { utctDay = ModifiedJulianDay 57141+            , utctDayTime = secondsToDiffTime 53659 }+          , userCostRate = Nothing+          , userIdentityAccountId = Just 302900+          , userIdentityUserId = Just 20725 }+        ]+  where+    response = $(embedFile "data-examples/people.json")+    result = A.decodeStrict response++getTimeEntriesJsonSpec :: Spec+getTimeEntriesJsonSpec =+  context "when parsing API response" $+    it "returns correct data" $+      shouldBe result . Just . TimeEntries (ModifiedJulianDay 57414) $+        [ TimeEntry+          { teProjectId = "5198193"+          , teProject   = "Internal"+          , teUserId    = UserId 508343+          , teSpentAt   = ModifiedJulianDay 57414+          , teTaskId    = "2892243"+          , teTask      = "Internal Development"+          , teClient    = "Apple"+          , teId        = TimeEntryId 420923769+          , teNotes     = Just "Here goes the description entered by the user."+          , teTimerStartedAt = Nothing+          , teCreatedAt = UTCTime+            { utctDay = ModifiedJulianDay 57414+            , utctDayTime = secondsToDiffTime 14844 }+          , teUpdatedAt = UTCTime+            { utctDay = ModifiedJulianDay 57414+            , utctDayTime = secondsToDiffTime 19697 }+          , teHoursWithoutTimer = 1.16+          , teHours     = 2.77 }+        , TimeEntry+          { teProjectId = "5198193"+          , teProject   = "Internal"+          , teUserId    = UserId 508343+          , teSpentAt   = ModifiedJulianDay 57414+          , teTaskId    = "2892243"+          , teTask      = "Internal Development"+          , teClient    = "Apple"+          , teId        = TimeEntryId 420923783+          , teNotes     = Nothing+          , teTimerStartedAt = Just UTCTime+            { utctDay = ModifiedJulianDay 57414+            , utctDayTime = secondsToDiffTime 19697 }+          , teCreatedAt = UTCTime+            { utctDay = ModifiedJulianDay 57414+            , utctDayTime = secondsToDiffTime 14844 }+          , teUpdatedAt = UTCTime+            { utctDay = ModifiedJulianDay 57414+            , utctDayTime = secondsToDiffTime 19697 }+          , teHoursWithoutTimer = 1+          , teHours     = 2 }+        ]+  where+    response = $(embedFile "data-examples/daily.json")+    result = A.decodeStrict response