hipbot 0.2 → 0.2.1

raw patch · 8 files changed

+31/−43 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• hipbot.cabal +1/−1
• pg.sql +1/−1
• src/HipBot.hs +1/−7
• src/HipBot/API.hs +0/−3
• src/HipBot/Internal/HipBot.hs +13/−10
• src/HipBot/Internal/OAuth.hs +5/−14
• src/HipBot/Internal/Resources.hs +5/−2
• src/HipBot/Internal/Types.hs +5/−5

@@ -1,5 +1,5 @@ name:               hipbot-version:            0.2+version:            0.2.1 license:            BSD3 license-file:       LICENSE author:             Richard Wallace <rwallace@atlassian.com>

@@ -5,5 +5,5 @@   groupId                  integer NOT NULL,   oauthSecret              char(40) NOT NULL,   accessToken              char(40) NOT NULL,-  accessTokenExpires       timestamp NOT NULL+  accessTokenExpires       timestamptz NOT NULL );

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}@@ -108,13 +109,6 @@     oid   fetch (reg, tok) = do     now <- liftIO getCurrentTime-    -- TODO get rid of this once confident the check is correct-    liftIO $ print $ mconcat-      [ "OAuthToken: expires="-      , show $ tok ^. expires-      , ", now="-      , show now-      ]     if addUTCTime 300 now < tok ^. expires       then right (reg, tok)       else updatedToken bot reg <&> (reg,)

@@ -6,7 +6,6 @@  module HipBot.API   ( HipBotAPI(..)-  , HasHipBotAPI(hipBotAPI)   , stmAPI   , pgAPI   ) where@@ -32,8 +31,6 @@   , apiLookupRegistration :: OAuthId -> m (Maybe (Registration, AccessToken))   , apiUpdateAccessToken :: OAuthId -> AccessToken -> m ()   }--makeClassy ''HipBotAPI  stmAPI :: MonadIO m => IO (HipBotAPI m) stmAPI = do

@@ -14,22 +14,25 @@ import HipBot.API import HipBot.Internal.Types +type OnUninstall m = OAuthId -> m ()+ data HipBot m = HipBot-  { botAPI :: HipBotAPI m-  , botAddOn :: AddOn-  , botManager :: HTTP.Manager+  { _hipBotHipBotAPI :: HipBotAPI m+  , _hipBotAddOn :: AddOn+  , _hipBotOnUninstall :: OnUninstall m+  , _hipBotManager :: HTTP.Manager   } -makeClassy ''HipBot+makeFields ''HipBot -instance HasHipBotAPI (HipBot m) m where-  hipBotAPI = hipBot . api where-    api f (HipBot a b c) = fmap (\ a' -> HipBot a' b c) (f a)+newHipBot :: HipBotAPI m -> AddOn -> OnUninstall m -> IO (HipBot m)+newHipBot api addon uninstall = HipBot api addon uninstall+  <$> HTTP.newManager tlsManagerSettings -newHipBot :: HipBotAPI m -> AddOn -> IO (HipBot m)-newHipBot api addon = HipBot api addon <$> HTTP.newManager tlsManagerSettings+newHipBot' :: Monad m => HipBotAPI m -> AddOn -> IO (HipBot m)+newHipBot' api addon = newHipBot api addon (const $ return ())  wreqDefaults :: HipBot m -> Wreq.Options wreqDefaults bot = Wreq.defaults-  & Wreq.manager .~ Right (botManager bot)+  & Wreq.manager .~ Right (bot ^. manager) 

@@ -125,7 +125,7 @@     [ "grant_type" .= A.String "client_credentials"     , "scope" .= unwords (show <$> capScopes)     ]-  capScopes = botAddOn bot ^. capabilities . folded . hipchatApiConsumer . folded . scopes+  capScopes = bot ^. addOn . capabilities . folded . hipchatApiConsumer . folded . scopes   handleErr =     handle (return . Left . FetchAccessTokenError reg turl) .     handle (return . Left . ParseAccessTokenError reg turl)@@ -141,20 +141,11 @@     <*> o .: "expires_in"  resolveExpiresIn :: HCAccessToken -> IO AccessToken-resolveExpiresIn t = do-  now <- getCurrentTime+resolveExpiresIn t =   let     diff = realToFrac . _hcExpiresIn $ t-    expiring = addUTCTime diff now-  -- TODO get rid of this once confident the timing is right-  print $ mconcat-    [ "OAuthToken: expires_in="-    , show (_hcExpiresIn t)-    , ", now="-    , show now-    , ", expiring="-    , show expiring-    ]-  return $ AccessToken (_hcAccessToken t) expiring+    expiring = addUTCTime diff+  in+    AccessToken (_hcAccessToken t) . expiring <$> getCurrentTime  

@@ -32,7 +32,7 @@   => HipBot m   -> Dispatcher (WaiResource m) hipBotResources bot = mconcat-  [ root ==> resourceWithJson' (botAddOn bot)+  [ root ==> resourceWithJson' (bot ^. addOn)   , "installations" ==> installationsResource bot   , "installations" </> param ==> installationResource bot   ]@@ -68,7 +68,10 @@   -> WaiResource m installationResource bot oid = resource   { allowedMethods = return [methodDelete]-  , deleteResource = (True <$) . lift . lift . apiDeleteRegistration (bot ^. hipBotAPI) $ oid+  , deleteResource = lift . lift $ do+      bot ^. onUninstall . to ($ oid)+      apiDeleteRegistration (bot ^. hipBotAPI) oid+      return True   }  configResource

@@ -54,7 +54,7 @@  instance IsString AbsoluteURI where   fromString s =-    fromMaybe (error $ "Not an absolute URI: " ++ s) (parseAbsoluteURI s)+    fromMaybe (error $ "Not an absolute URI: " <> s) (parseAbsoluteURI s)  instance A.ToJSON AbsoluteURI where   toJSON = A.toJSON . show@@ -72,13 +72,13 @@   , _addOnVendor :: Maybe Vendor   } deriving (Show, Eq) -addOn+defaultAddOn   :: Text -- ^ key   -> Text -- ^ name   -> Text -- ^ description   -> Links   -> AddOn-addOn k n d ls = AddOn k n d ls Nothing Nothing+defaultAddOn k n d ls = AddOn k n d ls Nothing Nothing  data Links = Links   { _linksSelf :: AbsoluteURI@@ -189,7 +189,7 @@     "send_notification" -> return SendNotification     "view_group" -> return ViewGroup     "view_messages" -> return ViewMessages-    s -> fail $ "unexpected API scope " ++ T.unpack s+    s -> fail $ "unexpected API scope " <> T.unpack s  data Webhook = Webhook   { _webhookUrl :: AbsoluteURI@@ -220,7 +220,7 @@     "room_exit" -> return RoomExit     "room_enter" -> return RoomEnter     "room_topic_change" -> return RoomTopicChange-    s -> fail $ "unexpected room event" ++ T.unpack s+    s -> fail $ "unexpected room event" <> T.unpack s  data Configurable = Configurable   { _configurableUrl :: AbsoluteURI