2f66d57 · typeable/pandoc

git.iko.soy/typeable/pandoc

Remove openURL from Shared (API change).

Now all the guts of openURL have been put into openURL from Class. openURL is now sensitive to stRequestHeaders in CommonState and will add these custom headers when making a request. It no longer looks at the USER_AGENT environment variable, since you can now set the `User-Agent` header directly.

commit2f66d57616c72ad82c64cf632a10d3e842eab533 authorJohn MacFarlane <jgm@berkeley.edu> dateSun 15 Oct 2017, 22:10 (9 years ago) parenta1f7a42

3 files changed+46−58

compare with master

unifiedsplit

pandoc.cabal+1 src/Text/Pandoc/Class.hs+44−7 src/Text/Pandoc/Shared.hs+1−51

pandoc.cabal+1

@@ -336,6 +336,7 @@ library

336336 http-client >= 0.4.30 && < 0.6,

337337 http-client-tls >= 0.2.4 && < 0.4,

338338 http-types >= 0.8 && < 0.10,

339+ case-insensitive >= 1.2 && < 1.3,

339340 csv-conduit >= 0.6 && < 0.7

340341 if os(windows)

341342 cpp-options: -D_WINDOWS

src/Text/Pandoc/Class.hs+44−7

@@ -1,10 +1,12 @@

