pinboard 0.6.5 → 0.7.5

raw patch · 7 files changed

+104/−115 lines, 7 filesdep +http-clientdep +http-client-tlsdep −HsOpenSSLdep −haskell-src-extsdep −http-streamsPVP ok

version bump matches the API change (PVP)

Dependencies added: http-client, http-client-tls

Dependencies removed: HsOpenSSL, haskell-src-exts, http-streams, io-streams

API changes (from Hackage documentation)

Files

• CHANGELOG.md +0/−0
• README.md +0/−13
• changelog.md +16/−0
• pinboard.cabal +5/−7
• src/Pinboard/ApiTypes.hs +8/−10
• src/Pinboard/Client.hs +73/−83
• src/Pinboard/Client/Types.hs +2/−2

@@ -41,16 +41,3 @@ [Pinboard.ApiTypes](https://hackage.haskell.org/package/pinboard/docs/Pinboard-ApiTypes.html)    Pinboard Data Structures returned by the Api--## Windows--This package relies on HsOpenSSL which requires a binary distribution of openssl--In order for this install to go smoothly one must install a binary distribution of openssl from here: --    http://slproweb.com/products/Win32OpenSSL.html -    -and link during the cabal install process like this (assuing default install directories):--    cabal install HsOpenSSL --extra-include-dirs="c:/OpenSSL-Win32/include" --extra-lib-dirs="c:/OpenSSL-Win32"-

@@ -0,0 +1,16 @@+__v0.7.5__++replacing/removing io-streams in favor of http-client++__v0.6.5__++compatability with both time < 1.5 and time >= 1.5++__v0.6.4__++add ability to update a post directly from a Post record (save an existing post)++__v0.6.3__++add ToJson instances+add pretty print function

@@ -1,5 +1,5 @@ name:                pinboard-version:             0.6.5+version:             0.7.5 synopsis:            Access to the Pinboard API license:             MIT license-file:        LICENSE@@ -31,7 +31,7 @@     >     Left pinboardError -> print pinboardError     . Extra-Source-Files:-        README.md CHANGELOG.md+        README.md changelog.md library    hs-source-dirs:      src   build-depends:       base >=4.6 && < 5.0@@ -39,14 +39,12 @@                      , bytestring                      , containers                      , either-                     , haskell-src-exts-                     , HsOpenSSL-                     , http-streams                      , http-types-                     , io-streams+                     , http-client+                     , http-client-tls                      , mtl >= 2.1.3.1-                     , network                      , old-locale+                     , network                      , random >= 1.1                      , text                      , time

@@ -21,8 +21,8 @@ import Data.Time           (UTCTime) import Data.Time.Calendar  (Day) -import Language.Haskell.Exts.Parser-import Language.Haskell.Exts.Pretty+-- import Language.Haskell.Exts.Parser+-- import Language.Haskell.Exts.Pretty import qualified Data.HashMap.Strict as HM import qualified Data.Vector as V @@ -284,15 +284,13 @@   parseJSON (Object o) = ToUpdateTime <$> (o .: "update_time")   parseJSON _ = error "bad parse" --- * Pretty--prettyString :: String -> String-prettyString s = case parseExp s of-    ParseOk x -> prettyPrint x-    ParseFailed{} -> s+-- prettyString :: String -> String+-- prettyString s = case parseExp s of+--     ParseOk x -> prettyPrint x+--     ParseFailed{} -> s -pretty :: Show a => a -> String-pretty = prettyString . show+-- pretty :: Show a => a -> String+-- pretty = prettyString . show  -- * Aliases 

@@ -27,16 +27,15 @@     , runPinboardSingleJson       -- * Sending     , sendPinboardRequest-    , sendPinboardRequestBS-      -- * Connections-    , connOpenRaw-    , connOpen-    , connClose-    , connFail-     -- * JSON Streams-    ,parseJSONResponseStream-    ,parseJSONFromStream+      -- *  Manager (http-client)+    , mgrOpenRaw+    , mgrOpen+    , mgrFail+     -- * JSON Handling+    ,parseJSONResponse+    ,decodeJSONResponse      -- * Status Codes+    ,checkStatusCodeResponse     ,checkStatusCode      -- * Error Helpers     ,addErrMsg@@ -55,23 +54,21 @@ import Control.Monad.Trans.Either (runEitherT, hoistEither) import Data.ByteString.Char8      (pack) import Data.Monoid                ((<>))-import Data.Aeson                 (parseJSON, json', FromJSON)-import Data.Aeson.Types           (parseEither)-import Network.Http.Client        (Request, Connection, Method (GET), baselineContextSSL, -                                   buildRequest, closeConnection, concatHandler, concatHandler', -                                   getStatusCode, http, openConnectionSSL, receiveResponse, sendRequest,-                                   setHeader, emptyBody, Response, StatusCode)+import Data.Aeson                 (FromJSON, eitherDecodeStrict')+ import Network                    (withSocketsDo) import Network.HTTP.Types         (urlEncode)-import OpenSSL                    (withOpenSSL)-import System.IO.Streams          (InputStream)-import System.IO.Streams.Attoparsec (parseFromStream)+import Network.HTTP.Types.Status  (statusCode) +import           Network.HTTP.Client+import           Network.HTTP.Client.TLS++ import Pinboard.Client.Types import Pinboard.Client.Error import Pinboard.Client.Util -import qualified Data.ByteString             as S+import qualified Data.ByteString.Lazy        as LBS import qualified Data.Text                   as T import qualified Data.Text.Encoding          as T @@ -89,16 +86,16 @@     :: PinboardConfig     -> Pinboard a     -> IO (Either PinboardError a)-runPinboard config requests = withOpenSSL $-  bracket connOpen connClose (either (connFail ConnectionFailure) go)-  where go conn = runReaderT (runEitherT requests) (config, conn) -                  `catch` connFail UnknownErrorType+runPinboard config requests = +  bracket mgrOpen return (either (mgrFail ConnectionFailure) go)+  where go mgr = runReaderT (runEitherT requests) (config, mgr) +                  `catch` mgrFail UnknownErrorType  -- | Create a Pinboard value from a PinboardRequest w/ json deserialization pinboardJson :: FromJSON a => PinboardRequest -> Pinboard a pinboardJson req = do -  (config, conn)  <- ask-  (_, result) <- liftIO $ sendPinboardRequest (ensureResultFormatType FormatJson req) config conn parseJSONResponseStream+  (config, mgr)  <- ask+  result <- liftIO $ sendPinboardRequest (ensureResultFormatType FormatJson req) config mgr parseJSONResponse   hoistEither result  @@ -107,18 +104,22 @@ runPinboardSingleRaw     :: PinboardConfig            -> PinboardRequest-    -> (Response -> InputStream S.ByteString -> IO a)+    -> (Response LBS.ByteString -> a)     -> IO (Either PinboardError a)-runPinboardSingleRaw config req handler = withOpenSSL $ -  bracket connOpen connClose (either (connFail ConnectionFailure) go)-    where go conn = (Right <$> sendPinboardRequest req config conn handler)-                    `catch` connFail UnknownErrorType +runPinboardSingleRaw config req handler = +  bracket mgrOpen return (either (mgrFail ConnectionFailure) go)+    where go mgr = (Right <$> sendPinboardRequest req config mgr handler)+                    `catch` mgrFail UnknownErrorType  runPinboardSingleRawBS     :: PinboardConfig            -> PinboardRequest-    -> IO (Either PinboardError S.ByteString)-runPinboardSingleRawBS config req = runPinboardSingleRaw config req concatHandler'+    -> IO (Either PinboardError LBS.ByteString)+runPinboardSingleRawBS config req = do+  res <- runPinboardSingleRaw config req id+  return $ do+    r <- res+    responseBody r <$ checkStatusCodeResponse r  runPinboardSingleJson     :: FromJSON a@@ -133,60 +134,53 @@ sendPinboardRequest       :: PinboardRequest        -> PinboardConfig -      -> Connection -      -> (Response -> InputStream S.ByteString -> IO a)+      -> Manager+      -> (Response LBS.ByteString -> a)       -> IO a-sendPinboardRequest PinboardRequest{..} PinboardConfig{..} conn handler = do-   let url = S.concat [ T.encodeUtf8 requestPath +sendPinboardRequest PinboardRequest{..} PinboardConfig{..} man handler = do+   let url = T.concat [ requestPath                        , "?" -                      , paramsToByteString $ ("auth_token", urlEncode False apiToken) : encodeParams requestParams ]-   req <- buildReq url-   sendRequest conn req emptyBody-   receiveResponse conn handler---sendPinboardRequestBS -  :: PinboardRequest -  -> PinboardConfig -  -> Connection -  -> IO (Response, S.ByteString) -sendPinboardRequestBS request config conn = sendPinboardRequest request config conn handler-  where handler response responseInputStream = do resultBS <- concatHandler response responseInputStream-                                                  return (response, resultBS)+                      , T.decodeUtf8 $ paramsToByteString $ ("auth_token", urlEncode False apiToken) : encodeParams requestParams ]+   req <- buildReq $ T.unpack url+   res <- httpLbs req man+   return $ handler res  -------------------------------------------------------------------------------- -buildReq ::  S.ByteString -> IO Request-buildReq url = buildRequest $ do-  http GET ("/v1/" <> url)-  setHeader "Connection" "Keep-Alive"  -  setHeader "User-Agent" "pinboard.hs/0.6.5"  +buildReq ::  String -> IO Request+buildReq url = do+  req <- parseUrl $ "https://api.pinboard.in/v1/" <> url+  return $ req +    { requestHeaders = [("User-Agent","pinboard.hs/0.7.5")]+    , checkStatus = \_ _ _ -> Nothing+    }  -------------------------------------------------------------------------------- -parseJSONResponseStream -    :: FromJSON a -    => Response -    -> InputStream S.ByteString-    -> IO (Response, Either PinboardError a)-parseJSONResponseStream response stream = -  (response,) <$> either (return . Left . addErrMsg (toText response)) -                         (const $ parseJSONFromStream stream) -                         (checkStatusCode $ getStatusCode response)+parseJSONResponse+    :: (FromJSON a)+    => Response LBS.ByteString+    -> Either PinboardError a+parseJSONResponse response = +  either (Left . addErrMsg (toText (responseBody response))) +         (const $ decodeJSONResponse (responseBody response)) +         (checkStatusCodeResponse response)  -parseJSONFromStream +decodeJSONResponse     :: FromJSON a -    => InputStream S.ByteString -    -> IO (Either PinboardError a)-parseJSONFromStream s = do -  r <- parseFromStream (parseEither parseJSON <$> json') s-  return $ either (Left . createParserErr . toText)  Right r-  `catch` connFail ParseFailure+    => LBS.ByteString +    -> Either PinboardError a+decodeJSONResponse s = +  let r = eitherDecodeStrict' (LBS.toStrict s) +  in either (Left . createParserErr . toText) Right r  -------------------------------------------------------------------------------- -checkStatusCode :: StatusCode -> Either PinboardError ()+checkStatusCodeResponse :: Response a -> Either PinboardError ()+checkStatusCodeResponse = checkStatusCode . statusCode . responseStatus++checkStatusCode :: Int -> Either PinboardError () checkStatusCode = \case   200 -> Right ()   400 -> httpStatusPinboardError BadRequest@@ -214,18 +208,14 @@ --------------------------------------------------------------------------------  -connOpenRaw :: IO Connection-connOpenRaw = withSocketsDo $ do-  ctx <- baselineContextSSL-  openConnectionSSL ctx "api.pinboard.in" 443--connOpen :: IO (Either SomeException Connection)-connOpen = try connOpenRaw+mgrOpenRaw :: IO Manager+mgrOpenRaw = withSocketsDo . newManager +                $ managerSetProxy (proxyEnvironment Nothing) tlsManagerSettings -connClose :: Either a Connection -> IO ()-connClose = either (const $ return ()) closeConnection+mgrOpen :: IO (Either SomeException Manager)+mgrOpen = try mgrOpenRaw -connFail :: PinboardErrorType -> SomeException -> IO (Either PinboardError b)-connFail e msg = return $ Left $ PinboardError e (toText msg) Nothing Nothing Nothing+mgrFail :: PinboardErrorType -> SomeException -> IO (Either PinboardError b)+mgrFail e msg = return $ Left $ PinboardError e (toText msg) Nothing Nothing Nothing  

@@ -19,14 +19,14 @@ import Control.Monad.Trans.Either (EitherT) import Data.ByteString            (ByteString) import Data.Text                  (Text)-import Network.Http.Client        (Connection)+import Network.HTTP.Client        (Manager) import Pinboard.Client.Error  (PinboardError (..)) import Data.Time.Calendar(Day) import Data.Time.Clock(UTCTime)  ------------------------------------------------------------------------------ -type Pinboard = EitherT PinboardError (ReaderT (PinboardConfig, Connection) IO)+type Pinboard = EitherT PinboardError (ReaderT (PinboardConfig, Manager) IO)  ------------------------------------------------------------------------------