packages feed

flowdock-api (empty) → 0.1.0.0

raw patch · 14 files changed

+1572/−0 lines, 14 filesdep +HsOpenSSLdep +MonadCatchIO-transformersdep +aesonsetup-changed

Dependencies added: HsOpenSSL, MonadCatchIO-transformers, aeson, base, base64-bytestring, blaze-builder, bytestring, data-default, directory, filepath, heredoc, hspec, http-streams, http-types, io-streams, monad-logger, optparse-applicative, split, template-haskell, text, time, transformers, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2013 Gabriel McArthur++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ flowdock-api.cabal view
@@ -0,0 +1,171 @@+-- Initial flowdock-api.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                flowdock-api+version:             0.1.0.0+synopsis:            API integration with Flowdock.+homepage:            https://github.com/gabemc/flowdock-api+license:             MIT+license-file:        LICENSE+author:              Gabriel McArthur+maintainer:          gabriel.mcarthur@gmail.com+copyright:           Gabriel McArthur 2013+category:            Network+build-type:          Simple+cabal-version:       >=1.10++description:         This library uses the Network.HTTP.Client library to interact+                     with the FlowDock chat service.+                     .+                     * Push API - <https://www.flowdock.com/api/team-inbox>+                     .+                     * Streaming API - <https://www.flowdock.com/api/streaming>+                     .+                     * REST API - <https://www.flowdock.com/api/rest>++-- extra-source-files:  ++source-repository head+  type:     git+  location: git://github.com/gabemc/flowdock-api.git++executable flowdock+    default-language:    Haskell2010+    hs-source-dirs:      src+    main-is:             Main.hs+    ghc-options:+        -Wall+        -fwarn-tabs+        -funbox-strict-fields+        -rtsopts+        -threaded+        -with-rtsopts=-N+    default-extensions:+        DeriveGeneric+      , GeneralizedNewtypeDeriving+      , OverloadedStrings+      , TemplateHaskell+      , RecordWildCards+      , RankNTypes+      , FlexibleContexts+      , DeriveDataTypeable+      , PatternGuards+      , Arrows+      , CPP+    build-depends:+        base >=4 && < 5+      , aeson+      , base64-bytestring+      , blaze-builder+      , bytestring+      , data-default+      , directory+      , filepath+      , HsOpenSSL+      , http-streams+      , http-types+      , io-streams+      , MonadCatchIO-transformers+      , optparse-applicative +      , split+      , text+      , time+      , transformers+      , unordered-containers+      , vector+ +library+    default-language:    Haskell2010+    hs-source-dirs:      src+    ghc-options:+        -Wall+        -fwarn-tabs+        -funbox-strict-fields+        -rtsopts+        -with-rtsopts=-N+    default-extensions:+        DeriveGeneric+      , GeneralizedNewtypeDeriving+      , OverloadedStrings+      , TemplateHaskell+      , RecordWildCards+      , RankNTypes+      , FlexibleContexts+      , DeriveDataTypeable+      , PatternGuards+      +    exposed-modules:     +        Flowdock+      , Flowdock.MessageTypes+      , Flowdock.Push+      , Flowdock.REST.Flow+      , Flowdock.REST.User+      , Flowdock.REST.Organization+      , Flowdock.REST.Invitation+      , Flowdock.REST.Source+          +    other-modules:       +        Flowdock.Internal++    -- other-extensions:    +    build-depends:+        base >=4 && < 5+      , aeson+      , base64-bytestring+      , blaze-builder+      , bytestring+      , data-default+      , HsOpenSSL+      , http-streams+      , http-types+      , io-streams+      , MonadCatchIO-transformers+      , monad-logger+      , text+      , time+      , transformers+      , unordered-containers+      , vector+      +test-suite spec+    type:              exitcode-stdio-1.0+    default-language:  Haskell2010+    main-is:           Spec.hs+    hs-source-dirs:    specs,src+    ghc-options:       -Wall+    default-extensions:+        DeriveGeneric+      , GeneralizedNewtypeDeriving+      , OverloadedStrings+      , TemplateHaskell+      , RecordWildCards+      , RankNTypes+      , FlexibleContexts+      , DeriveDataTypeable+      , PatternGuards+      , QuasiQuotes++    build-depends:+      -- Library+        base >=4 && < 5+      , aeson+      , base64-bytestring+      , blaze-builder+      , bytestring+      , data-default+      , HsOpenSSL+      , http-streams+      , http-types+      , io-streams+      , MonadCatchIO-transformers+      , monad-logger+      , text+      , time+      , transformers+      , unordered-containers+      , vector++      -- Tests+      , heredoc+      , hspec+      , template-haskell
+ specs/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ src/Flowdock.hs view
@@ -0,0 +1,4 @@+module Flowdock where++version :: String+version = "0.1.0"
+ src/Flowdock/Internal.hs view
@@ -0,0 +1,70 @@+-- |+-- Module       : Flowdock.Internal+-- License      : MIT License+-- Maintainer   : Gabriel McArthur <gabriel.mcarthur@gmail.com>+-- Stability    : experimental+-- Portability  : portable++module Flowdock.Internal+  ( createUrl+  , underscoreCase+  , picosecondsToUTCTime+  ) where++import           Blaze.ByteString.Builder+import           Blaze.ByteString.Builder.Char.Utf8+import           Data.ByteString            (ByteString)+import           Data.Char                  (isUpper, toLower)+import           Data.Text                  (Text)+import qualified Data.Text                  as Text+import           Data.Text.Encoding         (encodeUtf8)+import           Data.Time.Clock            (UTCTime, NominalDiffTime)+import           Data.Time.Clock.POSIX      (posixSecondsToUTCTime)+import           Data.Maybe+import           Data.Monoid+import           Network.HTTP.Types.URI++-- | Create a URL from a base URL and a list of relative paths, returning+-- the full URL+createUrl :: [Text]         -- ^ Relative paths+          -> [(Text, Text)] -- ^ Query parameters+          -> ByteString+createUrl relativePaths params = toByteString $+    if null params+      then path+      else path <> queryString+  where+    stripSlashes txt = txt''+      where+        txt' = if "/" `Text.isSuffixOf` txt+                  then fromJust $ Text.stripSuffix "/" txt+                  else txt+        txt'' = if "/" `Text.isPrefixOf` txt'+                  then fromJust $ Text.stripPrefix "/" txt'+                  else txt'++    path = foldr ((\p acc -> fromText "/" <> p <> acc) . fromText . stripSlashes) mempty relativePaths++    paramToQuery (k,v) = let k' = encodeUtf8 k in+                         if Text.null v+                           then (k', Nothing)+                           else (k', Just $ encodeUtf8 v)++    queryString = renderQueryBuilder True $ map paramToQuery params++underscoreCase :: String -> String+underscoreCase = underscoreCase' True+  where+    underscoreCase' _    []       = []+    underscoreCase' prev (x : xs) = if isUpper x+                                      then if prev+                                             then toLower x : underscoreCase' True xs+                                             else '_' : toLower x : underscoreCase' True xs+                                      else x : underscoreCase' False xs++-- | Turns picoseconds into UTCTime+picosecondsToUTCTime :: Integer -> UTCTime+picosecondsToUTCTime pico = posixSecondsToUTCTime posixSeconds+    where+      posixSeconds :: NominalDiffTime+      posixSeconds = fromInteger $ pico `div` (1000000 :: Integer)
+ src/Flowdock/MessageTypes.hs view
@@ -0,0 +1,152 @@+module Flowdock.MessageTypes where++import           Control.Applicative+import           Control.Monad+import           Data.Aeson+import           Data.Int+import           Data.Text                  (Text)++-- -----------------------------------------------------------------------------+-- Deserialized Data Types++data EventAction = AddPeople { people :: !Text }+                 | Joined+                 | Block { userId :: !Text }+                 | Invite { emails :: !Text }+                 | Decline { emails :: !Text }+                 | Uninvite { emails :: !Text }+                 | AddRssFeed { url :: !Text }+                 | RemoveRssFeed { url :: !Text }+                 | AddTwitterFollower { twitterUser :: !Text }+                 | RemoveTwitterFollower { twitterFollower :: !Text }+                 | AddTwitterSearch { twitterTerm :: !Text }+                 | RemoveTwitterSearch { twitterTerm :: !Text }+                 deriving (Eq, Show)++instance FromJSON EventAction where+  parseJSON (Object o) = do+    actionType <- o .: "type"+    case (actionType :: Text) of+      "add_people"              -> AddPeople <$> o .: "description"+      "join"                    -> return Joined+      "block"                   -> Block <$> o .: "description"+      "invite"                  -> Invite <$> o .: "descrption"+      "decline"                 -> Decline <$> o .: "description"+      "uninvite"                -> Uninvite <$> o .: "description"+      "add_rss_feed"            -> AddRssFeed <$> o .: "description"+      "remove_rss_feed"         -> RemoveRssFeed <$> o .: "decription"+      "add_twitter_follower"    -> AddTwitterFollower <$> o .: "description"+      "remove_twitter_follower" -> RemoveTwitterFollower <$> o .: "description"+      "add_twitter_search"      -> AddTwitterSearch <$> o .: "description"+      "remove_twitter_search"   -> RemoveTwitterSearch <$> o .: "description"+      _                         -> mzero+  parseJSON _ = mzero++data ImageDetails = ImageDetails { imageHeight :: !Int, imageWidth :: !Int } deriving (Eq, Show)++instance FromJSON ImageDetails where+  parseJSON (Object o) = ImageDetails <$> o .: "height" <*> o .: "width"+  parseJSON _ = mzero++data Thumbnail = Thumbnail { thumbnailHeight :: !Int, thumbnailWidth :: !Int, path :: !Text } deriving (Eq, Show)++instance FromJSON Thumbnail where+  parseJSON (Object o) = Thumbnail <$> o .: "height" <*> o .: "width" <*> o .: "path"+  parseJSON _ = mzero++data Attachment = Attachment+  { attachmentID          :: !(Maybe Text)+  , attachmentContentType :: !Text+  , attachmentFileName    :: !Text+  , attachmentFileSize    :: !Int+  , attachmentFilePath    :: !Text+  }+  deriving (Eq, Show)++instance FromJSON Attachment where+  parseJSON (Object o) = do+    cid   <- o .:? "content_id"+    ctype <- o .: "content_type"+    fname <- o .: "file_name"+    fsize <- o .: "file_size"+    fpath <- o .: "path"+    return $ Attachment cid ctype fname fsize fpath+  parseJSON _ = mzero++data EventType = Message { content :: !Text }+               | Status  { content :: !Text }+               | Comment { title :: !Text+                         , text :: !Text }+               | Action !EventAction+               | TagChange { messageID :: !Int+                           , addedTags :: ![Text]+                           , removedTags :: ![Text] }+               | MessageEdit { messageID :: !Int+                             , updatedContent :: !Text }+               | UserActivity { lastActivity :: !Int64 }+               | File { filePath :: !Text+                      , fileName :: !Text+                      , fileSize :: !Int+                      , contentType :: !Text+                      , imageDetails :: !(Maybe ImageDetails)+                      , thumbnail :: !(Maybe Thumbnail)+                      }+               deriving (Eq, Show)++instance FromJSON EventType where+  parseJSON (Object o) = do+    eventType <- o .: "event"+    case (eventType :: Text) of+      "message" -> Message <$> o .: "content"+      "status"  -> Status <$> o .: "content"+      "comment" -> do+        cnt <- o .: "content"+        Comment <$> cnt .: "title" <*> cnt .: "text"+      "action"  -> do+        ob <- o .: "content"+        Action <$> parseJSON ob+      "tag-change" -> do+        cnt <- o .: "content"+        TagChange <$> cnt .: "message" <*> cnt .: "add" <*> cnt .: "remove"+      "message-edit" -> do+        cnt <- o .: "content"+        MessageEdit <$> cnt .: "message" <*> cnt .: "updated_content"+      "activity.user" -> do+        cnt <- o .: "content"+        UserActivity <$> cnt .: "last_activity"+      "file" -> do+        cnt <- o .: "content"+        File <$> cnt .: "path"+             <*> cnt .: "file_name"+             <*> cnt .: "file_size"+             <*> cnt .: "content_type"+             <*> cnt .:? "image"+             <*> cnt .:? "thumbnail"+      _ -> mzero+  parseJSON _ = error "4"++data Event = Event+  { eventID          :: !Int+  , eventApp         :: !(Maybe Text)+  , eventTags        :: ![Text]+  , eventUuid        :: !(Maybe Text)+  , eventFlow        :: !Text+  , eventSent        :: !Int64+  , eventAttachments :: ![Attachment]+  , eventUser        :: !Text+  , eventType        :: !EventType+  }+  deriving (Eq, Show)++instance FromJSON Event where+  parseJSON obj@(Object o) = do+    eid  <- o .: "id"+    app  <- o .:? "app"+    tags <- o .: "tags"+    uuid <- o .:? "uuid"+    flow <- o .: "flow"+    att  <- o .: "attachments"+    sent <- o .: "sent"+    user <- o .: "user"+    Event eid app tags uuid flow sent att user <$> parseJSON obj+  parseJSON _ = mzero
+ src/Flowdock/Push.hs view
@@ -0,0 +1,189 @@+-- |+-- Module       : Flowdock.Push+-- License      : MIT License+-- Maintainer   : Gabriel McArthur <gabriel.mcarthur@gmail.com>+-- Stability    : experimental+-- Portability  : portable+--+-- This is a module for interacting with the Push API of Flowdock.+--+-- Example usage, by sending a chat message to another user might be,+-- in the IO monad:+--+-- > let chat = Chat { chatContent = "Hey, how are you?",+-- >                 , externalUserName = "ian"+-- >                 , chatTags = Nothing }+-- > let auth = PushApiToken "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"+-- > pushAPI conn $ do+-- >     push chat+--+-- If you happen to be in a monad that implements MonadIO, MonadLogger,+-- and MonadBaseControl IO (as in Yesod), you can also use+-- `runPushApiT` or `runPushApiLogging`.++module Flowdock.Push+  (+  -- * Types of messages+    PushEvent(..)++  -- * Authentication+  , PushApiToken(..)+  , mkApiToken++  -- * Monad Transformers+  , PushAPI+  , pushAPI++  -- * Sending messages+  , push+  ) where++import           Control.Applicative+import           Control.Monad+import           Control.Monad.CatchIO+import           Control.Monad.IO.Class     (liftIO, MonadIO)+import           Control.Monad.Trans.Reader+import           Data.Aeson+import           Data.ByteString            (ByteString)+import qualified Data.ByteString            as BS+import           Data.Char                  (isHexDigit)+import           Data.Maybe+import           Data.Text                  (Text,unpack)+import qualified Data.Text                  as Text+import           Data.Text.Encoding         (decodeUtf8)+import           Network.Http.Client+import           OpenSSL                    (withOpenSSL)+import           System.IO.Streams          (InputStream)+import qualified System.IO.Streams          as Streams++import           Flowdock.Internal++-- -----------------------------------------------------------------------------+-- Push Events++data PushEvent+  -- | A kind of message that is sent to a team inbox.+  = TeamInbox+    -- Required+    { source       :: !Text         -- ^ Human-readable name of the application that uses Flowdock+    , fromAddress  :: !Text         -- ^ Email address of the message sender+    , subject      :: !Text         -- ^ Subject line of the message+    , inboxContent :: !Text         -- ^ HTML-like body content+    -- Optional+    , fromName     :: !(Maybe Text) -- ^ The name of the message sender.+    , replyTo      :: !(Maybe Text) -- ^ The email address for replies to the message+    , project      :: !(Maybe Text) -- ^ Project for message categorization+    , inboxTags    :: !(Maybe [Text]) -- ^ A list of tags+    , link         :: !(Maybe Text) -- ^ Link associated with the message+    }+  -- | A kind of message that is sent to another user.+  | Chat+    { chatContent  :: !Text           -- ^ Content of message.+    , chatUserName :: !Text           -- ^ The external user.+    , chatTags     :: !(Maybe [Text]) -- ^ Optional tags to add to the message.+    } deriving (Show, Eq)++instance ToJSON PushEvent where+    toJSON TeamInbox{..} =+      object $ catMaybes [ Just $ "source" .= source+                         , Just $ "from_address" .= fromAddress+                         , Just $ "subject" .= subject+                         , Just $ "content" .= inboxContent+                         , ("from_name" .=) <$> fromName+                         , ("reply_to" .=) <$> replyTo+                         , ("content" .=) <$> project+                         , ("tags" .=) <$> inboxTags+                         , ("link" .=) <$> link+                         ]+    toJSON Chat{..} =+      object $ catMaybes [ Just $ "content" .= chatContent+                         , Just $ "external_user_name" .= chatUserName+                         , ("tags" .=) <$> chatTags+                         ]++-- To get the relative URLs from the types of messages+class RelativeUrl a where+    getRelativeUrl :: a -> Text++instance RelativeUrl PushEvent where+    getRelativeUrl TeamInbox{..} = "/v1/messages/team_inbox/"+    getRelativeUrl Chat{..}      = "/v1/messages/chat/"++-- -----------------------------------------------------------------------------+-- API Tokens++-- | Flowdock tokens are 32 character hexadecimal digits.+newtype PushApiToken = PushApiToken {pushApiToken :: Text}+    deriving (Eq, Show)++-- | Parses some text into a possible Api token+mkApiToken :: Text -> Maybe PushApiToken+mkApiToken txt =+    if rightLength && allHex+      then Just $ PushApiToken txt+      else Nothing+  where+    allHex = Text.all isHexDigit txt+    rightLength = Text.length txt == 32++-- -----------------------------------------------------------------------------+-- PushApi Requests++data Env = Env+    { apiToken :: !PushApiToken   -- ^ The API token to access the server+    }++data Error+    = Internal String+    | External Text++instance Show Error where+    show (Internal str) = "Inernal Error: " ++ str+    show (External txt) = "Exteranal Error: " ++ unpack txt++-- -----------------------------------------------------------------------------+-- PushApi Requests++newtype PushAPI a = PushAPI { unwrap :: ReaderT Env IO a }+                    deriving (Applicative, Functor, Monad, MonadIO, MonadCatchIO, MonadPlus)++pushAPI :: MonadIO m => PushApiToken -> PushAPI a => m a+pushAPI token api = liftIO $ runReaderT (unwrap api) conn+  where+    conn = Env token++push :: PushEvent+     -> PushAPI (Maybe Error)+push event = PushAPI $ do+    Env{..} <- ask+    liftIO $ withOpenSSL $+      bracket (open "api.flowdock.com") closeConnection (request apiToken)+  where+    open host = do+        ctx <- baselineContextSSL+        openConnectionSSL ctx host 443++    request apiToken conn = do+        enc <- Streams.fromLazyByteString $ encode event+        req <- buildRequest $ do+            http POST $ createUrl [getRelativeUrl event, pushApiToken apiToken] []+            setAccept "application/json"+            setContentType "application/json"+        sendRequest conn req $ inputStreamBody enc+        receiveResponse conn response++-- -----------------------------------------------------------------------------+-- Internal++response :: Response -> InputStream ByteString -> IO (Maybe Error)+response resp body =+    case getStatusCode resp of+      200 -> return Nothing+      201 -> return Nothing+      400 -> failure+      500 -> failure+      n   -> return $ Just $ Internal $ "Flowdock returned a bad status code: " ++ show n+  where+    failure = do+      body' <- BS.concat <$> Streams.toList body+      return $ Just $ External $ decodeUtf8 body'
+ src/Flowdock/REST/Flow.hs view
@@ -0,0 +1,178 @@+module Flowdock.REST.Flow+  (+  -- | Fetch data types+    Flow(..)+  , FlowOrganization(..)+  , FlowAccessMode(..)+  , Flows(..)++  -- | Update data types+  , CreateFlow(..)+  , FlowUpdate(..)++  -- | Flow API calls+  , listFlows+  , listAllFlows+  , getFlow+  , getFlowById+  , createFlow+  , updateFlow+  ) where++import           Control.Monad+import           Data.Aeson+import           Data.Aeson.TH+import           Data.Aeson.Types+import           Data.Char                  (toLower)+import           Data.Text                  (Text, pack)+import           Data.Vector                (toList)+import           GHC.Generics+import           Network.Http.Client        (Method(..))++import           Flowdock.Internal+import           Flowdock.REST+import           Flowdock.REST.User++-- -----------------------------------------------------------------------------+-- Deserialized Data Types++-- | The organization associated with a flow.+data FlowOrganization = FlowOrganization+    { organizationId                :: !Int+    , organizationName              :: !Text+    , organizationParamaterizedName :: !Text+    , userLimit                     :: !Int+    , userCount                     :: !Int+    , organizationActive            :: !Bool+    , organizationUrl               :: !Text+    } deriving(Show, Eq)++instance FromJSON FlowOrganization where+    parseJSON (Object o) = do+      oid                 <- o .: "id"+      name                <- o .: "name"+      paramaterized_name  <- o .: "parameterized_name"+      user_limit          <- o .: "user_limit"+      user_count          <- o .: "user_count"+      active              <- o .: "active"+      url                 <- o .: "url"+      return $ FlowOrganization oid name paramaterized_name user_limit user_count active url+    parseJSON _ = mzero++-- $(deriveFromJSON defaultOptions{fieldLabelModifier = flowOrganizationFromJSON} ''FlowOrganization)++data FlowAccessMode+    = Invitation+    | Link+    | Organization+    deriving (Generic, Show, Eq)++instance FromJSON FlowAccessMode where+    -- parseJSON = genericParseJSON defaultOptions { constructorTagModifier = map toLower }+    parseJSON (String s)+      | s == "invitation"   = return Invitation+      | s == "link"         = return Link+      | s == "organization" = return Organization+    parseJSON _ = mzero++$(deriveToJSON defaultOptions{constructorTagModifier = Prelude.map toLower} ''FlowAccessMode)++data Flow = Flow+    { flowId                :: !Text              -- ^ The flow ID+    , flowName              :: !Text              -- ^ Human readable name of the flow+    , flowParameterizedName :: !Text              -- ^ flow name for URLs (I think)+    , flowOrganization      :: !FlowOrganization  -- ^ Organization information+    , flowUnreadMentions    :: !Int+    , flowOpen              :: !Bool+    , flowJoined            :: !Bool+    , flowUrl               :: !Text+    , flowWebUrl            :: !Text+    , flowJoinUrl           :: !(Maybe Text)+    , flowAccessMode        :: !FlowAccessMode+    , flowUsers             :: !(Maybe [User])+    } deriving(Show, Eq)++instance FromJSON Flow where+    parseJSON (Object o) = do+      fid                <- o .: "id"+      name               <- o .: "name"+      paramaterized_name <- o .: "parameterized_name"+      organization       <- o .: "organization"+      unread_mentions    <- o .: "unread_mentions"+      open               <- o .: "open"+      joined             <- o .: "joined"+      url                <- o .: "url"+      web_url            <- o .: "web_url"+      join_url           <- o .:? "join_url"+      access_mode        <- o .: "access_mode"+      users              <- o .:? "users"+      return $ Flow fid name paramaterized_name organization unread_mentions open joined url web_url join_url access_mode users+    parseJSON _ = mzero++-- $(deriveFromJSON defaultOptions{fieldLabelModifier = camelToUnderscoreDrop 4} ''Flow)++newtype Flows = Flows { flows :: [Flow] } deriving(Show, Eq)++instance FromJSON Flows where+    parseJSON (Array as) = do+      flows <- mapM parseJSON $ toList as :: Parser [Flow]+      return $ Flows flows+    parseJSON _          = mzero++-- -----------------------------------------------------------------------------+-- Serialized Data Types++data CreateFlow = CreateFlow !Text deriving (Show, Eq)++instance ToJSON CreateFlow where+    toJSON (CreateFlow name) = object [ "name" .= name ]++data FlowUpdate = FlowUpdate+    { flowUpdateName       :: !Text+    , flowUpdateOpen       :: !Bool+    , flowUpdateDisabled   :: !Bool+    , flowUpdateAccessMode :: !FlowAccessMode+    } deriving (Show, Eq)++$(deriveToJSON defaultOptions{fieldLabelModifier = underscoreCase . drop 10} ''FlowUpdate)++-- -----------------------------------------------------------------------------+-- API Calls++includeUsers :: Bool -> Text+includeUsers True  = "1"+includeUsers False = "0"++listFlows :: Bool  -- ^ Whether to list the included users+          -> RestAPI (Either Error Flows)+listFlows user =+    request GET ["flows"] [("users", includeUsers user)] Nothing++listAllFlows :: Bool -- ^ Whether to list the included users+             -> RestAPI (Either Error Flows)+listAllFlows user =+    request GET ["flows", "all"] [("users", includeUsers user)] Nothing++getFlow :: Text -- ^ The paramaterized name of the organization+        -> Text -- ^ The parameterized name of the flow+        -> RestAPI (Either Error Flow)+getFlow organization flow =+    request GET ["flows", organization, flow] [] Nothing++getFlowById :: Int -- ^ The ID of the flow+            -> RestAPI (Either Error Flow)+getFlowById fid =+    request GET ["flows", "find"] [("id", pack $ show fid)] Nothing++createFlow :: Text       -- ^ The paramaterized name of the organization+           -> CreateFlow -- ^ The name to create+           -> RestAPI (Either Error Flow)+createFlow organization cf =+    request POST ["flows", organization] [] (Just $ encode cf)++updateFlow :: Text      -- ^ The paramaterized name of the organization+           -> Text      -- ^ The paramaterized name of the flow+           -> FlowUpdate -- ^ The command to update the flow+           -> RestAPI (Either Error Flow)+updateFlow organization flow fu =+    request PUT ["flows", organization, flow] [] (Just $ encode fu)
+ src/Flowdock/REST/Invitation.hs view
@@ -0,0 +1,136 @@+module Flowdock.REST.Invitation+  (+  -- * Types+    Invitation(..)+  , Invitations(..)+  , InvitationState(..)+  , ImportAddressMessage(..)+  , ImportAddressResponse(..)+  , CreateInvitation(..)++  -- * API+  , listInvitations+  , getInvitation+  , createInvitation+  , importAddressList+  , deleteInvitation+  ) where++import           Control.Monad+import           Data.Aeson+import           Data.Aeson.TH+import           Data.Aeson.Types+import           Data.Text                  (Text, pack)+import           Data.Vector                (toList)+import           Network.Http.Client        (Method(..))++import           Flowdock.Internal+import           Flowdock.REST+import           Flowdock.REST.User++-- -----------------------------------------------------------------------------+-- Deserialized Types++data InvitationState = Pending | Accepted deriving (Eq, Show)++instance FromJSON InvitationState where+    parseJSON (String s) =+      case s of+        "pending" -> return Pending+        "accepted" -> return Accepted+        _         -> mzero+    parseJSON _ = mzero++data Invitation = Invitation+    { invitationID    :: !Int+    , invitationState :: !InvitationState+    , invitationEmail :: !Text+    , flowResource    :: !Text+    , invitationURL   :: !Text+    } deriving (Eq, Show)++instance FromJSON Invitation where+    parseJSON (Object o) = do+      iid         <- o .: "id"+      state       <- o .: "state"+      email       <- o .: "email"+      flow        <- o .: "flow"+      url         <- o .: "url"+      return $ Invitation iid state email flow url+    parseJSON _ = mzero++newtype Invitations = Invitations { invitations :: [Invitation] } deriving (Show, Eq)++instance FromJSON Invitations where+    parseJSON (Array as) = do+      invitations <- mapM parseJSON $ toList as :: Parser [Invitation]+      return $ Invitations invitations+    parseJSON _ = mzero++data ImportAddressResponse = ImportAddressResponse+    { importInvitations :: ![Invitation]+    , importAddedUsers  :: ![User]+    , importErroneousEmails :: ![Object]+    } deriving (Eq, Show)++instance FromJSON ImportAddressResponse where+    parseJSON (Object o) = do+      invitations    <- o .: "invitations"+      addedUsers     <- o .: "added_users"+      erroneousEmails <- o .: "erroneous_emails"+      return $ ImportAddressResponse invitations addedUsers erroneousEmails+    parseJSON _ = mzero++-- -----------------------------------------------------------------------------+-- Serialized Types++data CreateInvitation = CreateInvitation+    { targetEmail   :: !Text+    , targetMessage :: !Text+    } deriving (Eq, Show)++$(deriveToJSON defaultOptions{fieldLabelModifier = underscoreCase . drop 6} ''CreateInvitation)++data ImportAddressMessage = ImportAddressMessage+    { addressList    :: !Text+    , addressMessage :: !Text+    } deriving (Eq, Show)++$(deriveToJSON defaultOptions{fieldLabelModifier = underscoreCase . drop 7} ''ImportAddressMessage)++-- -----------------------------------------------------------------------------+-- API Calls++listInvitations :: Text -- ^ Organization parmaterized name+                -> Text -- ^ Flow paramaterized name+                -> RestAPI (Either Error Invitations)+listInvitations organization flow =+    request GET ["flows", organization, flow, "invitations"] [] Nothing++getInvitation :: Text -- ^ Organization parmaterized name+              -> Text -- ^ Flow paramaterized name+              -> Int  -- ^ Invitation ID+              -> RestAPI (Either Error Invitation)+getInvitation organization flow iid =+    request GET ["flows", organization, flow, "invitations", pack $ show iid] [] Nothing++createInvitation :: Text -- ^ Organization parmaterized name+                 -> Text -- ^ Flow paramaterized name+                 -> CreateInvitation+                 -> RestAPI (Either Error Invitation)+createInvitation organization flow cinv =+    request POST ["flows", organization, flow, "invitations"] [] (Just $ encode cinv)++importAddressList :: Text -- ^ Organization parmaterized name+                  -> Text -- ^ Flow paramaterized name+                  -> ImportAddressMessage -- ^ The import message+                  -> RestAPI (Either Error ImportAddressResponse)+importAddressList organization flow iam =+    request POST ["flows", organization, flow, "invitations", "import"] [] (Just $ encode iam)++deleteInvitation :: Text -- ^ Organization parmaterized name+                 -> Text -- ^ Flow paramaterized name+                 -> Int  -- ^ Invitation ID+                 -> RestAPI (Either Error Success)+deleteInvitation organization flow iid =+    request DELETE ["flows", organization, flow, "invitations", pack $ show iid] [] Nothing
+ src/Flowdock/REST/Organization.hs view
@@ -0,0 +1,119 @@+module Flowdock.REST.Organization+    ( Organization(..)+    , Subscription(..)+    , OrganizationUser(..)+    , Organizations(..)+    , OrgNameUpdate(..)++    -- * API Calls+    , listOrganizations+    , getOrganization+    , getOrganizationByID+    , updateOrganization+    ) where++import           Control.Monad+import           Data.Aeson+import           Data.Aeson.TH+import           Data.Aeson.Types+import           Data.Text                  (Text, pack)+-- import           Data.Time.Clock            (UTCTime)+import           Data.Vector                (toList)+import           GHC.Generics+import           Network.Http.Client        (Method(..))++import           Flowdock.REST+import           Flowdock.Internal++-- -----------------------------------------------------------------------------+-- Deserialized Types++data Subscription = Subscription+    { trial     :: !Bool+    , trialEnds :: !Text -- TODO: UTCTime+    } deriving (Eq, Show, Generic)++instance FromJSON Subscription where+    parseJSON = genericParseJSON $ defaultOptions { fieldLabelModifier = underscoreCase }++data OrganizationUser = OrganizationUser+    { userID      :: !Int+    , userName    :: !Text+    , userEmail   :: !Text+    , isAdmin     :: !Bool+    } deriving (Eq, Show)++instance FromJSON OrganizationUser where+    parseJSON (Object o) = do+      uid       <- o .: "id"+      name      <- o .: "name"+      email     <- o .: "email"+      isAdmin   <- o .: "admin"+      return $ OrganizationUser uid name email isAdmin+    parseJSON _ = mzero++data Organization = Organization+    { orgID             :: !Int+    , paramaterizedName :: !Text+    , orgName           :: !Text+    , orgUserLimit      :: !Int+    , orgUserCount      :: !Int+    , orgIsActive       :: !Bool+    , orgURL            :: !Text+    , orgSubscription   :: !Subscription+    , orgUsers          :: ![OrganizationUser]+    } deriving (Eq, Show)++instance FromJSON Organization where+    parseJSON (Object o) = do+      oid                  <- o .: "id"+      paramaterizedName    <- o .: "parameterized_name"+      name                 <- o .: "name"+      userLimit            <- o .: "user_limit"+      userCount            <- o .: "user_count"+      isActive             <- o .: "active"+      url                  <- o .: "url"+      subscription         <- o .: "subscription"+      users                <- o .: "users"+      return $ Organization oid paramaterizedName name userLimit userCount isActive url subscription users+    parseJSON _ = mzero++newtype Organizations = Organizations { organizations :: [Organization] } deriving(Show, Eq)++instance FromJSON Organizations where+    parseJSON (Array as) = do+      organizations <- mapM parseJSON $ toList as :: Parser [Organization]+      return $ Organizations organizations+    parseJSON _          = mzero++-- -----------------------------------------------------------------------------+-- Serialized Types++data OrgNameUpdate = OrgNameUpdate+  { displayName   :: !Text+  } deriving (Eq, Show)++$(deriveToJSON defaultOptions{fieldLabelModifier = underscoreCase . drop 7} ''OrgNameUpdate)++-- -----------------------------------------------------------------------------+-- API Calls++listOrganizations :: RestAPI (Either Error Organizations)+listOrganizations =+    request GET ["organizations"] [] Nothing++getOrganization :: Text -- ^ The paramaterized organization name+                -> RestAPI (Either Error Organization)+getOrganization organization =+    request GET ["organizations", organization] [] Nothing++getOrganizationByID :: Int -- ^ The organization ID+                    -> RestAPI (Either Error Organization)+getOrganizationByID oid =+    request GET ["organizations", "find"] [("id", pack $ show oid)] Nothing++updateOrganization :: Text          -- ^ The paramaterized organization name+                   -> OrgNameUpdate -- ^ The name to update it to.+                   -> RestAPI (Either Error Organization)+updateOrganization organization update =+    request PUT ["organizations", organization] [] (Just $ encode update)
+ src/Flowdock/REST/Source.hs view
@@ -0,0 +1,148 @@+module Flowdock.REST.Source+  (+  -- * Types+    SourceType(..)+  , Source(..)+  , Sources(..)+  , Feed(..)+  , TwitterFollower(..)+  , TwitterKeyword(..)++  -- * API calls+  , listSources+  , getSource+  , createSource+  , deleteSource+  ) where++import           Control.Applicative+import           Control.Monad+import           Data.Aeson+import           Data.Aeson.TH+import           Data.Aeson.Types+import           Data.Text                  (Text)+import           Data.Vector                (toList)+import           Network.Http.Client        (Method(..))++import           Flowdock.Internal+import           Flowdock.REST++-- -----------------------------------------------------------------------------+-- Deserialized Types++data Feed = Feed { feedURL :: !Text, feedTitle :: !(Maybe Text)}+    deriving (Eq, Show)++instance FromJSON Feed where+    parseJSON (Object o) = do+      url    <- o .: "url"+      title  <- o .: "title"+      return $ Feed url title+    parseJSON _ = mzero++$(deriveToJSON defaultOptions{fieldLabelModifier = underscoreCase . drop 4} ''Feed)++data TwitterKeyword = TwitterKeyword+    { keywordParam    :: !Text+    , keywordReplies  :: !Bool+    , keywordRetweets :: !Bool+    } deriving (Eq, Show)++instance FromJSON TwitterKeyword where+    parseJSON (Object o) = do+      param     <- o .: "param"+      replies   <- o .: "replies"+      retweets  <- o .: "retweets"+      return $ TwitterKeyword param replies retweets+    parseJSON _ = mzero++$(deriveToJSON defaultOptions{fieldLabelModifier = underscoreCase . drop 7} ''TwitterKeyword)++data TwitterFollower = TwitterFollower+    { followerTwitterUserId :: !Text+    , followerParam         :: !Text+    , followerName          :: !Text+    , followerReplies       :: !Bool+    , followerRetweets      :: !Bool+    } deriving (Eq, Show)++instance FromJSON TwitterFollower where+    parseJSON (Object o) = do+      tid       <- o .: "twitter_user_id"+      param     <- o .: "param"+      name      <- o .: "name"+      replies   <- o .: "replies"+      retweets  <- o .: "retweets"+      return $ TwitterFollower tid param name replies retweets+    parseJSON _  = mzero++$(deriveToJSON defaultOptions{fieldLabelModifier = underscoreCase . drop 8} ''TwitterFollower)++data SourceType+    = Atom Feed+    | Follower TwitterFollower+    | Keyword TwitterKeyword+    deriving (Eq, Show)++instance ToJSON SourceType where+    toJSON (Atom feed)  = object ["type" .= ("feed" :: Text), "config" .= toJSON feed]+    toJSON (Follower f) = object ["type" .= ("twitter_user" :: Text), "config" .= toJSON f]+    toJSON (Keyword kw) = object ["type" .= ("twitter_keyword" :: Text), "config" .= toJSON kw]++data Source = Source+    { sourceId    :: !Text+    , sourceType  :: !SourceType+    , sourceURL   :: !Text+    } deriving (Eq, Show)++instance FromJSON Source where+    parseJSON (Object o) = do+      sid        <- o .: "id"+      stype      <- o .: "type"+      config     <-+        case (stype :: Text) of+          "feed"            -> Atom     <$> o .: "config"+          "twitter_keyword" -> Keyword  <$> o .: "config"+          "twitter_user"    -> Follower <$> o .: "config"+          _                 -> mzero+      url         <- o .: "url"+      return $ Source sid config url+    parseJSON _ = mzero++newtype Sources = Sources { sources :: [Source] } deriving (Eq, Show)++instance FromJSON Sources where+    parseJSON (Array as) = do+      sources <- mapM parseJSON $ toList as :: Parser [Source]+      return $ Sources sources+    parseJSON _          = mzero++-- -----------------------------------------------------------------------------+-- API Calls++listSources :: Text -- ^ Organization paramaterized name+            -> Text -- ^ Flow parameterized name+            -> RestAPI (Either Error Sources)+listSources organization flow =+    request GET ["flows", organization, flow, "sources"] [] Nothing++getSource :: Text -- ^ Organization paramaterized name+          -> Text -- ^ Flow parameterized name+          -> Text -- ^ Source ID+          -> RestAPI (Either Error Source)+getSource organization flow sid =+    request GET ["flows", organization, flow, "source", sid] [] Nothing++createSource :: Text -- ^ Organization paramaterized name+             -> Text -- ^ Flow parameterized name+             -> SourceType -- ^ The source to create+             -> RestAPI (Either Error Source)+createSource organization flow stype =+    request POST ["flows", organization, flow, "sources"] [] (Just $ encode stype)++deleteSource :: Text -- ^ Organization paramaterized name+             -> Text -- ^ Flow parameterized name+             -> Text -- ^ Source ID+             -> RestAPI (Either Error Success)+deleteSource organization flow sid =+    request DELETE ["flows", organization, flow, "source", sid] [] Nothing
+ src/Flowdock/REST/User.hs view
@@ -0,0 +1,129 @@+module Flowdock.REST.User+  ( User(..)+  , Users(..)+  , UserInformation(..)+  , UserStatus(..)+  , UserID(..)++  -- * API functions+  , getUser+  , getUsers+  , getFlowUsers+  , updateUserInfo+  , addUserToFlow+  , setUserAccess+  ) where++import           Control.Applicative+import           Control.Monad+import           Data.Aeson+import           Data.Aeson.Types+import           Data.Text                  (Text, pack)+import           Data.Time.Clock            (UTCTime)+import           Data.Vector                (toList)+import           Network.Http.Client        (Method(..))++import           Flowdock.Internal+import           Flowdock.REST++-- -----------------------------------------------------------------------------+-- Deserialized Types++data User = User+    { userId           :: !Int+    , userName         :: !Text+    , userNick         :: !Text+    , userEmail        :: !Text+    , userAvatar       :: !Text+    , userStatus       :: !(Maybe Text)+    , userDisabled     :: !Bool+    , userLastActivity :: !(Maybe UTCTime)+    , userLastPing     :: !(Maybe UTCTime)+    } deriving(Show, Eq)++instance FromJSON User where+    parseJSON (Object o) = do+      fid           <- o .: "id"+      name          <- o .: "name"+      nick          <- o .: "nick"+      email         <- o .: "email"+      avatar        <- o .: "avatar"+      status        <- o .:? "status"+      disabled      <- o .:? "disabled" .!= False+      last_activity <- o .:? "last_activity"+      last_ping     <- o .:? "last_ping"+      return $ User fid name nick email+                    avatar status disabled+                    (picosecondsToUTCTime <$> last_activity)+                    (picosecondsToUTCTime <$> last_ping)+    parseJSON _ = mzero++-- $(deriveFromJSON defaultOptions{fieldLabelModifier = camelToUnderscoreDrop 4} ''FlowUser)++newtype Users = Users { users :: [User] } deriving (Show, Eq)++instance FromJSON Users where+    parseJSON (Array as) = do+      users <- mapM parseJSON $ toList as :: Parser [User]+      return $ Users users+    parseJSON _ = mzero++-- -----------------------------------------------------------------------------+-- Serialized Types++data UserInformation = UserInformation+    { nickInfo  :: !Text+    , emailInfo :: !Text+    } deriving (Eq, Show)++instance ToJSON UserInformation where+    toJSON UserInformation{..} = object ["nick" .= nickInfo, "email" .= emailInfo]++newtype UserID = UserID { userID :: Int } deriving (Eq, Show)++instance ToJSON UserID where+    toJSON UserID{..} = object ["id" .= userID]++newtype UserStatus = UserStatus { isUserDisabled :: Bool } deriving (Eq, Show)++instance ToJSON UserStatus where+    toJSON UserStatus{..} = object ["disabled" .= isUserDisabled]++-- -----------------------------------------------------------------------------+-- API Functions++getUser :: Int -- ^ User ID+        -> RestAPI (Either Error User)+getUser uid =+    request GET ["users", pack $ show uid] [] Nothing++getUsers :: () -> RestAPI (Either Error Users)+getUsers _ =+    request GET ["users"] [] Nothing++getFlowUsers :: Text -- ^ Organization+             -> Text -- ^ Flow+             -> RestAPI (Either Error Users)+getFlowUsers organization flow =+    request GET ["flows", organization, flow, "users"] [] Nothing++updateUserInfo :: Int             -- ^ User ID+               -> UserInformation -- ^ User information to update+               -> RestAPI (Either Error Success)+updateUserInfo uid userInfo =+    request PUT ["users", pack $ show uid] [] (Just $ encode userInfo)++addUserToFlow :: Text -- ^ Organization+              -> Text -- ^ Flow+              -> UserID+              -> RestAPI (Either Error Success)+addUserToFlow organization flow userID =+    request POST ["flows", organization, flow, "users"] [] (Just $ encode userID)++setUserAccess :: Text -- ^ Organization+              -> Text -- ^ Flow+              -> Int  -- ^ User ID+              -> UserStatus+              -> RestAPI (Either Error Success)+setUserAccess organization flow uid us =+    request POST ["flows", organization, flow, "users", pack $ show uid] [] (Just $ encode us)
+ src/Main.hs view
@@ -0,0 +1,252 @@+module Main where++import           Control.Applicative+import           Control.Monad+import           Control.Monad.IO.Class+import           Data.Aeson+import qualified Data.ByteString.Lazy as LB+import           Data.List (isPrefixOf, intercalate)+import           Data.List.Split (splitOn)+import           Data.Text (Text, pack)+import           Options.Applicative+import           Options.Applicative.Arrows+import           System.Exit+import           System.FilePath+import           System.Directory+import           System.IO++import qualified Flowdock as Flowdock+import qualified Flowdock.Push as Push++-- -----------------------------------------------------------------------------+-- Option Handling++data Args = Args GlobalOptions Command+          deriving Show++data GlobalOptions = GlobalOptions+    { globalConfigFile  :: !(Maybe FilePath)+    } deriving Show++data Command+    = Chat ChatOptions+    | Inbox InboxOptions+    deriving Show++data ChatOptions = ChatOptions+    { chatUserName :: !String+    , chatTags     :: !(Maybe String)+    , chatMessage  :: !String+    } deriving Show++data InboxOptions = InboxOptions+    { messageSource   :: !String+    , messageFrom     :: !String+    , messageSubject  :: !String+    , messageBody     :: !String+    , messageFromName :: !(Maybe String)+    , messageReplyTo  :: !(Maybe String)+    , messageProject  :: !(Maybe String)+    , messageTags     :: !(Maybe String)+    , messageLink     :: !(Maybe String)+    } deriving Show++version :: Parser (a -> a)+version = infoOption Flowdock.version+  ( long "version"+  <> help "Print the version information." )++parser :: Parser Args+parser = runA $ proc () -> do+    opts <- asA globalOptions -< ()+    cmds <- (asA . hsubparser)+              ( command "chat"+                  (info chatParser+                        (progDesc "Sends a chat message to another user."))+              <> command "inbox"+                  (info inboxParser+                        (progDesc "Sends a message to a team inbox."))) -< ()+    A version >>> A helper -< Args opts cmds++globalOptions :: Parser GlobalOptions+globalOptions = GlobalOptions+            <$> optional (strOption+                ( long "config-file"+                <> short 'c'+                <> metavar "CONFIG"+                <> help "The config file to use."))++chatParser :: Parser Command+chatParser = runA $ proc () -> do+    config <- asA chatOptions -< ()+    returnA -< Chat config++chatOptions :: Parser ChatOptions+chatOptions = ChatOptions+            <$> strOption+                ( long "other-user"+                <> short 'u'+                <> metavar "USER_NAME"+                <> help "The other user to send the chat message to.")+            <*> optional (strOption+                ( long "tags"+                <> short 't'+                <> metavar "TAGS"+                <> help "Tags to attach to the message, separated by commas." ))+            <*> argument str (metavar "MESSAGE")++inboxParser :: Parser Command+inboxParser = runA $ proc () -> do+    config <- asA inboxOptions -< ()+    returnA -< Inbox config++inboxOptions :: Parser InboxOptions+inboxOptions = InboxOptions+            <$> strOption+              ( long "source"+              <> short 'p'+              <> metavar "PROGRAM"+              <> help "The source program using Flowdock." )+            <*> strOption+              ( long "from"+              <> short 'f'+              <> metavar "EMAIL"+              <> help "Email address of the message sender." )+            <*> strOption+              ( long "subject"+              <> short 's'+              <> metavar "SUBJECT"+              <> help "The subject of the message." )+            <*> argument str (metavar "CONTENT")+            <*> optional (strOption+              ( long "from-name"+              <> short 'n'+              <> metavar "NAME"+              <> help "The name of the message sender." ))+            <*> optional (strOption+              ( long "reply-to"+              <> short 'r'+              <> metavar "REPLY_TO"+              <> help "The email address for replies to this message." ))+            <*> optional (strOption+              ( long "project"+              <> short 'P'+              <> metavar "PROJECT"+              <> help "Project for message categorization." ))+            <*> optional (strOption+              ( long "tags"+              <> short 't'+              <> metavar "TAGS"+              <> help "A list of tags, separated by commas." ))+            <*> optional (strOption+              ( long "link"+              <> short 'l'+              <> metavar "LINK"+              <> help "The link associated with this message." ))++-- -----------------------------------------------------------------------------+-- JSON Configuration++data FlowdockConfig = FlowdockConfig+    { apiToken :: Text+    } deriving Show++instance FromJSON FlowdockConfig where+    parseJSON (Object o) = do+      token <- o .: "api-token"+      return $ FlowdockConfig token+    parseJSON _ = mzero++defaultPaths :: [FilePath]+defaultPaths = ["~/.flowdock.json", "/etc/flowdock.json"]++expandPath :: FilePath -> IO (FilePath)+expandPath path =+    if "~/" `isPrefixOf` path+      then do+        homeDir <- getHomeDirectory+        return $ joinPath [homeDir, tail $ tail path]+      else return path++lookupConfig :: FilePath -> IO (Either String FlowdockConfig)+lookupConfig path = do+    fullPath <- expandPath path+    exists   <- doesFileExist fullPath+    if exists+      then do+        contents <- LB.readFile fullPath+        return $ eitherDecode contents+      else do+        return $ Left $ "Unable to locate file: " ++ path++findConfig :: Maybe FilePath -> IO (Either String FlowdockConfig)+findConfig (Just cf) = lookupConfig cf+findConfig Nothing   = findConfig' defaultPaths+  where+    findConfig' :: [FilePath] -> IO (Either String FlowdockConfig)+    findConfig' (f:fs) = do+      config <- lookupConfig f+      case config of+        Left _   -> findConfig' fs+        Right fc -> return $ Right fc+    findConfig' [] = do+      return $ Left $ "Unable to find any configuration files at: " ++ (intercalate " " defaultPaths)++-- -----------------------------------------------------------------------------+-- Main++chat :: FlowdockConfig -> ChatOptions -> IO ()+chat (FlowdockConfig apiToken) (ChatOptions user tags message) = do+    let tags' = splitOn "," <$> tags+    let msg = Push.Chat (pack message)+                        (pack user)+                        ((map pack) <$> tags')+    Push.pushAPI (Push.PushApiToken apiToken) $ do+        response <- Push.push msg+        case response of+            Nothing  ->+              liftIO $ exitSuccess+            Just err -> do+              liftIO $ hPutStrLn stderr $ show err+              liftIO $ exitFailure++inbox :: FlowdockConfig -> InboxOptions -> IO ()+inbox (FlowdockConfig apiToken) (InboxOptions source from subject body name replyTo project tags link) = do+    let tags' = splitOn "," <$> tags+    let msg = Push.TeamInbox (pack source)+                             (pack from)+                             (pack subject)+                             (pack body)+                             (pack <$> name)+                             (pack <$> replyTo)+                             (pack <$> project)+                             ((map pack) <$> tags')+                             (pack <$> link)+    Push.pushAPI (Push.PushApiToken apiToken) $ do+        response <- Push.push msg+        case response of+          Nothing -> do+            liftIO $ exitSuccess+          Just err -> do+            liftIO $ hPutStrLn stderr $ show err+            liftIO $ exitFailure++run :: Args -> IO ()+run (Args (GlobalOptions configFile) cmd) = do+    config <- findConfig configFile+    case config of+      Left err -> do+        putStrLn err+        exitFailure+      Right flowdockConfig ->+        case cmd of+          Chat chatOpts   -> chat flowdockConfig chatOpts+          Inbox inboxOpts -> inbox flowdockConfig inboxOpts++main :: IO ()+main = execParser opts >>= run+  where+    opts = info parser+            ( fullDesc+            <> progDesc "Sends messages via the Flowdock API."+            <> header "flowdock - a way to send messages to Flowdock.")