11{-# LANGUAGE CPP #-}

2+{-# LANGUAGE PatternGuards #-}

23{-# LANGUAGE DeriveFunctor #-}

34{-# LANGUAGE TypeSynonymInstances #-}

45{-# LANGUAGE FlexibleInstances #-}

56{-# LANGUAGE GeneralizedNewtypeDeriving #-}

67{-# LANGUAGE FlexibleContexts #-}

78{-# LANGUAGE UndecidableInstances #-}

9+{-# LANGUAGE ScopedTypeVariables #-}

810#if MIN_VERSION_base(4,8,0)

911#else

1012{-# LANGUAGE OverlappingInstances #-}

@@ -97,9 +99,10 @@ import Prelude hiding (readFile)

9799import System.Random (StdGen, next, mkStdGen)

98100import qualified System.Random as IO (newStdGen)

99101import Codec.Archive.Zip

102+import qualified Data.CaseInsensitive as CI

100103import Data.Unique (hashUnique)

104+import Data.List (stripPrefix)

101105import qualified Data.Unique as IO (newUnique)

102−import qualified Text.Pandoc.Shared as Shared

103106import qualified Text.Pandoc.UTF8 as UTF8

104107import qualified System.Directory as Directory

105108import Text.Pandoc.Compat.Time (UTCTime)

@@ -115,9 +118,21 @@ import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds

115118 , posixSecondsToUTCTime

116119 , POSIXTime )

117120import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime, utc)

121+import Data.ByteString.Base64 (decodeLenient)

118122import Network.URI ( escapeURIString, nonStrictRelativeTo,

119123 unEscapeString, parseURIReference, isAllowedInURI,

120124 parseURI, URI(..) )

125+import Network.HTTP.Client (httpLbs, responseBody, responseHeaders,

126+ Request(port,host,requestHeaders))

127+import Network.HTTP.Client (parseRequest)

128+import Network.HTTP.Client (newManager)

129+import Network.HTTP.Client.Internal (addProxy)

130+import Network.HTTP.Client.TLS (tlsManagerSettings)

131+import System.Environment (getEnv)

132+import Network.HTTP.Types.Header ( hContentType )

133+import Network (withSocketsDo)

134+import Data.ByteString.Lazy (toChunks)

135+import qualified Control.Exception as E

121136import qualified Data.Time.LocalTime as IO (getCurrentTimeZone)

122137import Text.Pandoc.MediaBag (MediaBag, lookupMedia, mediaDirectory)

123138import Text.Pandoc.Walk (walkM, walk)

@@ -456,12 +471,34 @@ instance PandocMonad PandocIO where

456471 getCurrentTimeZone = liftIO IO.getCurrentTimeZone

457472 newStdGen = liftIO IO.newStdGen

458473 newUniqueHash = hashUnique <$> liftIO IO.newUnique

459− openURL u = do

460− report $ Fetching u

461− res <- liftIOError Shared.openURL u

462− case res of

463− Right r -> return r

464− Left e -> throwError $ PandocHttpError u e

474+

475+ openURL u

476+ | Just u'' <- stripPrefix "data:" u = do

477+ let mime = takeWhile (/=',') u''

478+ let contents = UTF8.fromString $

479+ unEscapeString $ drop 1 $ dropWhile (/=',') u''

480+ return (decodeLenient contents, Just mime)

481+ | otherwise = do

482+ let toReqHeader (n, v) = (CI.mk (UTF8.fromString n), UTF8.fromString v)

483+ customHeaders <- map toReqHeader <$> getsCommonState stRequestHeaders

484+ report $ Fetching u

485+ res <- liftIO $ E.try $ withSocketsDo $ do

486+ let parseReq = parseRequest

487+ proxy <- tryIOError (getEnv "http_proxy")

488+ let addProxy' x = case proxy of

489+ Left _ -> return x

490+ Right pr -> parseReq pr >>= \r ->

491+ return (addProxy (host r) (port r) x)

492+ req <- parseReq u >>= addProxy'

493+ let req' = req{requestHeaders = customHeaders ++ requestHeaders req}

494+ resp <- newManager tlsManagerSettings >>= httpLbs req'

495+ return (B.concat $ toChunks $ responseBody resp,

496+ UTF8.toString `fmap` lookup hContentType (responseHeaders resp))

497+

498+ case res of

499+ Right r -> return r

500+ Left e -> throwError $ PandocHttpError u e

501+

465502 readFileLazy s = liftIOError BL.readFile s

466503 readFileStrict s = liftIOError B.readFile s

467504

src/Text/Pandoc/Shared.hs+1−51

@@ -76,7 +76,6 @@ module Text.Pandoc.Shared (

7676 renderTags',

7777 -- * File handling

7878 inDirectory,

79− openURL,

8079 collapseFilePath,

8180 filteredFilesFromArchive,

8281 -- * URI handling

@@ -98,19 +97,17 @@ import Text.Pandoc.Definition

9897import Text.Pandoc.Walk

9998import Text.Pandoc.Builder (Inlines, Blocks, ToMetaValue(..))

10099import qualified Text.Pandoc.Builder as B

101−import qualified Text.Pandoc.UTF8 as UTF8

102100import Data.Char ( toLower, isLower, isUpper, isAlpha,

103101 isLetter, isDigit, isSpace )

104102import Data.List ( find, stripPrefix, intercalate )

105103import Data.Maybe (mapMaybe)

106104import Data.Version ( showVersion )

107105import qualified Data.Map as M

108−import Network.URI ( URI(uriScheme), escapeURIString, unEscapeString, parseURI )

106+import Network.URI ( URI(uriScheme), escapeURIString, parseURI )

109107import qualified Data.Set as Set

110108import System.Directory

111109import System.FilePath (splitDirectories, isPathSeparator)

112110import qualified System.FilePath.Posix as Posix

113−import Text.Pandoc.MIME (MimeType)

114111import Data.Generics (Typeable, Data)

115112import qualified Control.Monad.State.Strict as S

116113import qualified Control.Exception as E

@@ -118,33 +115,16 @@ import Control.Monad (msum, unless, MonadPlus(..))

118115import Text.Pandoc.Pretty (charWidth)

119116import Text.Pandoc.Generic (bottomUp)

120117import Text.Pandoc.Compat.Time

121−import System.IO.Error

122118import System.IO.Temp

123119import Text.HTML.TagSoup (renderTagsOptions, RenderOptions(..), Tag(..),

124120 renderOptions)

125121import Data.Monoid ((<>))

126−import qualified Data.ByteString as BS

127−import qualified Data.ByteString.Char8 as B8

128−import Data.ByteString.Base64 (decodeLenient)

129122import Data.Sequence (ViewR(..), ViewL(..), viewl, viewr)

130123import qualified Data.Text as T

131−import Data.ByteString.Lazy (toChunks)

132124import qualified Data.ByteString.Lazy as BL

133125import Paths_pandoc (version)

134−

135126import Codec.Archive.Zip

136127

137−import Network.HTTP.Client (httpLbs, responseBody, responseHeaders,

138− Request(port,host,requestHeaders),

139− HttpException)

140−import Network.HTTP.Client (parseRequest)

141−import Network.HTTP.Client (newManager)

142−import Network.HTTP.Client.Internal (addProxy)

143−import Network.HTTP.Client.TLS (tlsManagerSettings)

144−import System.Environment (getEnv)

145−import Network.HTTP.Types.Header ( hContentType, hUserAgent)

146−import Network (withSocketsDo)

147−

148128-- | Version number of pandoc library.

149129pandocVersion :: String

150130pandocVersion = showVersion version

@@ -606,36 +586,6 @@ inDirectory path action = E.bracket

606586 setCurrentDirectory

607587 (const $ setCurrentDirectory path >> action)

608588

609−-- | Read from a URL and return raw data and maybe mime type.

610−openURL :: String -> IO (Either HttpException (BS.ByteString, Maybe MimeType))

611−openURL u

612− | Just u'' <- stripPrefix "data:" u =

613− let mime = takeWhile (/=',') u''

614− contents = B8.pack $ unEscapeString $ drop 1 $ dropWhile (/=',') u''

615− in return $ Right (decodeLenient contents, Just mime)

616− | otherwise = E.try $ withSocketsDo $ do

617− let parseReq = parseRequest

618− (proxy :: Either IOError String) <-

619− tryIOError $ getEnv "http_proxy"

620− (useragent :: Either IOError String) <-

621− tryIOError $ getEnv "USER_AGENT"

622− req <- parseReq u

623− req' <- case proxy of

624− Left _ -> return req

625− Right pr -> (parseReq pr >>= \r ->

626− return $ addProxy (host r) (port r) req)

627− `mplus` return req

628− req'' <- case useragent of

629− Left _ -> return req'

630− Right ua -> do

631− let headers = requestHeaders req'

632− let useragentheader = (hUserAgent, B8.pack ua)

633− let headers' = useragentheader:headers

634− return $ req' {requestHeaders = headers'}

635− resp <- newManager tlsManagerSettings >>= httpLbs req''

636− return (BS.concat $ toChunks $ responseBody resp,

637− UTF8.toString `fmap` lookup hContentType (responseHeaders resp))

638−

639589--

640590-- Error reporting

641591--