User.hs

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)