http-client-0.5.14/Data/ 0000755 0000000 0000000 00000000000 13316025440 013071 5 ustar 00 0000000 0000000 http-client-0.5.14/Network/ 0000755 0000000 0000000 00000000000 12632352123 013652 5 ustar 00 0000000 0000000 http-client-0.5.14/Network/HTTP/ 0000755 0000000 0000000 00000000000 13316025440 014430 5 ustar 00 0000000 0000000 http-client-0.5.14/Network/HTTP/Client/ 0000755 0000000 0000000 00000000000 13374444652 015664 5 ustar 00 0000000 0000000 http-client-0.5.14/publicsuffixlist/ 0000755 0000000 0000000 00000000000 13225761432 015626 5 ustar 00 0000000 0000000 http-client-0.5.14/publicsuffixlist/Network/ 0000755 0000000 0000000 00000000000 12632352123 017251 5 ustar 00 0000000 0000000 http-client-0.5.14/publicsuffixlist/Network/PublicSuffixList/ 0000755 0000000 0000000 00000000000 13025776351 022522 5 ustar 00 0000000 0000000 http-client-0.5.14/test/ 0000755 0000000 0000000 00000000000 12632352123 013200 5 ustar 00 0000000 0000000 http-client-0.5.14/test-nonet/ 0000755 0000000 0000000 00000000000 12632352123 014321 5 ustar 00 0000000 0000000 http-client-0.5.14/test-nonet/Network/ 0000755 0000000 0000000 00000000000 12632352123 015752 5 ustar 00 0000000 0000000 http-client-0.5.14/test-nonet/Network/HTTP/ 0000755 0000000 0000000 00000000000 13247023725 016537 5 ustar 00 0000000 0000000 http-client-0.5.14/test-nonet/Network/HTTP/Client/ 0000755 0000000 0000000 00000000000 13374444652 017764 5 ustar 00 0000000 0000000 http-client-0.5.14/test/Network/ 0000755 0000000 0000000 00000000000 12632352123 014631 5 ustar 00 0000000 0000000 http-client-0.5.14/test/Network/HTTP/ 0000755 0000000 0000000 00000000000 13242327066 015416 5 ustar 00 0000000 0000000 http-client-0.5.14/Network/HTTP/Client.hs 0000644 0000000 0000000 00000031500 13316025440 016201 0 ustar 00 0000000 0000000 {-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE CPP #-}
-- |
--
-- = Simpler API
--
-- The API below is rather low-level. The @Network.HTTP.Simple@ module (from
-- the @http-conduit@ package) provides a higher-level API with built-in
-- support for things like JSON request and response bodies. For most users,
-- this will be an easier place to start. You can read the tutorial at:
--
-- https://haskell-lang.org/library/http-client
--
-- = Lower-level API
--
-- This is the main entry point for using http-client. Used by itself, this
-- module provides low-level access for streaming request and response bodies,
-- and only non-secure HTTP connections. Helper packages such as http-conduit
-- provide higher level streaming approaches, while other helper packages like
-- http-client-tls provide secure connections.
--
-- There are three core components to be understood here: requests, responses,
-- and managers. A 'Manager' keeps track of open connections to various hosts,
-- and when requested, will provide either an existing open connection or
-- create a new connection on demand. A 'Manager' also automatically reaps
-- connections which have been unused for a certain period of time. A 'Manager'
-- allows for more efficient HTTP usage by allowing for keep-alive connections.
-- Secure HTTP connections can be allowed by modifying the settings used for
-- creating a manager. The simplest way to create a 'Manager' is with:
--
-- @
-- 'newManager' 'defaultManagerSettings'
-- @
--
-- While generally speaking it is a good idea to share a single 'Manager'
-- throughout your application, there are cases where it makes more sense to
-- create and destroy 'Manager's more frequently. As an example, if you have an
-- application which will make a large number of requests to different hosts,
-- and will never make more than one connection to a single host, then sharing
-- a 'Manager' will result in idle connections being kept open longer than
-- necessary. In such a situation, it makes sense to use 'withManager' around
-- each new request, to avoid running out of file descriptors. (Note that the
-- 'managerIdleConnectionCount' setting mitigates the risk of leaking too many
-- file descriptors.)
--
-- The next core component is a 'Request', which represents a single HTTP
-- request to be sent to a specific server. 'Request's allow for many settings
-- to control exact how they function, but usually the simplest approach for
-- creating a 'Request' is to use 'parseRequest'.
--
-- Finally, a 'Response' is the result of sending a single 'Request' to a
-- server, over a connection which was acquired from a 'Manager'. Note that you
-- must close the response when you're done with it to ensure that the
-- connection is recycled to the 'Manager' to either be used by another
-- request, or to be reaped. Usage of 'withResponse' will ensure that this
-- happens automatically.
--
-- Helper packages may provide replacements for various recommendations listed
-- above. For example, if using http-client-tls, instead of using
-- 'defaultManagerSettings', you would want to use 'tlsManagerSettings'. Be
-- sure to read the relevant helper library documentation for more information.
--
-- A note on exceptions: for the most part, all actions that perform I/O should
-- be assumed to throw an 'HttpException' in the event of some problem, and all
-- pure functions will be total. For example, 'withResponse', 'httpLbs', and
-- 'BodyReader' can all throw exceptions. Functions like 'responseStatus' and
-- 'applyBasicAuth' are guaranteed to be total (or there's a bug in the
-- library).
--
-- One thing to be cautioned about: the type of 'parseRequest' allows it to work in
-- different monads. If used in the 'IO' monad, it will throw an exception in
-- the case of an invalid URI. In addition, if you leverage the @IsString@
-- instance of the 'Request' value via @OverloadedStrings@, an invalid URI will
-- result in a partial value. Caveat emptor!
module Network.HTTP.Client
( -- $example1
-- * Performing requests
withResponse
, httpLbs
, httpNoBody
, responseOpen
, responseClose
-- ** Tracking redirect history
, withResponseHistory
, responseOpenHistory
, HistoriedResponse
, hrRedirects
, hrFinalRequest
, hrFinalResponse
-- * Connection manager
, Manager
, newManager
, closeManager
, withManager
, HasHttpManager(..)
-- ** Connection manager settings
, ManagerSettings
, defaultManagerSettings
, managerConnCount
, managerRawConnection
, managerTlsConnection
, managerResponseTimeout
, managerRetryableException
, managerWrapException
, managerIdleConnectionCount
, managerModifyRequest
, managerModifyResponse
-- *** Manager proxy settings
, managerSetProxy
, managerSetInsecureProxy
, managerSetSecureProxy
, ProxyOverride
, proxyFromRequest
, noProxy
, useProxy
, proxyEnvironment
, proxyEnvironmentNamed
, defaultProxy
-- *** Response timeouts
, ResponseTimeout
, responseTimeoutMicro
, responseTimeoutNone
, responseTimeoutDefault
-- *** Helpers
, rawConnectionModifySocket
, rawConnectionModifySocketSize
-- * Request
-- $parsing-request
, parseUrl
, parseUrlThrow
, parseRequest
, parseRequest_
, requestFromURI
, requestFromURI_
, defaultRequest
, applyBasicAuth
, urlEncodedBody
, getUri
, setRequestIgnoreStatus
, setRequestCheckStatus
, setQueryString
#if MIN_VERSION_http_types(0,12,1)
, setQueryStringPartialEscape
#endif
-- ** Request type and fields
, Request
, method
, secure
, host
, port
, path
, queryString
, requestHeaders
, requestBody
, proxy
, applyBasicProxyAuth
, decompress
, redirectCount
, checkResponse
, responseTimeout
, cookieJar
, requestVersion
-- ** Request body
, RequestBody (..)
, Popper
, NeedsPopper
, GivesPopper
, streamFile
, observedStreamFile
, StreamFileStatus (..)
-- * Response
, Response
, responseStatus
, responseVersion
, responseHeaders
, responseBody
, responseCookieJar
, throwErrorStatusCodes
-- ** Response body
, BodyReader
, brRead
, brReadSome
, brConsume
-- * Advanced connection creation
, makeConnection
, socketConnection
-- * Misc
, HttpException (..)
, HttpExceptionContent (..)
, Cookie (..)
, CookieJar
, Proxy (..)
, withConnection
-- * Cookies
, module Network.HTTP.Client.Cookies
) where
import Network.HTTP.Client.Body
import Network.HTTP.Client.Connection (makeConnection, socketConnection)
import Network.HTTP.Client.Cookies
import Network.HTTP.Client.Core
import Network.HTTP.Client.Manager
import Network.HTTP.Client.Request
import Network.HTTP.Client.Response
import Network.HTTP.Client.Types
import Data.IORef (newIORef, writeIORef, readIORef, modifyIORef)
import qualified Data.ByteString.Lazy as L
import Data.Foldable (Foldable)
import Data.Traversable (Traversable)
import Network.HTTP.Types (statusCode)
import GHC.Generics (Generic)
import Data.Typeable (Typeable)
import Control.Exception (bracket, handle, throwIO)
-- | A datatype holding information on redirected requests and the final response.
--
-- Since 0.4.1
data HistoriedResponse body = HistoriedResponse
{ hrRedirects :: [(Request, Response L.ByteString)]
-- ^ Requests which resulted in a redirect, together with their responses.
-- The response contains the first 1024 bytes of the body.
--
-- Since 0.4.1
, hrFinalRequest :: Request
-- ^ The final request performed.
--
-- Since 0.4.1
, hrFinalResponse :: Response body
-- ^ The response from the final request.
--
-- Since 0.4.1
}
deriving (Functor, Data.Traversable.Traversable, Data.Foldable.Foldable, Show, Typeable, Generic)
-- | A variant of @responseOpen@ which keeps a history of all redirects
-- performed in the interim, together with the first 1024 bytes of their
-- response bodies.
--
-- Since 0.4.1
responseOpenHistory :: Request -> Manager -> IO (HistoriedResponse BodyReader)
responseOpenHistory reqOrig man0 = handle (throwIO . toHttpException reqOrig) $ do
reqRef <- newIORef reqOrig
historyRef <- newIORef id
let go req0 = do
(man, req) <- getModifiedRequestManager man0 req0
(req', res') <- httpRaw' req man
let res = res'
{ responseBody = handle (throwIO . toHttpException req0)
(responseBody res')
}
case getRedirectedRequest
req'
(responseHeaders res)
(responseCookieJar res)
(statusCode $ responseStatus res) of
Nothing -> return (res, req', False)
Just req'' -> do
writeIORef reqRef req''
body <- brReadSome (responseBody res) 1024
modifyIORef historyRef (. ((req, res { responseBody = body }):))
return (res, req'', True)
(_, res) <- httpRedirect' (redirectCount reqOrig) go reqOrig
reqFinal <- readIORef reqRef
history <- readIORef historyRef
return HistoriedResponse
{ hrRedirects = history []
, hrFinalRequest = reqFinal
, hrFinalResponse = res
}
-- | A variant of @withResponse@ which keeps a history of all redirects
-- performed in the interim, together with the first 1024 bytes of their
-- response bodies.
--
-- Since 0.4.1
withResponseHistory :: Request
-> Manager
-> (HistoriedResponse BodyReader -> IO a)
-> IO a
withResponseHistory req man = bracket
(responseOpenHistory req man)
(responseClose . hrFinalResponse)
-- | Set the proxy override value, only for HTTP (insecure) connections.
--
-- Since 0.4.7
managerSetInsecureProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings
managerSetInsecureProxy po m = m { managerProxyInsecure = po }
-- | Set the proxy override value, only for HTTPS (secure) connections.
--
-- Since 0.4.7
managerSetSecureProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings
managerSetSecureProxy po m = m { managerProxySecure = po }
-- | Set the proxy override value, for both HTTP (insecure) and HTTPS
-- (insecure) connections.
--
-- Since 0.4.7
managerSetProxy :: ProxyOverride -> ManagerSettings -> ManagerSettings
managerSetProxy po = managerSetInsecureProxy po . managerSetSecureProxy po
-- $example1
-- = Example Usage
--
-- === Making a GET request
--
-- > import Network.HTTP.Client
-- > import Network.HTTP.Types.Status (statusCode)
-- >
-- > main :: IO ()
-- > main = do
-- > manager <- newManager defaultManagerSettings
-- >
-- > request <- parseRequest "http://httpbin.org/get"
-- > response <- httpLbs request manager
-- >
-- > putStrLn $ "The status code was: " ++ (show $ statusCode $ responseStatus response)
-- > print $ responseBody response
--
--
-- === Posting JSON to a server
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import Network.HTTP.Client
-- > import Network.HTTP.Types.Status (statusCode)
-- > import Data.Aeson (object, (.=), encode)
-- > import Data.Text (Text)
-- >
-- > main :: IO ()
-- > main = do
-- > manager <- newManager defaultManagerSettings
-- >
-- > -- Create the request
-- > let requestObject = object ["name" .= "Michael", "age" .= 30]
-- > let requestObject = object
-- > [ "name" .= ("Michael" :: Text)
-- > , "age" .= (30 :: Int)
-- > ]
-- >
-- > initialRequest <- parseRequest "http://httpbin.org/post"
-- > let request = initialRequest { method = "POST", requestBody = RequestBodyLBS $ encode requestObject }
-- >
-- > response <- httpLbs request manager
-- > putStrLn $ "The status code was: " ++ (show $ statusCode $ responseStatus response)
-- > print $ responseBody response
--
-- | Specify a response timeout in microseconds
--
-- @since 0.5.0
responseTimeoutMicro :: Int -> ResponseTimeout
responseTimeoutMicro = ResponseTimeoutMicro
-- | Do not have a response timeout
--
-- @since 0.5.0
responseTimeoutNone :: ResponseTimeout
responseTimeoutNone = ResponseTimeoutNone
-- | Use the default response timeout
--
-- When used on a 'Request', means: use the manager's timeout value
--
-- When used on a 'ManagerSettings', means: default to 30 seconds
--
-- @since 0.5.0
responseTimeoutDefault :: ResponseTimeout
responseTimeoutDefault = ResponseTimeoutDefault
-- $parsing-request
--
-- The way you parse string of characters to construct a 'Request' will
-- determine whether exceptions will be thrown on non-2XX response status
-- codes. This is because the behavior is controlled by a setting in
-- 'Request' itself (see 'checkResponse') and different parsing functions
-- set it to different 'IO' actions.
http-client-0.5.14/Network/HTTP/Client/MultipartFormData.hs 0000644 0000000 0000000 00000025210 13262666473 021622 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
-- | This module handles building multipart/form-data. Example usage:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import Network
-- > import Network.HTTP.Client
-- > import Network.HTTP.Client.MultipartFormData
-- >
-- > import Data.Text.Encoding as TE
-- >
-- > import Control.Monad
-- >
-- > main = void $ withManager defaultManagerSettings $ \m -> do
-- > req1 <- parseRequest "http://random-cat-photo.net/cat.jpg"
-- > res <- httpLbs req1 m
-- > req2 <- parseRequest "http://example.org/~friedrich/blog/addPost.hs"
-- > flip httpLbs m =<<
-- > (formDataBody [partBS "title" "Bleaurgh"
-- > ,partBS "text" $ TE.encodeUtf8 "矢田矢田矢田矢田矢田"
-- > ,partFileSource "file1" "/home/friedrich/Photos/MyLittlePony.jpg"
-- > ,partFileRequestBody "file2" "cat.jpg" $ RequestBodyLBS $ responseBody res]
-- > req2)
module Network.HTTP.Client.MultipartFormData
(
-- * Part type
Part
,partName
,partFilename
,partContentType
,partHeaders
,partGetBody
-- * Constructing parts
,partBS
,partLBS
,partFile
,partFileSource
,partFileSourceChunked
,partFileRequestBody
,partFileRequestBodyM
-- * Headers
,addPartHeaders
-- * Building form data
,formDataBody
,formDataBodyWithBoundary
-- * Boundary
,webkitBoundary
,webkitBoundaryPure
-- * Misc
,renderParts
,renderPart
) where
import Network.HTTP.Client hiding (streamFile)
import Network.Mime
import Network.HTTP.Types (hContentType, methodPost, Header())
import Data.Monoid ((<>))
import Data.Foldable (foldMap)
import Blaze.ByteString.Builder
import Data.Text
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString as BS
import qualified Data.CaseInsensitive as CI
import Control.Monad.Trans.State.Strict (state, runState)
import Control.Monad.IO.Class
import System.FilePath
import System.Random
import Data.Array.Base
import System.IO
import Data.Bits
import Data.Word
import Data.Monoid (Monoid(..))
import Control.Monad
import Data.ByteString.Lazy.Internal (defaultChunkSize)
-- | A single part of a multipart message.
data Part = Part
{ partName :: Text -- ^ Name of the corresponding \
, partFilename :: Maybe String -- ^ A file name, if this is an attached file
, partContentType :: Maybe MimeType -- ^ Content type
, partHeaders :: [Header] -- ^ List of additional headers
, partGetBody :: IO RequestBody -- ^ Action in m which returns the body
-- of a message.
}
instance Show Part where
showsPrec d (Part n f c h _) =
showParen (d>=11) $ showString "Part "
. showsPrec 11 n
. showString " "
. showsPrec 11 f
. showString " "
. showsPrec 11 c
. showString " "
. showsPrec 11 h
. showString " "
. showString ""
-- | Make a 'Part' whose content is a strict 'BS.ByteString'.
--
-- The 'Part' does not have a file name or content type associated
-- with it.
partBS :: Text -- ^ Name of the corresponding \.
-> BS.ByteString -- ^ The body for this 'Part'.
-> Part
partBS n b = Part n Data.Monoid.mempty mempty mempty $ return $ RequestBodyBS b
-- | Make a 'Part' whose content is a lazy 'BL.ByteString'.
--
-- The 'Part' does not have a file name or content type associated
-- with it.
partLBS :: Text -- ^ Name of the corresponding \.
-> BL.ByteString -- ^ The body for this 'Part'.
-> Part
partLBS n b = Part n mempty mempty mempty $ return $ RequestBodyLBS b
-- | Make a 'Part' from a file.
--
-- The entire file will reside in memory at once. If you want
-- constant memory usage, use 'partFileSource'.
--
-- The 'FilePath' supplied will be used as the file name of the
-- 'Part'. If you do not want to reveal this name to the server, you
-- must remove it prior to uploading.
--
-- The 'Part' does not have a content type associated with it.
partFile :: Text -- ^ Name of the corresponding \.
-> FilePath -- ^ The name of the local file to upload.
-> Part
partFile n f =
partFileRequestBodyM n f $ do
liftM RequestBodyBS $ liftIO $ BS.readFile f
-- | Stream a 'Part' from a file.
--
-- The 'FilePath' supplied will be used as the file name of the
-- 'Part'. If you do not want to reveal this name to the server, you
-- must remove it prior to uploading.
--
-- The 'Part' does not have a content type associated with it.
partFileSource :: Text -- ^ Name of the corresponding \.
-> FilePath -- ^ The name of the local file to upload.
-> Part
partFileSource n f =
partFileRequestBodyM n f $ do
size <- liftIO $ withBinaryFile f ReadMode hFileSize
return $ RequestBodyStream (fromInteger size) $ streamFile f
streamFile :: FilePath -> GivesPopper ()
streamFile fp np =
withFile fp ReadMode $ np . go
where
go h = BS.hGetSome h defaultChunkSize
-- | 'partFileSourceChunked' will read a file and send it in chunks.
--
-- Note that not all servers support this. Only use 'partFileSourceChunked'
-- if you know the server you're sending to supports chunked request bodies.
--
-- The 'FilePath' supplied will be used as the file name of the
-- 'Part'. If you do not want to reveal this name to the server, you
-- must remove it prior to uploading.
--
-- The 'Part' does not have a content type associated with it.
partFileSourceChunked :: Text -> FilePath -> Part
partFileSourceChunked n f =
partFileRequestBody n f $ do
RequestBodyStreamChunked $ streamFile f
-- | Construct a 'Part' from form name, filepath and a 'RequestBody'
--
-- > partFileRequestBody "who_calls" "caller.json" $ RequestBodyBS "{\"caller\":\"Jason J Jason\"}"
--
-- > -- empty upload form
-- > partFileRequestBody "file" mempty mempty
--
-- The 'Part' does not have a content type associated with it.
partFileRequestBody :: Text -- ^ Name of the corresponding \.
-> FilePath -- ^ File name to supply to the server.
-> RequestBody -- ^ Data to upload.
-> Part
partFileRequestBody n f rqb =
partFileRequestBodyM n f $ return rqb
-- | Construct a 'Part' from action returning the 'RequestBody'
--
-- > partFileRequestBodyM "cat_photo" "haskell-the-cat.jpg" $ do
-- > size <- fromInteger <$> withBinaryFile "haskell-the-cat.jpg" ReadMode hFileSize
-- > return $ RequestBodySource size $ CB.sourceFile "haskell-the-cat.jpg" $= CL.map fromByteString
--
-- The 'Part' does not have a content type associated with it.
partFileRequestBodyM :: Text -- ^ Name of the corresponding \.
-> FilePath -- ^ File name to supply to the server.
-> IO RequestBody -- ^ Action that will supply data to upload.
-> Part
partFileRequestBodyM n f rqb =
Part n (Just f) (Just $ defaultMimeLookup $ pack f) mempty rqb
{-# INLINE cp #-}
cp :: BS.ByteString -> RequestBody
cp bs = RequestBodyBuilder (fromIntegral $ BS.length bs) $ copyByteString bs
-- | Add a list of additional headers to this 'Part'.
addPartHeaders :: Part -> [Header] -> Part
addPartHeaders p hs = p { partHeaders = partHeaders p <> hs }
renderPart :: BS.ByteString -- ^ Boundary between parts.
-> Part -> IO RequestBody
renderPart boundary (Part name mfilename mcontenttype hdrs get) = liftM render get
where render renderBody =
cp "--" <> cp boundary <> cp "\r\n"
<> cp "Content-Disposition: form-data; name=\""
<> RequestBodyBS (TE.encodeUtf8 name)
<> (case mfilename of
Just f -> cp "\"; filename=\""
<> RequestBodyBS (TE.encodeUtf8 $ pack $ takeFileName f)
_ -> mempty)
<> cp "\""
<> (case mcontenttype of
Just ct -> cp "\r\n"
<> cp "Content-Type: "
<> cp ct
_ -> mempty)
<> Data.Foldable.foldMap (\(k, v) ->
cp "\r\n"
<> cp (CI.original k)
<> cp ": "
<> cp v) hdrs
<> cp "\r\n\r\n"
<> renderBody <> cp "\r\n"
-- | Combine the 'Part's to form multipart/form-data body
renderParts :: BS.ByteString -- ^ Boundary between parts.
-> [Part] -> IO RequestBody
renderParts boundary parts = (fin . mconcat) `liftM` mapM (renderPart boundary) parts
where fin = (<> cp "--" <> cp boundary <> cp "--\r\n")
-- | Generate a boundary simillar to those generated by WebKit-based browsers.
webkitBoundary :: IO BS.ByteString
webkitBoundary = getStdRandom webkitBoundaryPure
webkitBoundaryPure :: RandomGen g => g -> (BS.ByteString, g)
webkitBoundaryPure g = (`runState` g) $ do
fmap (BS.append prefix . BS.pack . Prelude.concat) $ replicateM 4 $ do
randomness <- state $ random
return [unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 24 .&. 0x3F
,unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 16 .&. 0x3F
,unsafeAt alphaNumericEncodingMap $ randomness `shiftR` 8 .&. 0x3F
,unsafeAt alphaNumericEncodingMap $ randomness .&. 0x3F]
where
prefix = "----WebKitFormBoundary"
alphaNumericEncodingMap :: UArray Int Word8
alphaNumericEncodingMap = listArray (0, 63)
[0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48,
0x49, 0x4A, 0x4B, 0x4C, 0x4D, 0x4E, 0x4F, 0x50,
0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58,
0x59, 0x5A, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66,
0x67, 0x68, 0x69, 0x6A, 0x6B, 0x6C, 0x6D, 0x6E,
0x6F, 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76,
0x77, 0x78, 0x79, 0x7A, 0x30, 0x31, 0x32, 0x33,
0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x41, 0x42]
-- | Add form data to the 'Request'.
--
-- This sets a new 'requestBody', adds a content-type request header and changes the method to POST.
formDataBody :: MonadIO m => [Part] -> Request -> m Request
formDataBody a b = liftIO $ do
boundary <- webkitBoundary
formDataBodyWithBoundary boundary a b
-- | Add form data with supplied boundary
formDataBodyWithBoundary :: BS.ByteString -> [Part] -> Request -> IO Request
formDataBodyWithBoundary boundary parts req = do
body <- renderParts boundary parts
return $ req
{ method = methodPost
, requestHeaders =
(hContentType, "multipart/form-data; boundary=" <> boundary)
: Prelude.filter (\(x, _) -> x /= hContentType) (requestHeaders req)
, requestBody = body
}
http-client-0.5.14/Network/HTTP/Client/Internal.hs 0000644 0000000 0000000 00000002750 13227377006 017773 0 ustar 00 0000000 0000000 {-# OPTIONS_HADDOCK not-home #-}
-- | Note that this is essentially the \"kitchen sink\" export module,
-- including many functions intended only to be used internally by this
-- package. No API stability is guaranteed for this module. If you see
-- functions here which you believe should be promoted to a stable API, please
-- contact the author.
module Network.HTTP.Client.Internal
( -- * Low-level response body handling
module Network.HTTP.Client.Body
-- * Raw connection handling
, module Network.HTTP.Client.Connection
-- * Cookies
, module Network.HTTP.Client.Cookies
-- * Performing requests
, module Network.HTTP.Client.Core
-- * Parse response headers
, module Network.HTTP.Client.Headers
-- * Request helper functions
, module Network.HTTP.Client.Request
-- * Low-level response body handling
, module Network.HTTP.Client.Response
-- * Manager
, module Network.HTTP.Client.Manager
-- * All types
, module Network.HTTP.Client.Types
-- * Various utilities
, module Network.HTTP.Client.Util
, dummyManaged
) where
import Network.HTTP.Client.Body
import Network.HTTP.Client.Connection
import Network.HTTP.Client.Cookies
import Network.HTTP.Client.Core
import Network.HTTP.Client.Headers
import Network.HTTP.Client.Manager
import Network.HTTP.Client.Request
import Network.HTTP.Client.Response
import Network.HTTP.Client.Types
import Network.HTTP.Client.Util
import Data.KeyedPool (dummyManaged)
http-client-0.5.14/Network/HTTP/Client/Body.hs 0000644 0000000 0000000 00000015040 13025776404 017111 0 ustar 00 0000000 0000000 {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.Body
( makeChunkedReader
, makeLengthReader
, makeGzipReader
, makeUnlimitedReader
, brConsume
, brEmpty
, constBodyReader
, brAddCleanup
, brReadSome
, brRead
) where
import Network.HTTP.Client.Connection
import Network.HTTP.Client.Types
import Control.Exception (assert)
import Data.ByteString (empty, uncons)
import Data.IORef
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Control.Monad (unless, when)
import qualified Data.Streaming.Zlib as Z
-- ^ Get a single chunk of data from the response body, or an empty
-- bytestring if no more data is available.
--
-- Note that in order to consume the entire request body, you will need to
-- repeatedly call this function until you receive an empty @ByteString@ as a
-- result.
--
-- Since 0.1.0
brRead :: BodyReader -> IO S.ByteString
brRead = id
-- | Continuously call 'brRead', building up a lazy ByteString until a chunk is
-- constructed that is at least as many bytes as requested.
--
-- Since 0.4.20
brReadSome :: BodyReader -> Int -> IO L.ByteString
brReadSome brRead' =
loop id
where
loop front rem'
| rem' <= 0 = return $ L.fromChunks $ front []
| otherwise = do
bs <- brRead'
if S.null bs
then return $ L.fromChunks $ front []
else loop (front . (bs:)) (rem' - S.length bs)
brEmpty :: BodyReader
brEmpty = return S.empty
constBodyReader :: [S.ByteString] -> IO BodyReader
constBodyReader input = do
iinput <- newIORef input
return $ atomicModifyIORef iinput $ \input' ->
case input' of
[] -> ([], S.empty)
x:xs -> (xs, x)
brAddCleanup :: IO () -> BodyReader -> BodyReader
brAddCleanup cleanup brRead' = do
bs <- brRead'
when (S.null bs) cleanup
return bs
-- | Strictly consume all remaining chunks of data from the stream.
--
-- Since 0.1.0
brConsume :: BodyReader -> IO [S.ByteString]
brConsume brRead' =
go id
where
go front = do
x <- brRead'
if S.null x
then return $ front []
else go (front . (x:))
makeGzipReader :: BodyReader -> IO BodyReader
makeGzipReader brRead' = do
inf <- Z.initInflate $ Z.WindowBits 31
istate <- newIORef Nothing
let goPopper popper = do
res <- popper
case res of
Z.PRNext bs -> do
writeIORef istate $ Just popper
return bs
Z.PRDone -> do
bs <- Z.flushInflate inf
if S.null bs
then start
else do
writeIORef istate Nothing
return bs
Z.PRError e -> throwHttp $ HttpZlibException e
start = do
bs <- brRead'
if S.null bs
then return S.empty
else do
popper <- Z.feedInflate inf bs
goPopper popper
return $ do
state <- readIORef istate
case state of
Nothing -> start
Just popper -> goPopper popper
makeUnlimitedReader :: Connection -> IO BodyReader
makeUnlimitedReader Connection {..} = do
icomplete <- newIORef False
return $ do
bs <- connectionRead
when (S.null bs) $ writeIORef icomplete True
return bs
makeLengthReader :: Int -> Connection -> IO BodyReader
makeLengthReader count0 Connection {..} = do
icount <- newIORef count0
return $ do
count <- readIORef icount
if count <= 0
then return empty
else do
bs <- connectionRead
when (S.null bs) $ throwHttp $ ResponseBodyTooShort (fromIntegral count0) (fromIntegral $ count0 - count)
case compare count $ S.length bs of
LT -> do
let (x, y) = S.splitAt count bs
connectionUnread y
writeIORef icount (-1)
return x
EQ -> do
writeIORef icount (-1)
return bs
GT -> do
writeIORef icount (count - S.length bs)
return bs
makeChunkedReader :: Bool -- ^ raw
-> Connection
-> IO BodyReader
makeChunkedReader raw conn@Connection {..} = do
icount <- newIORef 0
return $ go icount
where
go icount = do
count0 <- readIORef icount
(rawCount, count) <-
if count0 == 0
then readHeader
else return (empty, count0)
if count <= 0
then do
writeIORef icount (-1)
return $ if count /= (-1) && raw then rawCount else empty
else do
(bs, count') <- readChunk count
writeIORef icount count'
return $ appendHeader rawCount bs
appendHeader
| raw = S.append
| otherwise = flip const
readChunk 0 = return (empty, 0)
readChunk remainder = do
bs <- connectionRead
when (S.null bs) $ throwHttp InvalidChunkHeaders
case compare remainder $ S.length bs of
LT -> do
let (x, y) = S.splitAt remainder bs
assert (not $ S.null y) $ connectionUnread y
requireNewline
done x
EQ -> do
requireNewline
done bs
GT -> return (bs, remainder - S.length bs)
where
done x
| raw = return (x `S.append` "\r\n", 0)
| otherwise = return (x, 0)
requireNewline = do
bs <- connectionReadLine conn
unless (S.null bs) $ throwHttp InvalidChunkHeaders
readHeader = do
bs <- connectionReadLine conn
case parseHex bs of
Nothing -> throwHttp InvalidChunkHeaders
Just hex -> return (bs `S.append` "\r\n", hex)
parseHex bs0 =
case uncons bs0 of
Just (w0, bs')
| Just i0 <- toI w0 -> Just $ parseHex' i0 bs'
_ -> Nothing
parseHex' i bs =
case uncons bs of
Just (w, bs')
| Just i' <- toI w -> parseHex' (i * 16 + i') bs'
_ -> i
toI w
| 48 <= w && w <= 57 = Just $ fromIntegral w - 48
| 65 <= w && w <= 70 = Just $ fromIntegral w - 55
| 97 <= w && w <= 102 = Just $ fromIntegral w - 87
| otherwise = Nothing
http-client-0.5.14/Network/HTTP/Client/Connection.hs 0000644 0000000 0000000 00000014216 13101575463 020314 0 ustar 00 0000000 0000000 {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Network.HTTP.Client.Connection
( connectionReadLine
, connectionReadLineWith
, connectionDropTillBlankLine
, dummyConnection
, openSocketConnection
, openSocketConnectionSize
, makeConnection
, socketConnection
) where
import Data.ByteString (ByteString, empty)
import Data.IORef
import Control.Monad
import Network.HTTP.Client.Types
import Network.Socket (Socket, HostAddress)
import qualified Network.Socket as NS
import Network.Socket.ByteString (sendAll, recv)
import qualified Control.Exception as E
import qualified Data.ByteString as S
import Data.Word (Word8)
import Data.Function (fix)
connectionReadLine :: Connection -> IO ByteString
connectionReadLine conn = do
bs <- connectionRead conn
when (S.null bs) $ throwHttp IncompleteHeaders
connectionReadLineWith conn bs
-- | Keep dropping input until a blank line is found.
connectionDropTillBlankLine :: Connection -> IO ()
connectionDropTillBlankLine conn = fix $ \loop -> do
bs <- connectionReadLine conn
unless (S.null bs) loop
connectionReadLineWith :: Connection -> ByteString -> IO ByteString
connectionReadLineWith conn bs0 =
go bs0 id 0
where
go bs front total =
case S.break (== charLF) bs of
(_, "") -> do
let total' = total + S.length bs
when (total' > 4096) $ throwHttp OverlongHeaders
bs' <- connectionRead conn
when (S.null bs') $ throwHttp IncompleteHeaders
go bs' (front . (bs:)) total'
(x, S.drop 1 -> y) -> do
unless (S.null y) $! connectionUnread conn y
return $! killCR $! S.concat $! front [x]
charLF, charCR :: Word8
charLF = 10
charCR = 13
killCR :: ByteString -> ByteString
killCR bs
| S.null bs = bs
| S.last bs == charCR = S.init bs
| otherwise = bs
-- | For testing
dummyConnection :: [ByteString] -- ^ input
-> IO (Connection, IO [ByteString], IO [ByteString]) -- ^ conn, output, input
dummyConnection input0 = do
iinput <- newIORef input0
ioutput <- newIORef []
return (Connection
{ connectionRead = atomicModifyIORef iinput $ \input ->
case input of
[] -> ([], empty)
x:xs -> (xs, x)
, connectionUnread = \x -> atomicModifyIORef iinput $ \input -> (x:input, ())
, connectionWrite = \x -> atomicModifyIORef ioutput $ \output -> (output ++ [x], ())
, connectionClose = return ()
}, atomicModifyIORef ioutput $ \output -> ([], output), readIORef iinput)
-- | Create a new 'Connection' from a read, write, and close function.
--
-- @since 0.5.3
makeConnection :: IO ByteString -- ^ read
-> (ByteString -> IO ()) -- ^ write
-> IO () -- ^ close
-> IO Connection
makeConnection r w c = do
istack <- newIORef []
-- it is necessary to make sure we never read from or write to
-- already closed connection.
closedVar <- newIORef False
let close = do
closed <- atomicModifyIORef closedVar (\closed -> (True, closed))
unless closed $
c
_ <- mkWeakIORef istack close
return $! Connection
{ connectionRead = do
closed <- readIORef closedVar
when closed $ throwHttp ConnectionClosed
join $ atomicModifyIORef istack $ \stack ->
case stack of
x:xs -> (xs, return x)
[] -> ([], r)
, connectionUnread = \x -> do
closed <- readIORef closedVar
when closed $ throwHttp ConnectionClosed
atomicModifyIORef istack $ \stack -> (x:stack, ())
, connectionWrite = \x -> do
closed <- readIORef closedVar
when closed $ throwHttp ConnectionClosed
w x
, connectionClose = close
}
-- | Create a new 'Connection' from a 'Socket'.
--
-- @since 0.5.3
socketConnection :: Socket
-> Int -- ^ chunk size
-> IO Connection
socketConnection socket chunksize = makeConnection
(recv socket chunksize)
(sendAll socket)
(NS.close socket)
openSocketConnection :: (Socket -> IO ())
-> Maybe HostAddress
-> String -- ^ host
-> Int -- ^ port
-> IO Connection
openSocketConnection f = openSocketConnectionSize f 8192
openSocketConnectionSize :: (Socket -> IO ())
-> Int -- ^ chunk size
-> Maybe HostAddress
-> String -- ^ host
-> Int -- ^ port
-> IO Connection
openSocketConnectionSize tweakSocket chunksize hostAddress' host' port' = do
let hints = NS.defaultHints {
NS.addrFlags = [NS.AI_ADDRCONFIG]
, NS.addrSocketType = NS.Stream
}
addrs <- case hostAddress' of
Nothing ->
NS.getAddrInfo (Just hints) (Just host') (Just $ show port')
Just ha ->
return
[NS.AddrInfo
{ NS.addrFlags = []
, NS.addrFamily = NS.AF_INET
, NS.addrSocketType = NS.Stream
, NS.addrProtocol = 6 -- tcp
, NS.addrAddress = NS.SockAddrInet (toEnum port') ha
, NS.addrCanonName = Nothing
}]
firstSuccessful addrs $ \addr ->
E.bracketOnError
(NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)
(NS.addrProtocol addr))
NS.close
(\sock -> do
NS.setSocketOption sock NS.NoDelay 1
tweakSocket sock
NS.connect sock (NS.addrAddress addr)
socketConnection sock chunksize)
firstSuccessful :: [NS.AddrInfo] -> (NS.AddrInfo -> IO a) -> IO a
firstSuccessful [] _ = error "getAddrInfo returned empty list"
firstSuccessful (a:as) cb =
cb a `E.catch` \(e :: E.IOException) ->
case as of
[] -> E.throwIO e
_ -> firstSuccessful as cb
http-client-0.5.14/Network/HTTP/Client/Cookies.hs 0000644 0000000 0000000 00000032772 13316025440 017611 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
-- | This module implements the algorithms described in RFC 6265 for the Network.HTTP.Conduit library.
module Network.HTTP.Client.Cookies
( updateCookieJar
, receiveSetCookie
, generateCookie
, insertCheckedCookie
, insertCookiesIntoRequest
, computeCookieString
, evictExpiredCookies
, createCookieJar
, destroyCookieJar
, pathMatches
, removeExistingCookieFromCookieJar
, domainMatches
, isIpAddress
, defaultPath
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as S8
import Data.Maybe
import qualified Data.List as L
import Data.Time.Clock
import Data.Time.Calendar
import Web.Cookie
import qualified Data.CaseInsensitive as CI
import Blaze.ByteString.Builder
import qualified Network.PublicSuffixList.Lookup as PSL
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Network.HTTP.Client.Types as Req
slash :: Integral a => a
slash = 47 -- '/'
isIpAddress :: BS.ByteString -> Bool
isIpAddress =
go (4 :: Int)
where
go 0 bs = BS.null bs
go rest bs =
case S8.readInt x of
Just (i, x') | BS.null x' && i >= 0 && i < 256 -> go (rest - 1) y
_ -> False
where
(x, y') = BS.break (== 46) bs -- period
y = BS.drop 1 y'
-- | This corresponds to the subcomponent algorithm entitled \"Domain Matching\" detailed
-- in section 5.1.3
domainMatches :: BS.ByteString -- ^ Domain to test
-> BS.ByteString -- ^ Domain from a cookie
-> Bool
domainMatches string' domainString'
| string == domainString = True
| BS.length string < BS.length domainString + 1 = False
| domainString `BS.isSuffixOf` string && BS.singleton (BS.last difference) == "." && not (isIpAddress string) = True
| otherwise = False
where difference = BS.take (BS.length string - BS.length domainString) string
string = CI.foldCase string'
domainString = CI.foldCase domainString'
-- | This corresponds to the subcomponent algorithm entitled \"Paths\" detailed
-- in section 5.1.4
defaultPath :: Req.Request -> BS.ByteString
defaultPath req
| BS.null uri_path = "/"
| BS.singleton (BS.head uri_path) /= "/" = "/"
| BS.count slash uri_path <= 1 = "/"
| otherwise = BS.reverse $ BS.tail $ BS.dropWhile (/= slash) $ BS.reverse uri_path
where uri_path = Req.path req
-- | This corresponds to the subcomponent algorithm entitled \"Path-Match\" detailed
-- in section 5.1.4
pathMatches :: BS.ByteString -> BS.ByteString -> Bool
pathMatches requestPath cookiePath
| cookiePath == path' = True
| cookiePath `BS.isPrefixOf` path' && BS.singleton (BS.last cookiePath) == "/" = True
| cookiePath `BS.isPrefixOf` path' && BS.singleton (BS.head remainder) == "/" = True
| otherwise = False
where remainder = BS.drop (BS.length cookiePath) requestPath
path' = case S8.uncons requestPath of
Just ('/', _) -> requestPath
_ -> '/' `S8.cons` requestPath
createCookieJar :: [Cookie] -> CookieJar
createCookieJar = CJ
destroyCookieJar :: CookieJar -> [Cookie]
destroyCookieJar = expose
insertIntoCookieJar :: Cookie -> CookieJar -> CookieJar
insertIntoCookieJar cookie cookie_jar' = CJ $ cookie : cookie_jar
where cookie_jar = expose cookie_jar'
removeExistingCookieFromCookieJar :: Cookie -> CookieJar -> (Maybe Cookie, CookieJar)
removeExistingCookieFromCookieJar cookie cookie_jar' = (mc, CJ lc)
where (mc, lc) = removeExistingCookieFromCookieJarHelper cookie (expose cookie_jar')
removeExistingCookieFromCookieJarHelper _ [] = (Nothing, [])
removeExistingCookieFromCookieJarHelper c (c' : cs)
| c == c' = (Just c', cs)
| otherwise = (cookie', c' : cookie_jar'')
where (cookie', cookie_jar'') = removeExistingCookieFromCookieJarHelper c cs
-- | Are we configured to reject cookies for domains such as \"com\"?
rejectPublicSuffixes :: Bool
rejectPublicSuffixes = True
isPublicSuffix :: BS.ByteString -> Bool
isPublicSuffix = PSL.isSuffix . decodeUtf8With lenientDecode
-- | This corresponds to the eviction algorithm described in Section 5.3 \"Storage Model\"
evictExpiredCookies :: CookieJar -- ^ Input cookie jar
-> UTCTime -- ^ Value that should be used as \"now\"
-> CookieJar -- ^ Filtered cookie jar
evictExpiredCookies cookie_jar' now = CJ $ filter (\ cookie -> cookie_expiry_time cookie >= now) $ expose cookie_jar'
-- | This applies the 'computeCookieString' to a given Request
insertCookiesIntoRequest :: Req.Request -- ^ The request to insert into
-> CookieJar -- ^ Current cookie jar
-> UTCTime -- ^ Value that should be used as \"now\"
-> (Req.Request, CookieJar) -- ^ (Output request, Updated cookie jar (last-access-time is updated))
insertCookiesIntoRequest request cookie_jar now
| BS.null cookie_string = (request, cookie_jar')
| otherwise = (request {Req.requestHeaders = cookie_header : purgedHeaders}, cookie_jar')
where purgedHeaders = L.deleteBy (\ (a, _) (b, _) -> a == b) (CI.mk $ "Cookie", BS.empty) $ Req.requestHeaders request
(cookie_string, cookie_jar') = computeCookieString request cookie_jar now True
cookie_header = (CI.mk $ "Cookie", cookie_string)
-- | This corresponds to the algorithm described in Section 5.4 \"The Cookie Header\"
computeCookieString :: Req.Request -- ^ Input request
-> CookieJar -- ^ Current cookie jar
-> UTCTime -- ^ Value that should be used as \"now\"
-> Bool -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that)
-> (BS.ByteString, CookieJar) -- ^ (Contents of a \"Cookie\" header, Updated cookie jar (last-access-time is updated))
computeCookieString request cookie_jar now is_http_api = (output_line, cookie_jar')
where matching_cookie cookie = condition1 && condition2 && condition3 && condition4
where condition1
| cookie_host_only cookie = CI.foldCase (Req.host request) == CI.foldCase (cookie_domain cookie)
| otherwise = domainMatches (Req.host request) (cookie_domain cookie)
condition2 = pathMatches (Req.path request) (cookie_path cookie)
condition3
| not (cookie_secure_only cookie) = True
| otherwise = Req.secure request
condition4
| not (cookie_http_only cookie) = True
| otherwise = is_http_api
matching_cookies = filter matching_cookie $ expose cookie_jar
output_cookies = map (\ c -> (cookie_name c, cookie_value c)) $ L.sort matching_cookies
output_line = toByteString $ renderCookies $ output_cookies
folding_function cookie_jar'' cookie = case removeExistingCookieFromCookieJar cookie cookie_jar'' of
(Just c, cookie_jar''') -> insertIntoCookieJar (c {cookie_last_access_time = now}) cookie_jar'''
(Nothing, cookie_jar''') -> cookie_jar'''
cookie_jar' = foldl folding_function cookie_jar matching_cookies
-- | This applies 'receiveSetCookie' to a given Response
updateCookieJar :: Response a -- ^ Response received from server
-> Request -- ^ Request which generated the response
-> UTCTime -- ^ Value that should be used as \"now\"
-> CookieJar -- ^ Current cookie jar
-> (CookieJar, Response a) -- ^ (Updated cookie jar with cookies from the Response, The response stripped of any \"Set-Cookie\" header)
updateCookieJar response request now cookie_jar = (cookie_jar', response { responseHeaders = other_headers })
where (set_cookie_headers, other_headers) = L.partition ((== (CI.mk $ "Set-Cookie")) . fst) $ responseHeaders response
set_cookie_data = map snd set_cookie_headers
set_cookies = map parseSetCookie set_cookie_data
cookie_jar' = foldl (\ cj sc -> receiveSetCookie sc request now True cj) cookie_jar set_cookies
-- | This corresponds to the algorithm described in Section 5.3 \"Storage Model\"
-- This function consists of calling 'generateCookie' followed by 'insertCheckedCookie'.
-- Use this function if you plan to do both in a row.
-- 'generateCookie' and 'insertCheckedCookie' are only provided for more fine-grained control.
receiveSetCookie :: SetCookie -- ^ The 'SetCookie' the cookie jar is receiving
-> Req.Request -- ^ The request that originated the response that yielded the 'SetCookie'
-> UTCTime -- ^ Value that should be used as \"now\"
-> Bool -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that)
-> CookieJar -- ^ Input cookie jar to modify
-> CookieJar -- ^ Updated cookie jar
receiveSetCookie set_cookie request now is_http_api cookie_jar = case (do
cookie <- generateCookie set_cookie request now is_http_api
return $ insertCheckedCookie cookie cookie_jar is_http_api) of
Just cj -> cj
Nothing -> cookie_jar
-- | Insert a cookie created by generateCookie into the cookie jar (or not if it shouldn't be allowed in)
insertCheckedCookie :: Cookie -- ^ The 'SetCookie' the cookie jar is receiving
-> CookieJar -- ^ Input cookie jar to modify
-> Bool -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that)
-> CookieJar -- ^ Updated (or not) cookie jar
insertCheckedCookie c cookie_jar is_http_api = case (do
(cookie_jar', cookie') <- existanceTest c cookie_jar
return $ insertIntoCookieJar cookie' cookie_jar') of
Just cj -> cj
Nothing -> cookie_jar
where existanceTest cookie cookie_jar' = existanceTestHelper cookie $ removeExistingCookieFromCookieJar cookie cookie_jar'
existanceTestHelper new_cookie (Just old_cookie, cookie_jar')
| not is_http_api && cookie_http_only old_cookie = Nothing
| otherwise = return (cookie_jar', new_cookie {cookie_creation_time = cookie_creation_time old_cookie})
existanceTestHelper new_cookie (Nothing, cookie_jar') = return (cookie_jar', new_cookie)
-- | Turn a SetCookie into a Cookie, if it is valid
generateCookie :: SetCookie -- ^ The 'SetCookie' we are encountering
-> Req.Request -- ^ The request that originated the response that yielded the 'SetCookie'
-> UTCTime -- ^ Value that should be used as \"now\"
-> Bool -- ^ Whether or not this request is coming from an \"http\" source (not javascript or anything like that)
-> Maybe Cookie -- ^ The optional output cookie
generateCookie set_cookie request now is_http_api = do
domain_sanitized <- sanitizeDomain $ step4 (setCookieDomain set_cookie)
domain_intermediate <- step5 domain_sanitized
(domain_final, host_only') <- step6 domain_intermediate
http_only' <- step10
return $ Cookie { cookie_name = setCookieName set_cookie
, cookie_value = setCookieValue set_cookie
, cookie_expiry_time = getExpiryTime (setCookieExpires set_cookie) (setCookieMaxAge set_cookie)
, cookie_domain = domain_final
, cookie_path = getPath $ setCookiePath set_cookie
, cookie_creation_time = now
, cookie_last_access_time = now
, cookie_persistent = getPersistent
, cookie_host_only = host_only'
, cookie_secure_only = setCookieSecure set_cookie
, cookie_http_only = http_only'
}
where sanitizeDomain domain'
| has_a_character && BS.singleton (BS.last domain') == "." = Nothing
| has_a_character && BS.singleton (BS.head domain') == "." = Just $ BS.tail domain'
| otherwise = Just $ domain'
where has_a_character = not (BS.null domain')
step4 (Just set_cookie_domain) = set_cookie_domain
step4 Nothing = BS.empty
step5 domain'
| firstCondition && domain' == (Req.host request) = return BS.empty
| firstCondition = Nothing
| otherwise = return domain'
where firstCondition = rejectPublicSuffixes && has_a_character && isPublicSuffix domain'
has_a_character = not (BS.null domain')
step6 domain'
| firstCondition && not (domainMatches (Req.host request) domain') = Nothing
| firstCondition = return (domain', False)
| otherwise = return (Req.host request, True)
where firstCondition = not $ BS.null domain'
step10
| not is_http_api && setCookieHttpOnly set_cookie = Nothing
| otherwise = return $ setCookieHttpOnly set_cookie
getExpiryTime :: Maybe UTCTime -> Maybe DiffTime -> UTCTime
getExpiryTime _ (Just t) = (fromRational $ toRational t) `addUTCTime` now
getExpiryTime (Just t) Nothing = t
getExpiryTime Nothing Nothing = UTCTime (365000 `addDays` utctDay now) (secondsToDiffTime 0)
getPath (Just p) = p
getPath Nothing = defaultPath request
getPersistent = isJust (setCookieExpires set_cookie) || isJust (setCookieMaxAge set_cookie)
http-client-0.5.14/Network/HTTP/Client/Core.hs 0000644 0000000 0000000 00000027127 13374444652 017121 0 ustar 00 0000000 0000000 {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.Core
( withResponse
, httpLbs
, httpNoBody
, httpRaw
, httpRaw'
, getModifiedRequestManager
, responseOpen
, responseClose
, httpRedirect
, httpRedirect'
, withConnection
) where
import Network.HTTP.Types
import Network.HTTP.Client.Manager
import Network.HTTP.Client.Types
import Network.HTTP.Client.Headers
import Network.HTTP.Client.Body
import Network.HTTP.Client.Request
import Network.HTTP.Client.Response
import Network.HTTP.Client.Cookies
import Data.Maybe (fromMaybe, isJust)
import Data.Time
import Control.Exception
import qualified Data.ByteString.Lazy as L
import Data.Monoid
import Control.Monad (void)
import System.Timeout (timeout)
import Data.KeyedPool
-- | Perform a @Request@ using a connection acquired from the given @Manager@,
-- and then provide the @Response@ to the given function. This function is
-- fully exception safe, guaranteeing that the response will be closed when the
-- inner function exits. It is defined as:
--
-- > withResponse req man f = bracket (responseOpen req man) responseClose f
--
-- It is recommended that you use this function in place of explicit calls to
-- 'responseOpen' and 'responseClose'.
--
-- You will need to use functions such as 'brRead' to consume the response
-- body.
--
-- Since 0.1.0
withResponse :: Request
-> Manager
-> (Response BodyReader -> IO a)
-> IO a
withResponse req man f = bracket (responseOpen req man) responseClose f
-- | A convenience wrapper around 'withResponse' which reads in the entire
-- response body and immediately closes the connection. Note that this function
-- performs fully strict I\/O, and only uses a lazy ByteString in its response
-- for memory efficiency. If you are anticipating a large response body, you
-- are encouraged to use 'withResponse' and 'brRead' instead.
--
-- Since 0.1.0
httpLbs :: Request -> Manager -> IO (Response L.ByteString)
httpLbs req man = withResponse req man $ \res -> do
bss <- brConsume $ responseBody res
return res { responseBody = L.fromChunks bss }
-- | A convenient wrapper around 'withResponse' which ignores the response
-- body. This is useful, for example, when performing a HEAD request.
--
-- Since 0.3.2
httpNoBody :: Request -> Manager -> IO (Response ())
httpNoBody req man = withResponse req man $ return . void
-- | Get a 'Response' without any redirect following.
httpRaw
:: Request
-> Manager
-> IO (Response BodyReader)
httpRaw = fmap (fmap snd) . httpRaw'
-- | Get a 'Response' without any redirect following.
--
-- This extended version of 'httpRaw' also returns the potentially modified Request.
httpRaw'
:: Request
-> Manager
-> IO (Request, Response BodyReader)
httpRaw' req0 m = do
let req' = mSetProxy m req0
(req, cookie_jar') <- case cookieJar req' of
Just cj -> do
now <- getCurrentTime
return $ insertCookiesIntoRequest req' (evictExpiredCookies cj now) now
Nothing -> return (req', Data.Monoid.mempty)
(timeout', mconn) <- getConnectionWrapper
(responseTimeout' req)
(getConn req m)
-- Originally, we would only test for exceptions when sending the request,
-- not on calling @getResponse@. However, some servers seem to close
-- connections after accepting the request headers, so we need to check for
-- exceptions in both.
ex <- try $ do
cont <- requestBuilder (dropProxyAuthSecure req) (managedResource mconn)
getResponse timeout' req mconn cont
case ex of
-- Connection was reused, and might have been closed. Try again
Left e | managedReused mconn && mRetryableException m e -> do
managedRelease mconn DontReuse
httpRaw' req m
-- Not reused, or a non-retry, so this is a real exception
Left e -> throwIO e
-- Everything went ok, so the connection is good. If any exceptions get
-- thrown in the response body, just throw them as normal.
Right res -> case cookieJar req' of
Just _ -> do
now' <- getCurrentTime
let (cookie_jar, _) = updateCookieJar res req now' cookie_jar'
return (req, res {responseCookieJar = cookie_jar})
Nothing -> return (req, res)
where
getConnectionWrapper mtimeout f =
case mtimeout of
Nothing -> fmap ((,) Nothing) f
Just timeout' -> do
before <- getCurrentTime
mres <- timeout timeout' f
case mres of
Nothing -> throwHttp ConnectionTimeout
Just res -> do
now <- getCurrentTime
let timeSpentMicro = diffUTCTime now before * 1000000
remainingTime = round $ fromIntegral timeout' - timeSpentMicro
if remainingTime <= 0
then throwHttp ConnectionTimeout
else return (Just remainingTime, res)
responseTimeout' req =
case responseTimeout req of
ResponseTimeoutDefault ->
case mResponseTimeout m of
ResponseTimeoutDefault -> Just 30000000
ResponseTimeoutNone -> Nothing
ResponseTimeoutMicro u -> Just u
ResponseTimeoutNone -> Nothing
ResponseTimeoutMicro u -> Just u
-- | The used Manager can be overridden (by requestManagerOverride) and the used
-- Request can be modified (through managerModifyRequest). This function allows
-- to retrieve the possibly overridden Manager and the possibly modified
-- Request.
--
-- (In case the Manager is overridden by requestManagerOverride, the Request is
-- being modified by managerModifyRequest of the new Manager, not the old one.)
getModifiedRequestManager :: Manager -> Request -> IO (Manager, Request)
getModifiedRequestManager manager0 req0 = do
let manager = fromMaybe manager0 (requestManagerOverride req0)
req <- mModifyRequest manager req0
return (manager, req)
-- | The most low-level function for initiating an HTTP request.
--
-- The first argument to this function gives a full specification
-- on the request: the host to connect to, whether to use SSL,
-- headers, etc. Please see 'Request' for full details. The
-- second argument specifies which 'Manager' should be used.
--
-- This function then returns a 'Response' with a
-- 'BodyReader'. The 'Response' contains the status code
-- and headers that were sent back to us, and the
-- 'BodyReader' contains the body of the request. Note
-- that this 'BodyReader' allows you to have fully
-- interleaved IO actions during your HTTP download, making it
-- possible to download very large responses in constant memory.
--
-- An important note: the response body returned by this function represents a
-- live HTTP connection. As such, if you do not use the response body, an open
-- socket will be retained indefinitely. You must be certain to call
-- 'responseClose' on this response to free up resources.
--
-- This function automatically performs any necessary redirects, as specified
-- by the 'redirectCount' setting.
--
-- When implementing a (reverse) proxy using this function or relating
-- functions, it's wise to remove Transfer-Encoding:, Content-Length:,
-- Content-Encoding: and Accept-Encoding: from request and response
-- headers to be relayed.
--
-- Since 0.1.0
responseOpen :: Request -> Manager -> IO (Response BodyReader)
responseOpen inputReq manager' = do
case validateHeaders (requestHeaders inputReq) of
GoodHeaders -> return ()
BadHeaders reason -> throwHttp $ InvalidRequestHeader reason
(manager, req0) <- getModifiedRequestManager manager' inputReq
wrapExc req0 $ mWrapException manager req0 $ do
(req, res) <- go manager (redirectCount req0) req0
checkResponse req req res
mModifyResponse manager res
{ responseBody = wrapExc req0 (responseBody res)
}
where
wrapExc :: Request -> IO a -> IO a
wrapExc req0 = handle $ throwIO . toHttpException req0
go manager0 count req' = httpRedirect'
count
(\req -> do
(manager, modReq) <- getModifiedRequestManager manager0 req
(req'', res) <- httpRaw' modReq manager
let mreq = if redirectCount modReq == 0
then Nothing
else getRedirectedRequest req'' (responseHeaders res) (responseCookieJar res) (statusCode (responseStatus res))
return (res, fromMaybe req'' mreq, isJust mreq))
req'
-- | Redirect loop.
httpRedirect
:: Int -- ^ 'redirectCount'
-> (Request -> IO (Response BodyReader, Maybe Request)) -- ^ function which performs a request and returns a response, and possibly another request if there's a redirect.
-> Request
-> IO (Response BodyReader)
httpRedirect count0 http0 req0 = fmap snd $ httpRedirect' count0 http' req0
where
-- adapt callback API
http' req' = do
(res, mbReq) <- http0 req'
return (res, fromMaybe req0 mbReq, isJust mbReq)
-- | Redirect loop.
--
-- This extended version of 'httpRaw' also returns the Request potentially modified by @managerModifyRequest@.
httpRedirect'
:: Int -- ^ 'redirectCount'
-> (Request -> IO (Response BodyReader, Request, Bool)) -- ^ function which performs a request and returns a response, the potentially modified request, and a Bool indicating if there was a redirect.
-> Request
-> IO (Request, Response BodyReader)
httpRedirect' count0 http' req0 = go count0 req0 []
where
go count _ ress | count < 0 = throwHttp $ TooManyRedirects ress
go count req' ress = do
(res, req, isRedirect) <- http' req'
if isRedirect then do
-- Allow the original connection to return to the
-- connection pool immediately by flushing the body.
-- If the response body is too large, don't flush, but
-- instead just close the connection.
let maxFlush = 1024
lbs <- brReadSome (responseBody res) maxFlush
-- The connection may already be closed, e.g.
-- when using withResponseHistory. See
-- https://github.com/snoyberg/http-client/issues/169
`Control.Exception.catch` \se ->
case () of
()
| Just ConnectionClosed <-
fmap unHttpExceptionContentWrapper
(fromException se) -> return L.empty
| Just (HttpExceptionRequest _ ConnectionClosed) <-
fromException se -> return L.empty
_ -> throwIO se
responseClose res
-- And now perform the actual redirect
go (count - 1) req (res { responseBody = lbs }:ress)
else
return (req, res)
-- | Close any open resources associated with the given @Response@. In general,
-- this will either close an active @Connection@ or return it to the @Manager@
-- to be reused.
--
-- Since 0.1.0
responseClose :: Response a -> IO ()
responseClose = runResponseClose . responseClose'
-- | Perform an action using a @Connection@ acquired from the given @Manager@.
--
-- You should use this only when you have to read and write interactively
-- through the connection (e.g. connection by the WebSocket protocol).
--
-- @since 0.5.13
withConnection :: Request -> Manager -> (Connection -> IO a) -> IO a
withConnection origReq man action = do
mHttpConn <- getConn (mSetProxy man origReq) man
action (managedResource mHttpConn) <* keepAlive mHttpConn
`finally` managedRelease mHttpConn DontReuse
http-client-0.5.14/Network/HTTP/Client/Headers.hs 0000644 0000000 0000000 00000010125 13374444652 017572 0 ustar 00 0000000 0000000 {-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
module Network.HTTP.Client.Headers
( parseStatusHeaders
, validateHeaders
, HeadersValidationResult (..)
) where
import Control.Applicative as A ((<$>), (<*>))
import Control.Monad
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.CaseInsensitive as CI
import Data.Char (ord)
import Data.Maybe (mapMaybe)
import Data.Monoid
import Network.HTTP.Client.Connection
import Network.HTTP.Client.Types
import System.Timeout (timeout)
import Network.HTTP.Types
import Data.Word (Word8)
charSpace, charColon, charPeriod :: Word8
charSpace = 32
charColon = 58
charPeriod = 46
parseStatusHeaders :: Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders
parseStatusHeaders conn timeout' cont
| Just k <- cont = getStatusExpectContinue k
| otherwise = getStatus
where
withTimeout = case timeout' of
Nothing -> id
Just t -> timeout t >=> maybe (throwHttp ResponseTimeout) return
getStatus = withTimeout next
where
next = nextStatusHeaders >>= maybe next return
getStatusExpectContinue sendBody = do
status <- withTimeout nextStatusHeaders
case status of
Just s -> return s
Nothing -> sendBody >> getStatus
nextStatusHeaders = do
(s, v) <- nextStatusLine
if statusCode s == 100
then connectionDropTillBlankLine conn >> return Nothing
else Just . StatusHeaders s v A.<$> parseHeaders (0 :: Int) id
nextStatusLine :: IO (Status, HttpVersion)
nextStatusLine = do
-- Ensure that there is some data coming in. If not, we want to signal
-- this as a connection problem and not a protocol problem.
bs <- connectionRead conn
when (S.null bs) $ throwHttp NoResponseDataReceived
connectionReadLineWith conn bs >>= parseStatus 3
parseStatus :: Int -> S.ByteString -> IO (Status, HttpVersion)
parseStatus i bs | S.null bs && i > 0 = connectionReadLine conn >>= parseStatus (i - 1)
parseStatus _ bs = do
let (ver, bs2) = S.break (== charSpace) bs
(code, bs3) = S.break (== charSpace) $ S.dropWhile (== charSpace) bs2
msg = S.dropWhile (== charSpace) bs3
case (,) <$> parseVersion ver A.<*> readInt code of
Just (ver', code') -> return (Status code' msg, ver')
Nothing -> throwHttp $ InvalidStatusLine bs
stripPrefixBS x y
| x `S.isPrefixOf` y = Just $ S.drop (S.length x) y
| otherwise = Nothing
parseVersion bs0 = do
bs1 <- stripPrefixBS "HTTP/" bs0
let (num1, S.drop 1 -> num2) = S.break (== charPeriod) bs1
HttpVersion <$> readInt num1 <*> readInt num2
readInt bs =
case S8.readInt bs of
Just (i, "") -> Just i
_ -> Nothing
parseHeaders 100 _ = throwHttp OverlongHeaders
parseHeaders count front = do
line <- connectionReadLine conn
if S.null line
then return $ front []
else do
header <- parseHeader line
parseHeaders (count + 1) $ front . (header:)
parseHeader :: S.ByteString -> IO Header
parseHeader bs = do
let (key, bs2) = S.break (== charColon) bs
when (S.null bs2) $ throwHttp $ InvalidHeader bs
return (CI.mk $! strip key, strip $! S.drop 1 bs2)
strip = S.dropWhile (== charSpace) . fst . S.spanEnd (== charSpace)
data HeadersValidationResult
= GoodHeaders
| BadHeaders S.ByteString -- contains a message with the reason
validateHeaders :: RequestHeaders -> HeadersValidationResult
validateHeaders headers =
case mapMaybe validateHeader headers of
[] -> GoodHeaders
reasons -> BadHeaders (S8.unlines reasons)
where
validateHeader (k, v)
| S8.elem '\n' v = Just ("Header " <> CI.original k <> " has newlines")
| True = Nothing
http-client-0.5.14/Network/HTTP/Client/Manager.hs 0000644 0000000 0000000 00000027046 13262666473 017606 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.HTTP.Client.Manager
( ManagerSettings (..)
, newManager
, closeManager
, withManager
, getConn
, defaultManagerSettings
, rawConnectionModifySocket
, rawConnectionModifySocketSize
, proxyFromRequest
, noProxy
, useProxy
, proxyEnvironment
, proxyEnvironmentNamed
, defaultProxy
, dropProxyAuthSecure
) where
import qualified Data.ByteString.Char8 as S8
import Data.Text (Text)
import Control.Monad (unless)
import Control.Exception (throwIO, fromException, IOException, Exception (..), handle)
import qualified Network.Socket as NS
import Network.HTTP.Types (status200)
import Network.HTTP.Client.Types
import Network.HTTP.Client.Connection
import Network.HTTP.Client.Headers (parseStatusHeaders)
import Network.HTTP.Proxy
import Data.KeyedPool
import Data.Maybe (isJust)
-- | A value for the @managerRawConnection@ setting, but also allows you to
-- modify the underlying @Socket@ to set additional settings. For a motivating
-- use case, see: .
--
-- Since 0.3.8
rawConnectionModifySocket :: (NS.Socket -> IO ())
-> IO (Maybe NS.HostAddress -> String -> Int -> IO Connection)
rawConnectionModifySocket = return . openSocketConnection
-- | Same as @rawConnectionModifySocket@, but also takes in a chunk size.
--
-- @since 0.5.2
rawConnectionModifySocketSize :: (NS.Socket -> IO ())
-> IO (Int -> Maybe NS.HostAddress -> String -> Int -> IO Connection)
rawConnectionModifySocketSize = return . openSocketConnectionSize
-- | Default value for @ManagerSettings@.
--
-- Note that this value does /not/ have support for SSL/TLS. If you need to
-- make any https connections, please use the http-client-tls package, which
-- provides a @tlsManagerSettings@ value.
--
-- Since 0.1.0
defaultManagerSettings :: ManagerSettings
defaultManagerSettings = ManagerSettings
{ managerConnCount = 10
, managerRawConnection = return $ openSocketConnection (const $ return ())
, managerTlsConnection = return $ \_ _ _ -> throwHttp TlsNotSupported
, managerTlsProxyConnection = return $ \_ _ _ _ _ _ -> throwHttp TlsNotSupported
, managerResponseTimeout = ResponseTimeoutDefault
, managerRetryableException = \e ->
case fromException e of
Just (_ :: IOException) -> True
_ ->
case fmap unHttpExceptionContentWrapper $ fromException e of
-- Note: Some servers will timeout connections by accepting
-- the incoming packets for the new request, but closing
-- the connection as soon as we try to read. To make sure
-- we open a new connection under these circumstances, we
-- check for the NoResponseDataReceived exception.
Just NoResponseDataReceived -> True
Just IncompleteHeaders -> True
_ -> False
, managerWrapException = \_req ->
let wrapper se =
case fromException se of
Just (_ :: IOException) -> throwHttp $ InternalException se
Nothing -> throwIO se
in handle wrapper
, managerIdleConnectionCount = 512
, managerModifyRequest = return
, managerModifyResponse = return
, managerProxyInsecure = defaultProxy
, managerProxySecure = defaultProxy
}
-- | Create a 'Manager'. The @Manager@ will be shut down automatically via
-- garbage collection.
--
-- Creating a new 'Manager' is a relatively expensive operation, you are
-- advised to share a single 'Manager' between requests instead.
--
-- The first argument to this function is often 'defaultManagerSettings',
-- though add-on libraries may provide a recommended replacement.
--
-- Since 0.1.0
newManager :: ManagerSettings -> IO Manager
newManager ms = do
NS.withSocketsDo $ return ()
httpProxy <- runProxyOverride (managerProxyInsecure ms) False
httpsProxy <- runProxyOverride (managerProxySecure ms) True
createConnection <- mkCreateConnection ms
keyedPool <- createKeyedPool
createConnection
connectionClose
(managerConnCount ms)
(managerIdleConnectionCount ms)
(const (return ())) -- could allow something in ManagerSettings to handle exceptions more nicely
let manager = Manager
{ mConns = keyedPool
, mResponseTimeout = managerResponseTimeout ms
, mRetryableException = managerRetryableException ms
, mWrapException = managerWrapException ms
, mModifyRequest = managerModifyRequest ms
, mModifyResponse = managerModifyResponse ms
, mSetProxy = \req ->
if secure req
then httpsProxy req
else httpProxy req
}
return manager
{- FIXME why isn't this being used anymore?
flushStaleCerts now =
Map.fromList . mapMaybe flushStaleCerts' . Map.toList
where
flushStaleCerts' (host', inner) =
case mapMaybe flushStaleCerts'' $ Map.toList inner of
[] -> Nothing
pairs ->
let x = take 10 pairs
in x `seqPairs` Just (host', Map.fromList x)
flushStaleCerts'' (certs, expires)
| expires > now = Just (certs, expires)
| otherwise = Nothing
seqPairs :: [(L.ByteString, UTCTime)] -> b -> b
seqPairs [] b = b
seqPairs (p:ps) b = p `seqPair` ps `seqPairs` b
seqPair :: (L.ByteString, UTCTime) -> b -> b
seqPair (lbs, utc) b = lbs `seqLBS` utc `seqUTC` b
seqLBS :: L.ByteString -> b -> b
seqLBS lbs b = L.length lbs `seq` b
seqUTC :: UTCTime -> b -> b
seqUTC (UTCTime day dt) b = day `seqDay` dt `seqDT` b
seqDay :: Day -> b -> b
seqDay (ModifiedJulianDay i) b = i `deepseq` b
seqDT :: DiffTime -> b -> b
seqDT = seq
-}
-- | Close all connections in a 'Manager'.
--
-- Note that this doesn't affect currently in-flight connections,
-- meaning you can safely use it without hurting any queries you may
-- have concurrently running.
--
-- Since 0.1.0
closeManager :: Manager -> IO ()
closeManager _ = return ()
{-# DEPRECATED closeManager "Manager will be closed for you automatically when no longer in use" #-}
-- | Create, use and close a 'Manager'.
--
-- Since 0.2.1
withManager :: ManagerSettings -> (Manager -> IO a) -> IO a
withManager settings f = newManager settings >>= f
{-# DEPRECATED withManager "Use newManager instead" #-}
-- | Drop the Proxy-Authorization header from the request if we're using a
-- secure proxy.
dropProxyAuthSecure :: Request -> Request
dropProxyAuthSecure req
| secure req && useProxy' = req
{ requestHeaders = filter (\(k, _) -> k /= "Proxy-Authorization")
(requestHeaders req)
}
| otherwise = req
where
useProxy' = isJust (proxy req)
getConn :: Request
-> Manager
-> IO (Managed Connection)
getConn req m
-- Stop Mac OS X from getting high:
-- https://github.com/snoyberg/http-client/issues/40#issuecomment-39117909
| S8.null h = throwHttp $ InvalidDestinationHost h
| otherwise = takeKeyedPool (mConns m) connkey
where
h = host req
connkey = connKey req
connKey :: Request -> ConnKey
connKey req =
case proxy req of
Nothing
| secure req -> simple CKSecure
| otherwise -> simple CKRaw
Just p
| secure req -> CKProxy
(proxyHost p)
(proxyPort p)
(lookup "Proxy-Authorization" (requestHeaders req))
(host req)
(port req)
| otherwise -> CKRaw Nothing (proxyHost p) (proxyPort p)
where
simple con = con (hostAddress req) (host req) (port req)
mkCreateConnection :: ManagerSettings -> IO (ConnKey -> IO Connection)
mkCreateConnection ms = do
rawConnection <- managerRawConnection ms
tlsConnection <- managerTlsConnection ms
tlsProxyConnection <- managerTlsProxyConnection ms
return $ \ck -> wrapConnectExc $ case ck of
CKRaw connaddr connhost connport ->
rawConnection connaddr (S8.unpack connhost) connport
CKSecure connaddr connhost connport ->
tlsConnection connaddr (S8.unpack connhost) connport
CKProxy connhost connport mProxyAuthHeader ultHost ultPort ->
let proxyAuthorizationHeader = maybe
""
(\h' -> S8.concat ["Proxy-Authorization: ", h', "\r\n"])
mProxyAuthHeader
hostHeader = S8.concat ["Host: ", ultHost, ":", (S8.pack $ show ultPort), "\r\n"]
connstr = S8.concat
[ "CONNECT "
, ultHost
, ":"
, S8.pack $ show ultPort
, " HTTP/1.1\r\n"
, proxyAuthorizationHeader
, hostHeader
, "\r\n"
]
parse conn = do
StatusHeaders status _ _ <- parseStatusHeaders conn Nothing Nothing
unless (status == status200) $
throwHttp $ ProxyConnectException ultHost ultPort status
in tlsProxyConnection
connstr
parse
(S8.unpack ultHost)
Nothing -- we never have a HostAddress we can use
(S8.unpack connhost)
connport
where
wrapConnectExc = handle $ \e ->
throwHttp $ ConnectionFailure (toException (e :: IOException))
-- | Get the proxy settings from the @Request@ itself.
--
-- Since 0.4.7
proxyFromRequest :: ProxyOverride
proxyFromRequest = ProxyOverride $ const $ return id
-- | Never connect using a proxy, regardless of the proxy value in the @Request@.
--
-- Since 0.4.7
noProxy :: ProxyOverride
noProxy = ProxyOverride $ const $ return $ \req -> req { proxy = Nothing }
-- | Use the given proxy settings, regardless of the proxy value in the @Request@.
--
-- Since 0.4.7
useProxy :: Proxy -> ProxyOverride
useProxy p = ProxyOverride $ const $ return $ \req -> req { proxy = Just p }
-- | Get the proxy settings from the default environment variable (@http_proxy@
-- for insecure, @https_proxy@ for secure). If no variable is set, then fall
-- back to the given value. @Nothing@ is equivalent to 'noProxy', @Just@ is
-- equivalent to 'useProxy'.
--
-- Since 0.4.7
proxyEnvironment :: Maybe Proxy -- ^ fallback if no environment set
-> ProxyOverride
proxyEnvironment mp = ProxyOverride $ \secure' ->
systemProxyHelper Nothing (httpProtocol secure') $ maybe EHNoProxy EHUseProxy mp
-- | Same as 'proxyEnvironment', but instead of default environment variable
-- names, allows you to set your own name.
--
-- Since 0.4.7
proxyEnvironmentNamed
:: Text -- ^ environment variable name
-> Maybe Proxy -- ^ fallback if no environment set
-> ProxyOverride
proxyEnvironmentNamed name mp = ProxyOverride $ \secure' ->
systemProxyHelper (Just name) (httpProtocol secure') $ maybe EHNoProxy EHUseProxy mp
-- | The default proxy settings for a manager. In particular: if the @http_proxy@ (or @https_proxy@) environment variable is set, use it. Otherwise, use the values in the @Request@.
--
-- Since 0.4.7
defaultProxy :: ProxyOverride
defaultProxy = ProxyOverride $ \secure' ->
systemProxyHelper Nothing (httpProtocol secure') EHFromRequest
http-client-0.5.14/Network/HTTP/Client/Request.hs 0000644 0000000 0000000 00000050762 13374444652 017662 0 ustar 00 0000000 0000000 {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Network.HTTP.Client.Request
( parseUrl
, parseUrlThrow
, parseRequest
, parseRequest_
, requestFromURI
, requestFromURI_
, defaultRequest
, setUriRelative
, getUri
, setUri
, browserDecompress
, alwaysDecompress
, addProxy
, applyBasicAuth
, applyBasicProxyAuth
, urlEncodedBody
, needsGunzip
, requestBuilder
, setRequestIgnoreStatus
, setRequestCheckStatus
, setQueryString
#if MIN_VERSION_http_types(0,12,1)
, setQueryStringPartialEscape
#endif
, streamFile
, observedStreamFile
, extractBasicAuthInfo
, throwErrorStatusCodes
) where
import Data.Int (Int64)
import Data.Maybe (fromMaybe, isJust, isNothing)
import Data.Monoid (mempty, mappend, (<>))
import Data.String (IsString(..))
import Data.Char (toLower)
import Control.Applicative as A ((<$>))
import Control.Monad (unless, guard)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Numeric (showHex)
import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString, toByteStringIO, flush)
import Blaze.ByteString.Builder.Char8 (fromChar, fromShow)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import qualified Network.HTTP.Types as W
import Network.URI (URI (..), URIAuth (..), parseURI, relativeTo, escapeURIString, unEscapeString, isAllowedInURI)
import Control.Exception (throw, throwIO, IOException)
import qualified Control.Exception as E
import qualified Data.CaseInsensitive as CI
import qualified Data.ByteArray.Encoding as BAE
import Network.HTTP.Client.Body
import Network.HTTP.Client.Types
import Network.HTTP.Client.Util
import Control.Monad.Catch (MonadThrow, throwM)
import System.IO (withBinaryFile, hTell, hFileSize, Handle, IOMode (ReadMode))
import Control.Monad (liftM)
-- | Deprecated synonym for 'parseUrlThrow'. You probably want
-- 'parseRequest' or 'parseRequest_' instead.
--
-- @since 0.1.0
parseUrl :: MonadThrow m => String -> m Request
parseUrl = parseUrlThrow
{-# DEPRECATED parseUrl "Please use parseUrlThrow, parseRequest, or parseRequest_ instead" #-}
-- | Same as 'parseRequest', except will throw an 'HttpException' in the
-- event of a non-2XX response. This uses 'throwErrorStatusCodes' to
-- implement 'checkResponse'.
--
-- @since 0.4.30
parseUrlThrow :: MonadThrow m => String -> m Request
parseUrlThrow =
liftM yesThrow . parseRequest
where
yesThrow req = req { checkResponse = throwErrorStatusCodes }
-- | Throws a 'StatusCodeException' wrapped in 'HttpExceptionRequest',
-- if the response's status code indicates an error (if it isn't 2xx).
-- This can be used to implement 'checkResponse'.
--
-- @since 0.5.13
throwErrorStatusCodes :: MonadIO m => Request -> Response BodyReader -> m ()
throwErrorStatusCodes req res = do
let W.Status sci _ = responseStatus res
if 200 <= sci && sci < 300
then return ()
else liftIO $ do
chunk <- brReadSome (responseBody res) 1024
let res' = fmap (const ()) res
let ex = StatusCodeException res' (L.toStrict chunk)
throwIO $ HttpExceptionRequest req ex
-- | Convert a URL into a 'Request'.
--
-- This function defaults some of the values in 'Request', such as setting 'method' to
-- @"GET"@ and 'requestHeaders' to @[]@.
--
-- Since this function uses 'MonadThrow', the return monad can be anything that is
-- an instance of 'MonadThrow', such as 'IO' or 'Maybe'.
--
-- You can place the request method at the beginning of the URL separated by a
-- space, e.g.:
--
-- @@@
-- parseRequest "POST http://httpbin.org/post"
-- @@@
--
-- Note that the request method must be provided as all capital letters.
--
-- A 'Request' created by this function won't cause exceptions on non-2XX
-- response status codes.
--
-- To create a request which throws on non-2XX status codes, see 'parseUrlThrow'
--
-- @since 0.4.30
parseRequest :: MonadThrow m => String -> m Request
parseRequest s' =
case parseURI (encode s) of
Just uri -> liftM setMethod (setUri defaultRequest uri)
Nothing -> throwM $ InvalidUrlException s "Invalid URL"
where
encode = escapeURIString isAllowedInURI
(mmethod, s) =
case break (== ' ') s' of
(x, ' ':y) | all (\c -> 'A' <= c && c <= 'Z') x -> (Just x, y)
_ -> (Nothing, s')
setMethod req =
case mmethod of
Nothing -> req
Just m -> req { method = S8.pack m }
-- | Same as 'parseRequest', but parse errors cause an impure exception.
-- Mostly useful for static strings which are known to be correctly
-- formatted.
parseRequest_ :: String -> Request
parseRequest_ = either throw id . parseRequest
-- | Convert a 'URI' into a 'Request'.
--
-- This can fail if the given 'URI' is not absolute, or if the
-- 'URI' scheme is not @"http"@ or @"https"@. In these cases the function
-- will throw an error via 'MonadThrow'.
--
-- This function defaults some of the values in 'Request', such as setting 'method' to
-- @"GET"@ and 'requestHeaders' to @[]@.
--
-- A 'Request' created by this function won't cause exceptions on non-2XX
-- response status codes.
--
-- @since 0.5.12
requestFromURI :: MonadThrow m => URI -> m Request
requestFromURI = setUri defaultRequest
-- | Same as 'requestFromURI', but if the conversion would fail,
-- throws an impure exception.
--
-- @since 0.5.12
requestFromURI_ :: URI -> Request
requestFromURI_ = either throw id . requestFromURI
-- | Add a 'URI' to the request. If it is absolute (includes a host name), add
-- it as per 'setUri'; if it is relative, merge it with the existing request.
setUriRelative :: MonadThrow m => Request -> URI -> m Request
setUriRelative req uri = setUri req $ uri `relativeTo` getUri req
-- | Extract a 'URI' from the request.
--
-- Since 0.1.0
getUri :: Request -> URI
getUri req = URI
{ uriScheme = if secure req
then "https:"
else "http:"
, uriAuthority = Just URIAuth
{ uriUserInfo = ""
, uriRegName = S8.unpack $ host req
, uriPort = port'
}
, uriPath = S8.unpack $ path req
, uriQuery =
case S8.uncons $ queryString req of
Just (c, _) | c /= '?' -> '?' : (S8.unpack $ queryString req)
_ -> S8.unpack $ queryString req
, uriFragment = ""
}
where
port'
| secure req && (port req) == 443 = ""
| not (secure req) && (port req) == 80 = ""
| otherwise = ':' : show (port req)
applyAnyUriBasedAuth :: URI -> Request -> Request
applyAnyUriBasedAuth uri req =
case extractBasicAuthInfo uri of
Just auth -> uncurry applyBasicAuth auth req
Nothing -> req
-- | Extract basic access authentication info in URI.
-- Return Nothing when there is no auth info in URI.
extractBasicAuthInfo :: URI -> Maybe (S8.ByteString, S8.ByteString)
extractBasicAuthInfo uri = do
userInfo <- uriUserInfo A.<$> uriAuthority uri
guard (':' `elem` userInfo)
let (username, ':':password) = break (==':') . takeWhile (/='@') $ userInfo
return (toLiteral username, toLiteral password)
where
toLiteral = S8.pack . unEscapeString
-- | Validate a 'URI', then add it to the request.
setUri :: MonadThrow m => Request -> URI -> m Request
setUri req uri = do
sec <- parseScheme uri
auth <- maybe (failUri "URL must be absolute") return $ uriAuthority uri
port' <- parsePort sec auth
return $ applyAnyUriBasedAuth uri req
{ host = S8.pack $ uriRegName auth
, port = port'
, secure = sec
, path = S8.pack $
if null $ uriPath uri
then "/"
else uriPath uri
, queryString = S8.pack $ uriQuery uri
}
where
failUri :: MonadThrow m => String -> m a
failUri = throwM . InvalidUrlException (show uri)
parseScheme URI{uriScheme = scheme} =
case map toLower scheme of
"http:" -> return False
"https:" -> return True
_ -> failUri "Invalid scheme"
parsePort sec URIAuth{uriPort = portStr} =
case portStr of
-- If the user specifies a port, then use it
':':rest -> maybe
(failUri "Invalid port")
return
(readDec rest)
-- Otherwise, use the default port
_ -> case sec of
False {- HTTP -} -> return 80
True {- HTTPS -} -> return 443
-- | A default request value, a GET request of localhost/:80, with an
-- empty request body.
--
-- Note that the default 'checkResponse' does nothing.
--
-- @since 0.4.30
defaultRequest :: Request
defaultRequest = Request
{ host = "localhost"
, port = 80
, secure = False
, requestHeaders = []
, path = "/"
, queryString = S8.empty
, requestBody = RequestBodyLBS L.empty
, method = "GET"
, proxy = Nothing
, hostAddress = Nothing
, rawBody = False
, decompress = browserDecompress
, redirectCount = 10
, checkResponse = \_ _ -> return ()
, responseTimeout = ResponseTimeoutDefault
, cookieJar = Just Data.Monoid.mempty
, requestVersion = W.http11
, onRequestBodyException = \se ->
case E.fromException se of
Just (_ :: IOException) -> return ()
Nothing -> throwIO se
, requestManagerOverride = Nothing
}
-- | Parses a URL via 'parseRequest_'
--
-- /NOTE/: Prior to version 0.5.0, this instance used 'parseUrlThrow'
-- instead.
instance IsString Request where
fromString = parseRequest_
{-# INLINE fromString #-}
-- | Always decompress a compressed stream.
alwaysDecompress :: S.ByteString -> Bool
alwaysDecompress = const True
-- | Decompress a compressed stream unless the content-type is 'application/x-tar'.
browserDecompress :: S.ByteString -> Bool
browserDecompress = (/= "application/x-tar")
-- | Build a basic-auth header value
buildBasicAuth ::
S8.ByteString -- ^ Username
-> S8.ByteString -- ^ Password
-> S8.ByteString
buildBasicAuth user passwd =
S8.append "Basic " (BAE.convertToBase BAE.Base64 (S8.concat [ user, ":", passwd ]))
-- | Add a Basic Auth header (with the specified user name and password) to the
-- given Request. Ignore error handling:
--
-- > applyBasicAuth "user" "pass" $ parseRequest_ url
--
-- NOTE: The function @applyDigestAuth@ is provided by the @http-client-tls@
-- package instead of this package due to extra dependencies. Please use that
-- package if you need to use digest authentication.
--
-- Since 0.1.0
applyBasicAuth :: S.ByteString -> S.ByteString -> Request -> Request
applyBasicAuth user passwd req =
req { requestHeaders = authHeader : requestHeaders req }
where
authHeader = (CI.mk "Authorization", buildBasicAuth user passwd)
-- | Add a proxy to the Request so that the Request when executed will use
-- the provided proxy.
--
-- Since 0.1.0
addProxy :: S.ByteString -> Int -> Request -> Request
addProxy hst prt req =
req { proxy = Just $ Proxy hst prt }
-- | Add a Proxy-Authorization header (with the specified username and
-- password) to the given 'Request'. Ignore error handling:
--
-- > applyBasicProxyAuth "user" "pass" <$> parseRequest "http://example.org"
--
-- Since 0.3.4
applyBasicProxyAuth :: S.ByteString -> S.ByteString -> Request -> Request
applyBasicProxyAuth user passwd req =
req { requestHeaders = authHeader : requestHeaders req }
where
authHeader = (CI.mk "Proxy-Authorization", buildBasicAuth user passwd)
-- | Add url-encoded parameters to the 'Request'.
--
-- This sets a new 'requestBody', adds a content-type request header and
-- changes the 'method' to POST.
--
-- Since 0.1.0
urlEncodedBody :: [(S.ByteString, S.ByteString)] -> Request -> Request
urlEncodedBody headers req = req
{ requestBody = RequestBodyLBS body
, method = "POST"
, requestHeaders =
(ct, "application/x-www-form-urlencoded")
: filter (\(x, _) -> x /= ct) (requestHeaders req)
}
where
ct = "Content-Type"
body = L.fromChunks . return $ W.renderSimpleQuery False headers
needsGunzip :: Request
-> [W.Header] -- ^ response headers
-> Bool
needsGunzip req hs' =
not (rawBody req)
&& ("content-encoding", "gzip") `elem` hs'
&& decompress req (fromMaybe "" $ lookup "content-type" hs')
requestBuilder :: Request -> Connection -> IO (Maybe (IO ()))
requestBuilder req Connection {..} = do
(contentLength, sendNow, sendLater) <- toTriple (requestBody req)
if expectContinue
then flushHeaders contentLength >> return (Just (checkBadSend sendLater))
else sendNow >> return Nothing
where
expectContinue = Just "100-continue" == lookup "Expect" (requestHeaders req)
checkBadSend f = f `E.catch` onRequestBodyException req
writeBuilder = toByteStringIO connectionWrite
writeHeadersWith contentLength = writeBuilder . (builder contentLength `Data.Monoid.mappend`)
flushHeaders contentLength = writeHeadersWith contentLength flush
toTriple (RequestBodyLBS lbs) = do
let body = fromLazyByteString lbs
len = Just $ L.length lbs
now = checkBadSend $ writeHeadersWith len body
later = writeBuilder body
return (len, now, later)
toTriple (RequestBodyBS bs) = do
let body = fromByteString bs
len = Just $ fromIntegral $ S.length bs
now = checkBadSend $ writeHeadersWith len body
later = writeBuilder body
return (len, now, later)
toTriple (RequestBodyBuilder len body) = do
let now = checkBadSend $ writeHeadersWith (Just len) body
later = writeBuilder body
return (Just len, now, later)
toTriple (RequestBodyStream len stream) = do
-- See https://github.com/snoyberg/http-client/issues/74 for usage
-- of flush here.
let body = writeStream (Just . fromIntegral $ len) stream
-- Don't check for a bad send on the headers themselves.
-- Ideally, we'd do the same thing for the other request body
-- types, but it would also introduce a performance hit since
-- we couldn't merge request headers and bodies together.
now = flushHeaders (Just len) >> checkBadSend body
return (Just len, now, body)
toTriple (RequestBodyStreamChunked stream) = do
let body = writeStream Nothing stream
now = flushHeaders Nothing >> checkBadSend body
return (Nothing, now, body)
toTriple (RequestBodyIO mbody) = mbody >>= toTriple
writeStream mlen withStream =
withStream (loop 0)
where
loop !n stream = do
bs <- stream
if S.null bs
then case mlen of
-- If stream is chunked, no length argument
Nothing -> connectionWrite "0\r\n\r\n"
-- Not chunked - validate length argument
Just len -> unless (len == n) $ throwHttp $ WrongRequestBodyStreamSize (fromIntegral len) (fromIntegral n)
else do
connectionWrite $
if (isNothing mlen) -- Chunked
then S.concat
[ S8.pack $ showHex (S.length bs) "\r\n"
, bs
, "\r\n"
]
else bs
loop (n + (S.length bs)) stream
hh
| port req == 80 && not (secure req) = host req
| port req == 443 && secure req = host req
| otherwise = host req <> S8.pack (':' : show (port req))
requestProtocol
| secure req = fromByteString "https://"
| otherwise = fromByteString "http://"
requestHostname
| isJust (proxy req) && not (secure req)
= requestProtocol <> fromByteString hh
| otherwise = mempty
contentLengthHeader (Just contentLength') =
if method req `elem` ["GET", "HEAD"] && contentLength' == 0
then id
else (:) ("Content-Length", S8.pack $ show contentLength')
contentLengthHeader Nothing = (:) ("Transfer-Encoding", "chunked")
acceptEncodingHeader =
case lookup "Accept-Encoding" $ requestHeaders req of
Nothing -> (("Accept-Encoding", "gzip"):)
Just "" -> filter (\(k, _) -> k /= "Accept-Encoding")
Just _ -> id
hostHeader x =
case lookup "Host" x of
Nothing -> ("Host", hh) : x
Just{} -> x
headerPairs :: Maybe Int64 -> W.RequestHeaders
headerPairs contentLength
= hostHeader
$ acceptEncodingHeader
$ contentLengthHeader contentLength
$ requestHeaders req
builder :: Maybe Int64 -> Builder
builder contentLength =
fromByteString (method req)
<> fromByteString " "
<> requestHostname
<> (case S8.uncons $ path req of
Just ('/', _) -> fromByteString $ path req
_ -> fromChar '/' <> fromByteString (path req))
<> (case S8.uncons $ queryString req of
Nothing -> mempty
Just ('?', _) -> fromByteString $ queryString req
_ -> fromChar '?' <> fromByteString (queryString req))
<> (case requestVersion req of
W.HttpVersion 1 1 -> fromByteString " HTTP/1.1\r\n"
W.HttpVersion 1 0 -> fromByteString " HTTP/1.0\r\n"
version ->
fromChar ' ' <>
fromShow version <>
fromByteString "\r\n")
<> foldr
(\a b -> headerPairToBuilder a <> b)
(fromByteString "\r\n")
(headerPairs contentLength)
headerPairToBuilder (k, v) =
fromByteString (CI.original k)
<> fromByteString ": "
<> fromByteString v
<> fromByteString "\r\n"
-- | Modify the request so that non-2XX status codes do not generate a runtime
-- 'StatusCodeException'.
--
-- @since 0.4.29
setRequestIgnoreStatus :: Request -> Request
setRequestIgnoreStatus req = req { checkResponse = \_ _ -> return () }
-- | Modify the request so that non-2XX status codes generate a runtime
-- 'StatusCodeException', by using 'throwErrorStatusCodes'
--
-- @since 0.5.13
setRequestCheckStatus :: Request -> Request
setRequestCheckStatus req = req { checkResponse = throwErrorStatusCodes }
-- | Set the query string to the given key/value pairs.
--
-- Since 0.3.6
setQueryString :: [(S.ByteString, Maybe S.ByteString)] -> Request -> Request
setQueryString qs req = req { queryString = W.renderQuery True qs }
#if MIN_VERSION_http_types(0,12,1)
-- | Set the query string to the given key/value pairs.
--
-- @since 0.5.10
setQueryStringPartialEscape :: [(S.ByteString, [W.EscapeItem])] -> Request -> Request
setQueryStringPartialEscape qs req = req { queryString = W.renderQueryPartialEscape True qs }
#endif
-- | Send a file as the request body.
--
-- It is expected that the file size does not change between calling
-- `streamFile` and making any requests using this request body.
--
-- Since 0.4.9
streamFile :: FilePath -> IO RequestBody
streamFile = observedStreamFile (\_ -> return ())
-- | Send a file as the request body, while observing streaming progress via
-- a `PopObserver`. Observations are made between reading and sending a chunk.
--
-- It is expected that the file size does not change between calling
-- `observedStreamFile` and making any requests using this request body.
--
-- Since 0.4.9
observedStreamFile :: (StreamFileStatus -> IO ()) -> FilePath -> IO RequestBody
observedStreamFile obs path = do
size <- fromIntegral <$> withBinaryFile path ReadMode hFileSize
let filePopper :: Handle -> Popper
filePopper h = do
bs <- S.hGetSome h defaultChunkSize
currentPosition <- fromIntegral <$> hTell h
obs $ StreamFileStatus
{ fileSize = size
, readSoFar = currentPosition
, thisChunkSize = S.length bs
}
return bs
givesFilePopper :: GivesPopper ()
givesFilePopper k = withBinaryFile path ReadMode $ \h -> do
k (filePopper h)
return $ RequestBodyStream size givesFilePopper
http-client-0.5.14/Network/HTTP/Client/Response.hs 0000644 0000000 0000000 00000012236 13264567404 020021 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP.Client.Response
( getRedirectedRequest
, getResponse
, lbsResponse
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import qualified Data.CaseInsensitive as CI
import Control.Arrow (second)
import Data.Monoid (mempty)
import qualified Network.HTTP.Types as W
import Network.URI (parseURIReference, escapeURIString, isAllowedInURI)
import Network.HTTP.Client.Types
import Network.HTTP.Client.Request
import Network.HTTP.Client.Util
import Network.HTTP.Client.Body
import Network.HTTP.Client.Headers
import Data.KeyedPool
-- | If a request is a redirection (status code 3xx) this function will create
-- a new request from the old request, the server headers returned with the
-- redirection, and the redirection code itself. This function returns 'Nothing'
-- if the code is not a 3xx, there is no 'location' header included, or if the
-- redirected response couldn't be parsed with 'parseRequest'.
--
-- If a user of this library wants to know the url chain that results from a
-- specific request, that user has to re-implement the redirect-following logic
-- themselves. An example of that might look like this:
--
-- > myHttp req man = do
-- > (res, redirectRequests) <- (`runStateT` []) $
-- > 'httpRedirect'
-- > 9000
-- > (\req' -> do
-- > res <- http req'{redirectCount=0} man
-- > modify (\rqs -> req' : rqs)
-- > return (res, getRedirectedRequest req' (responseHeaders res) (responseCookieJar res) (W.statusCode (responseStatus res))
-- > )
-- > 'lift'
-- > req
-- > applyCheckStatus (checkStatus req) res
-- > return redirectRequests
getRedirectedRequest :: Request -> W.ResponseHeaders -> CookieJar -> Int -> Maybe Request
getRedirectedRequest req hs cookie_jar code
| 300 <= code && code < 400 = do
l' <- lookup "location" hs
let l = escapeURIString isAllowedInURI (S8.unpack l')
req' <- setUriRelative req =<< parseURIReference l
return $
if code == 302 || code == 303
-- According to the spec, this should *only* be for status code
-- 303. However, almost all clients mistakenly implement it for
-- 302 as well. So we have to be wrong like everyone else...
then req'
{ method = "GET"
, requestBody = RequestBodyBS ""
, cookieJar = cookie_jar'
, requestHeaders = filter ((/= W.hContentType) . fst) $ requestHeaders req'
}
else req' {cookieJar = cookie_jar'}
| otherwise = Nothing
where
cookie_jar' = fmap (const cookie_jar) $ cookieJar req
-- | Convert a 'Response' that has a 'Source' body to one with a lazy
-- 'L.ByteString' body.
lbsResponse :: Response BodyReader -> IO (Response L.ByteString)
lbsResponse res = do
bss <- brConsume $ responseBody res
return res
{ responseBody = L.fromChunks bss
}
getResponse :: Maybe Int
-> Request
-> Managed Connection
-> Maybe (IO ()) -- ^ Action to run in case of a '100 Continue'.
-> IO (Response BodyReader)
getResponse timeout' req@(Request {..}) mconn cont = do
let conn = managedResource mconn
StatusHeaders s version hs <- parseStatusHeaders conn timeout' cont
let mcl = lookup "content-length" hs >>= readDec . S8.unpack
isChunked = ("transfer-encoding", CI.mk "chunked") `elem` map (second CI.mk) hs
-- should we put this connection back into the connection manager?
toPut = Just "close" /= lookup "connection" hs && version > W.HttpVersion 1 0
cleanup bodyConsumed = managedRelease mconn $ if toPut && bodyConsumed then Reuse else DontReuse
body <-
-- RFC 2616 section 4.4_1 defines responses that must not include a body
if hasNoBody method (W.statusCode s) || (mcl == Just 0 && not isChunked)
then do
cleanup True
return brEmpty
else do
body1 <-
if isChunked
then makeChunkedReader rawBody conn
else
case mcl of
Just len -> makeLengthReader len conn
Nothing -> makeUnlimitedReader conn
body2 <- if needsGunzip req hs
then makeGzipReader body1
else return body1
return $ brAddCleanup (cleanup True) body2
return Response
{ responseStatus = s
, responseVersion = version
, responseHeaders = hs
, responseBody = body
, responseCookieJar = Data.Monoid.mempty
, responseClose' = ResponseClose (cleanup False)
}
-- | Does this response have no body?
hasNoBody :: ByteString -- ^ request method
-> Int -- ^ status code
-> Bool
hasNoBody "HEAD" _ = True
hasNoBody _ 204 = True
hasNoBody _ 304 = True
hasNoBody _ i = 100 <= i && i < 200
http-client-0.5.14/Network/HTTP/Client/Types.hs 0000644 0000000 0000000 00000071120 13374444652 017325 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.Types
( BodyReader
, Connection (..)
, StatusHeaders (..)
, HttpException (..)
, HttpExceptionContent (..)
, unHttpExceptionContentWrapper
, throwHttp
, toHttpException
, Cookie (..)
, CookieJar (..)
, Proxy (..)
, RequestBody (..)
, Popper
, NeedsPopper
, GivesPopper
, Request (..)
, Response (..)
, ResponseClose (..)
, Manager (..)
, HasHttpManager (..)
, ConnsMap (..)
, ManagerSettings (..)
, NonEmptyList (..)
, ConnHost (..)
, ConnKey (..)
, ProxyOverride (..)
, StreamFileStatus (..)
, ResponseTimeout (..)
) where
import qualified Data.Typeable as T (Typeable)
import Network.HTTP.Types
import Control.Exception (Exception, SomeException, throwIO)
import Data.Word (Word64)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Blaze.ByteString.Builder (Builder, fromLazyByteString, fromByteString, toLazyByteString)
import Data.Int (Int64)
import Data.Foldable (Foldable)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString, fromString)
import Data.Time (UTCTime)
import Data.Traversable (Traversable)
import qualified Data.List as DL
import Network.Socket (HostAddress)
import Data.IORef
import qualified Network.Socket as NS
import qualified Data.Map as Map
import Data.Text (Text)
import Data.Streaming.Zlib (ZlibException)
import Data.CaseInsensitive as CI
import Data.KeyedPool (KeyedPool)
-- | An @IO@ action that represents an incoming response body coming from the
-- server. Data provided by this action has already been gunzipped and
-- de-chunked, and respects any content-length headers present.
--
-- The action gets a single chunk of data from the response body, or an empty
-- bytestring if no more data is available.
--
-- Since 0.4.0
type BodyReader = IO S.ByteString
data Connection = Connection
{ connectionRead :: IO S.ByteString
-- ^ If no more data, return empty.
, connectionUnread :: S.ByteString -> IO ()
-- ^ Return data to be read next time.
, connectionWrite :: S.ByteString -> IO ()
-- ^ Send data to server
, connectionClose :: IO ()
-- ^ Close connection. Any successive operation on the connection
-- (except closing) should fail with `ConnectionClosed` exception.
-- It is allowed to close connection multiple times.
}
deriving T.Typeable
data StatusHeaders = StatusHeaders Status HttpVersion RequestHeaders
deriving (Show, Eq, Ord, T.Typeable)
-- | A newtype wrapper which is not exported from this library but is an
-- instance of @Exception@. This allows @HttpExceptionContent@ to be thrown
-- (via this wrapper), but users of the library can't accidentally try to catch
-- it (when they /should/ be trying to catch 'HttpException').
--
-- @since 0.5.0
newtype HttpExceptionContentWrapper = HttpExceptionContentWrapper
{ unHttpExceptionContentWrapper :: HttpExceptionContent
}
deriving (Show, T.Typeable)
instance Exception HttpExceptionContentWrapper
throwHttp :: HttpExceptionContent -> IO a
throwHttp = throwIO . HttpExceptionContentWrapper
toHttpException :: Request -> HttpExceptionContentWrapper -> HttpException
toHttpException req (HttpExceptionContentWrapper e) = HttpExceptionRequest req e
-- | An exception which may be generated by this library
--
-- @since 0.5.0
data HttpException
= HttpExceptionRequest Request HttpExceptionContent
-- ^ Most exceptions are specific to a 'Request'. Inspect the
-- 'HttpExceptionContent' value for details on what occurred.
--
-- @since 0.5.0
| InvalidUrlException String String
-- ^ A URL (first field) is invalid for a given reason
-- (second argument).
--
-- @since 0.5.0
deriving (Show, T.Typeable)
instance Exception HttpException
data HttpExceptionContent
= StatusCodeException (Response ()) S.ByteString
-- ^ Generated by the @parseUrlThrow@ function when the
-- server returns a non-2XX response status code.
--
-- May include the beginning of the response body.
--
-- @since 0.5.0
| TooManyRedirects [Response L.ByteString]
-- ^ The server responded with too many redirects for a
-- request.
--
-- Contains the list of encountered responses containing
-- redirects in reverse chronological order; including last
-- redirect, which triggered the exception and was not
-- followed.
--
-- @since 0.5.0
| OverlongHeaders
-- ^ Either too many headers, or too many total bytes in a
-- single header, were returned by the server, and the
-- memory exhaustion protection in this library has kicked
-- in.
--
-- @since 0.5.0
| ResponseTimeout
-- ^ The server took too long to return a response. This can
-- be altered via 'responseTimeout' or
-- 'managerResponseTimeout'.
--
-- @since 0.5.0
| ConnectionTimeout
-- ^ Attempting to connect to the server timed out.
--
-- @since 0.5.0
| ConnectionFailure SomeException
-- ^ An exception occurred when trying to connect to the
-- server.
--
-- @since 0.5.0
| InvalidStatusLine S.ByteString
-- ^ The status line returned by the server could not be parsed.
--
-- @since 0.5.0
| InvalidHeader S.ByteString
-- ^ The given response header line could not be parsed
--
-- @since 0.5.0
| InvalidRequestHeader S.ByteString
-- ^ The given request header is not compliant (e.g. has newlines)
--
-- @since 0.5.14
| InternalException SomeException
-- ^ An exception was raised by an underlying library when
-- performing the request. Most often, this is caused by a
-- failing socket action or a TLS exception.
--
-- @since 0.5.0
| ProxyConnectException S.ByteString Int Status
-- ^ A non-200 status code was returned when trying to
-- connect to the proxy server on the given host and port.
--
-- @since 0.5.0
| NoResponseDataReceived
-- ^ No response data was received from the server at all.
-- This exception may deserve special handling within the
-- library, since it may indicate that a pipelining has been
-- used, and a connection thought to be open was in fact
-- closed.
--
-- @since 0.5.0
| TlsNotSupported
-- ^ Exception thrown when using a @Manager@ which does not
-- have support for secure connections. Typically, you will
-- want to use @tlsManagerSettings@ from @http-client-tls@
-- to overcome this.
--
-- @since 0.5.0
| WrongRequestBodyStreamSize Word64 Word64
-- ^ The request body provided did not match the expected size.
--
-- Provides the expected and actual size.
--
-- @since 0.4.31
| ResponseBodyTooShort Word64 Word64
-- ^ The returned response body is too short. Provides the
-- expected size and actual size.
--
-- @since 0.5.0
| InvalidChunkHeaders
-- ^ A chunked response body had invalid headers.
--
-- @since 0.5.0
| IncompleteHeaders
-- ^ An incomplete set of response headers were returned.
--
-- @since 0.5.0
| InvalidDestinationHost S.ByteString
-- ^ The host we tried to connect to is invalid (e.g., an
-- empty string).
| HttpZlibException ZlibException
-- ^ An exception was thrown when inflating a response body.
--
-- @since 0.5.0
| InvalidProxyEnvironmentVariable Text Text
-- ^ Values in the proxy environment variable were invalid.
-- Provides the environment variable name and its value.
--
-- @since 0.5.0
| ConnectionClosed
-- ^ Attempted to use a 'Connection' which was already closed
--
-- @since 0.5.0
| InvalidProxySettings Text
-- ^ Proxy settings are not valid (Windows specific currently)
-- @since 0.5.7
deriving (Show, T.Typeable)
-- Purposely not providing this instance, since we don't want users to
-- accidentally try and catch these exceptions instead of HttpException
--
-- instance Exception HttpExceptionContent
-- This corresponds to the description of a cookie detailed in Section 5.3 \"Storage Model\"
data Cookie = Cookie
{ cookie_name :: S.ByteString
, cookie_value :: S.ByteString
, cookie_expiry_time :: UTCTime
, cookie_domain :: S.ByteString
, cookie_path :: S.ByteString
, cookie_creation_time :: UTCTime
, cookie_last_access_time :: UTCTime
, cookie_persistent :: Bool
, cookie_host_only :: Bool
, cookie_secure_only :: Bool
, cookie_http_only :: Bool
}
deriving (Read, Show, T.Typeable)
newtype CookieJar = CJ { expose :: [Cookie] }
deriving (Read, Show, T.Typeable)
-- This corresponds to step 11 of the algorithm described in Section 5.3 \"Storage Model\"
instance Eq Cookie where
(==) a b = name_matches && domain_matches && path_matches
where name_matches = cookie_name a == cookie_name b
domain_matches = CI.foldCase (cookie_domain a) == CI.foldCase (cookie_domain b)
path_matches = cookie_path a == cookie_path b
instance Ord Cookie where
compare c1 c2
| S.length (cookie_path c1) > S.length (cookie_path c2) = LT
| S.length (cookie_path c1) < S.length (cookie_path c2) = GT
| cookie_creation_time c1 > cookie_creation_time c2 = GT
| otherwise = LT
instance Eq CookieJar where
(==) cj1 cj2 = (DL.sort $ expose cj1) == (DL.sort $ expose cj2)
instance Semigroup CookieJar where
(CJ a) <> (CJ b) = CJ (DL.nub $ DL.sortBy compare' $ a <> b)
where compare' c1 c2 =
-- inverse so that recent cookies are kept by nub over older
if cookie_creation_time c1 > cookie_creation_time c2
then LT
else GT
-- | Since 1.9
instance Data.Monoid.Monoid CookieJar where
mempty = CJ []
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
-- | Define a HTTP proxy, consisting of a hostname and port number.
data Proxy = Proxy
{ proxyHost :: S.ByteString -- ^ The host name of the HTTP proxy.
, proxyPort :: Int -- ^ The port number of the HTTP proxy.
}
deriving (Show, Read, Eq, Ord, T.Typeable)
-- | When using one of the 'RequestBodyStream' \/ 'RequestBodyStreamChunked'
-- constructors, you must ensure that the 'GivesPopper' can be called multiple
-- times. Usually this is not a problem.
--
-- The 'RequestBodyStreamChunked' will send a chunked request body. Note that
-- not all servers support this. Only use 'RequestBodyStreamChunked' if you
-- know the server you're sending to supports chunked request bodies.
--
-- Since 0.1.0
data RequestBody
= RequestBodyLBS L.ByteString
| RequestBodyBS S.ByteString
| RequestBodyBuilder Int64 Builder
| RequestBodyStream Int64 (GivesPopper ())
| RequestBodyStreamChunked (GivesPopper ())
| RequestBodyIO (IO RequestBody)
-- ^ Allows creation of a @RequestBody@ inside the @IO@ monad, which is
-- useful for making easier APIs (like @setRequestBodyFile@).
--
-- @since 0.4.28
deriving T.Typeable
-- |
--
-- Since 0.4.12
instance IsString RequestBody where
fromString str = RequestBodyBS (fromString str)
instance Monoid RequestBody where
mempty = RequestBodyBS S.empty
#if !(MIN_VERSION_base(4,11,0))
mappend = (<>)
#endif
instance Semigroup RequestBody where
x0 <> y0 =
case (simplify x0, simplify y0) of
(Left (i, x), Left (j, y)) -> RequestBodyBuilder (i + j) (x <> y)
(Left x, Right y) -> combine (builderToStream x) y
(Right x, Left y) -> combine x (builderToStream y)
(Right x, Right y) -> combine x y
where
combine (Just i, x) (Just j, y) = RequestBodyStream (i + j) (combine' x y)
combine (_, x) (_, y) = RequestBodyStreamChunked (combine' x y)
combine' :: GivesPopper () -> GivesPopper () -> GivesPopper ()
combine' x y f = x $ \x' -> y $ \y' -> combine'' x' y' f
combine'' :: Popper -> Popper -> NeedsPopper () -> IO ()
combine'' x y f = do
istate <- newIORef $ Left (x, y)
f $ go istate
go istate = do
state <- readIORef istate
case state of
Left (x, y) -> do
bs <- x
if S.null bs
then do
writeIORef istate $ Right y
y
else return bs
Right y -> y
simplify :: RequestBody -> Either (Int64, Builder) (Maybe Int64, GivesPopper ())
simplify (RequestBodyLBS lbs) = Left (L.length lbs, fromLazyByteString lbs)
simplify (RequestBodyBS bs) = Left (fromIntegral $ S.length bs, fromByteString bs)
simplify (RequestBodyBuilder len b) = Left (len, b)
simplify (RequestBodyStream i gp) = Right (Just i, gp)
simplify (RequestBodyStreamChunked gp) = Right (Nothing, gp)
simplify (RequestBodyIO _mbody) = error "FIXME No support for Monoid on RequestBodyIO"
builderToStream :: (Int64, Builder) -> (Maybe Int64, GivesPopper ())
builderToStream (len, builder) =
(Just len, gp)
where
gp np = do
ibss <- newIORef $ L.toChunks $ toLazyByteString builder
np $ do
bss <- readIORef ibss
case bss of
[] -> return S.empty
bs:bss' -> do
writeIORef ibss bss'
return bs
-- | A function which generates successive chunks of a request body, provider a
-- single empty bytestring when no more data is available.
--
-- Since 0.1.0
type Popper = IO S.ByteString
-- | A function which must be provided with a 'Popper'.
--
-- Since 0.1.0
type NeedsPopper a = Popper -> IO a
-- | A function which will provide a 'Popper' to a 'NeedsPopper'. This
-- seemingly convoluted structure allows for creation of request bodies which
-- allocate scarce resources in an exception safe manner.
--
-- Since 0.1.0
type GivesPopper a = NeedsPopper a -> IO a
-- | All information on how to connect to a host and what should be sent in the
-- HTTP request.
--
-- If you simply wish to download from a URL, see 'parseRequest'.
--
-- The constructor for this data type is not exposed. Instead, you should use
-- either the 'defaultRequest' value, or 'parseRequest' to
-- construct from a URL, and then use the records below to make modifications.
-- This approach allows http-client to add configuration options without
-- breaking backwards compatibility.
--
-- For example, to construct a POST request, you could do something like:
--
-- > initReq <- parseRequest "http://www.example.com/path"
-- > let req = initReq
-- > { method = "POST"
-- > }
--
-- For more information, please see
-- .
--
-- Since 0.1.0
data Request = Request
{ method :: Method
-- ^ HTTP request method, eg GET, POST.
--
-- Since 0.1.0
, secure :: Bool
-- ^ Whether to use HTTPS (ie, SSL).
--
-- Since 0.1.0
, host :: S.ByteString
-- ^ Requested host name, used for both the IP address to connect to and
-- the @host@ request header.
--
-- Since 0.1.0
, port :: Int
-- ^ The port to connect to. Also used for generating the @host@ request header.
--
-- Since 0.1.0
, path :: S.ByteString
-- ^ Everything from the host to the query string.
--
-- Since 0.1.0
, queryString :: S.ByteString
-- ^ Query string appended to the path.
--
-- Since 0.1.0
, requestHeaders :: RequestHeaders
-- ^ Custom HTTP request headers
--
-- The Content-Length and Transfer-Encoding headers are set automatically
-- by this module, and shall not be added to @requestHeaders@.
--
-- If not provided by the user, @Host@ will automatically be set based on
-- the @host@ and @port@ fields.
--
-- Moreover, the Accept-Encoding header is set implicitly to gzip for
-- convenience by default. This behaviour can be overridden if needed, by
-- setting the header explicitly to a different value. In order to omit the
-- Accept-Header altogether, set it to the empty string \"\". If you need an
-- empty Accept-Header (i.e. requesting the identity encoding), set it to a
-- non-empty white-space string, e.g. \" \". See RFC 2616 section 14.3 for
-- details about the semantics of the Accept-Header field. If you request a
-- content-encoding not supported by this module, you will have to decode
-- it yourself (see also the 'decompress' field).
--
-- Note: Multiple header fields with the same field-name will result in
-- multiple header fields being sent and therefore it\'s the responsibility
-- of the client code to ensure that the rules from RFC 2616 section 4.2
-- are honoured.
--
-- Since 0.1.0
, requestBody :: RequestBody
-- ^ Request body to be sent to the server.
--
-- Since 0.1.0
, proxy :: Maybe Proxy
-- ^ Optional HTTP proxy.
--
-- Since 0.1.0
, hostAddress :: Maybe HostAddress
-- ^ Optional resolved host address. May not be used by all backends.
--
-- Since 0.1.0
, rawBody :: Bool
-- ^ If @True@, a chunked and\/or gzipped body will not be
-- decoded. Use with caution.
--
-- Since 0.1.0
, decompress :: S.ByteString -> Bool
-- ^ Predicate to specify whether gzipped data should be
-- decompressed on the fly (see 'alwaysDecompress' and
-- 'browserDecompress'). Argument is the mime type.
-- Default: browserDecompress.
--
-- Since 0.1.0
, redirectCount :: Int
-- ^ How many redirects to follow when getting a resource. 0 means follow
-- no redirects. Default value: 10.
--
-- Since 0.1.0
, checkResponse :: Request -> Response BodyReader -> IO ()
-- ^ Check the response immediately after receiving the status and headers.
-- This can be useful for throwing exceptions on non-success status codes.
--
-- In previous versions of http-client, this went under the name
-- @checkStatus@, but was renamed to avoid confusion about the new default
-- behavior (doing nothing).
--
-- @since 0.5.0
, responseTimeout :: ResponseTimeout
-- ^ Number of microseconds to wait for a response. If
-- @Nothing@, will wait indefinitely. Default: use
-- 'managerResponseTimeout' (which by default is 30 seconds).
--
-- Since 0.1.0
, cookieJar :: Maybe CookieJar
-- ^ A user-defined cookie jar.
-- If 'Nothing', no cookie handling will take place, \"Cookie\" headers
-- in 'requestHeaders' will be sent raw, and 'responseCookieJar' will be
-- empty.
--
-- Since 0.1.0
, requestVersion :: HttpVersion
-- ^ HTTP version to send to server.
--
-- Default: HTTP 1.1
--
-- Since 0.4.3
, onRequestBodyException :: SomeException -> IO ()
-- ^ How to deal with exceptions thrown while sending the request.
--
-- Default: ignore @IOException@s, rethrow all other exceptions.
--
-- Since: 0.4.6
, requestManagerOverride :: Maybe Manager
-- ^ A 'Manager' value that should override whatever @Manager@ value was
-- passed in to the HTTP request function manually. This is useful when
-- dealing with implicit global managers, such as in @Network.HTTP.Simple@
--
-- @since 0.4.28
}
deriving T.Typeable
-- | How to deal with timing out a response
--
-- @since 0.5.0
data ResponseTimeout
= ResponseTimeoutMicro !Int
| ResponseTimeoutNone
| ResponseTimeoutDefault
deriving (Eq, Show)
instance Show Request where
show x = unlines
[ "Request {"
, " host = " ++ show (host x)
, " port = " ++ show (port x)
, " secure = " ++ show (secure x)
, " requestHeaders = " ++ show (DL.map redactSensitiveHeader (requestHeaders x))
, " path = " ++ show (path x)
, " queryString = " ++ show (queryString x)
--, " requestBody = " ++ show (requestBody x)
, " method = " ++ show (method x)
, " proxy = " ++ show (proxy x)
, " rawBody = " ++ show (rawBody x)
, " redirectCount = " ++ show (redirectCount x)
, " responseTimeout = " ++ show (responseTimeout x)
, " requestVersion = " ++ show (requestVersion x)
, "}"
]
redactSensitiveHeader :: Header -> Header
redactSensitiveHeader ("Authorization", _) = ("Authorization", "")
redactSensitiveHeader h = h
-- | A simple representation of the HTTP response.
--
-- Since 0.1.0
data Response body = Response
{ responseStatus :: Status
-- ^ Status code of the response.
--
-- Since 0.1.0
, responseVersion :: HttpVersion
-- ^ HTTP version used by the server.
--
-- Since 0.1.0
, responseHeaders :: ResponseHeaders
-- ^ Response headers sent by the server.
--
-- Since 0.1.0
, responseBody :: body
-- ^ Response body sent by the server.
--
-- Since 0.1.0
, responseCookieJar :: CookieJar
-- ^ Cookies set on the client after interacting with the server. If
-- cookies have been disabled by setting 'cookieJar' to @Nothing@, then
-- this will always be empty.
--
-- Since 0.1.0
, responseClose' :: ResponseClose
-- ^ Releases any resource held by this response. If the response body
-- has not been fully read yet, doing so after this call will likely
-- be impossible.
--
-- Since 0.1.0
}
deriving (Show, Eq, T.Typeable, Functor, Data.Foldable.Foldable, Data.Traversable.Traversable)
newtype ResponseClose = ResponseClose { runResponseClose :: IO () }
deriving T.Typeable
instance Show ResponseClose where
show _ = "ResponseClose"
instance Eq ResponseClose where
_ == _ = True
-- | Settings for a @Manager@. Please use the 'defaultManagerSettings' function and then modify
-- individual settings. For more information, see .
--
-- Since 0.1.0
data ManagerSettings = ManagerSettings
{ managerConnCount :: Int
-- ^ Number of connections to a single host to keep alive. Default: 10.
--
-- Since 0.1.0
, managerRawConnection :: IO (Maybe NS.HostAddress -> String -> Int -> IO Connection)
-- ^ Create an insecure connection.
--
-- Since 0.1.0
, managerTlsConnection :: IO (Maybe NS.HostAddress -> String -> Int -> IO Connection)
-- ^ Create a TLS connection. Default behavior: throw an exception that TLS is not supported.
--
-- Since 0.1.0
, managerTlsProxyConnection :: IO (S.ByteString -> (Connection -> IO ()) -> String -> Maybe NS.HostAddress -> String -> Int -> IO Connection)
-- ^ Create a TLS proxy connection. Default behavior: throw an exception that TLS is not supported.
--
-- Since 0.2.2
, managerResponseTimeout :: ResponseTimeout
-- ^ Default timeout to be applied to requests which do not provide a
-- timeout value.
--
-- Default is 30 seconds
--
-- @since 0.5.0
, managerRetryableException :: SomeException -> Bool
-- ^ Exceptions for which we should retry our request if we were reusing an
-- already open connection. In the case of IOExceptions, for example, we
-- assume that the connection was closed on the server and therefore open a
-- new one.
--
-- Since 0.1.0
, managerWrapException :: forall a. Request -> IO a -> IO a
-- ^ Action wrapped around all attempted @Request@s, usually used to wrap
-- up exceptions in library-specific types.
--
-- Default: wrap all @IOException@s in the @InternalException@ constructor.
--
-- @since 0.5.0
, managerIdleConnectionCount :: Int
-- ^ Total number of idle connection to keep open at a given time.
--
-- This limit helps deal with the case where you are making a large number
-- of connections to different hosts. Without this limit, you could run out
-- of file descriptors. Additionally, it can be set to zero to prevent
-- reuse of any connections. Doing this is useful when the server your application
-- is talking to sits behind a load balancer.
--
-- Default: 512
--
-- Since 0.3.7
, managerModifyRequest :: Request -> IO Request
-- ^ Perform the given modification to a @Request@ before performing it.
--
-- Default: no modification
--
-- Since 0.4.4
, managerModifyResponse :: Response BodyReader -> IO (Response BodyReader)
-- ^ Perform the given modification to a @Response@ after receiving it.
--
-- Default: no modification
--
-- @since 0.5.5
, managerProxyInsecure :: ProxyOverride
-- ^ How HTTP proxy server settings should be discovered.
--
-- Default: respect the @proxy@ value on the @Request@ itself.
--
-- Since 0.4.7
, managerProxySecure :: ProxyOverride
-- ^ How HTTPS proxy server settings should be discovered.
--
-- Default: respect the @proxy@ value on the @Request@ itself.
--
-- Since 0.4.7
}
deriving T.Typeable
-- | How the HTTP proxy server settings should be discovered.
--
-- Since 0.4.7
newtype ProxyOverride = ProxyOverride
{ runProxyOverride :: Bool -> IO (Request -> Request)
}
deriving T.Typeable
-- | Keeps track of open connections for keep-alive.
--
-- If possible, you should share a single 'Manager' between multiple threads and requests.
--
-- Since 0.1.0
data Manager = Manager
{ mConns :: KeyedPool ConnKey Connection
, mResponseTimeout :: ResponseTimeout
-- ^ Copied from 'managerResponseTimeout'
, mRetryableException :: SomeException -> Bool
, mWrapException :: forall a. Request -> IO a -> IO a
, mModifyRequest :: Request -> IO Request
, mSetProxy :: Request -> Request
, mModifyResponse :: Response BodyReader -> IO (Response BodyReader)
-- ^ See 'managerProxy'
}
deriving T.Typeable
class HasHttpManager a where
getHttpManager :: a -> Manager
instance HasHttpManager Manager where
getHttpManager = id
data ConnsMap
= ManagerClosed
| ManagerOpen {-# UNPACK #-} !Int !(Map.Map ConnKey (NonEmptyList Connection))
data NonEmptyList a =
One a UTCTime |
Cons a Int UTCTime (NonEmptyList a)
deriving T.Typeable
-- | Hostname or resolved host address.
data ConnHost =
HostName Text |
HostAddress NS.HostAddress
deriving (Eq, Show, Ord, T.Typeable)
-- | @ConnKey@ consists of a hostname, a port and a @Bool@
-- specifying whether to use SSL.
data ConnKey
= CKRaw (Maybe HostAddress) {-# UNPACK #-} !S.ByteString !Int
| CKSecure (Maybe HostAddress) {-# UNPACK #-} !S.ByteString !Int
| CKProxy
{-# UNPACK #-} !S.ByteString
!Int
-- Proxy-Authorization request header
(Maybe S.ByteString)
-- ultimate host
{-# UNPACK #-} !S.ByteString
-- ultimate port
!Int
deriving (Eq, Show, Ord, T.Typeable)
-- | Status of streaming a request body from a file.
--
-- Since 0.4.9
data StreamFileStatus = StreamFileStatus
{ fileSize :: Int64
, readSoFar :: Int64
, thisChunkSize :: Int
}
deriving (Eq, Show, Ord, T.Typeable)
http-client-0.5.14/Network/HTTP/Client/Util.hs 0000644 0000000 0000000 00000000564 13262666473 017145 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.HTTP.Client.Util
( readDec
) where
import qualified Data.Text as T
import qualified Data.Text.Read
readDec :: Integral i => String -> Maybe i
readDec s =
case Data.Text.Read.decimal $ T.pack s of
Right (i, t)
| T.null t -> Just i
_ -> Nothing
http-client-0.5.14/Network/HTTP/Proxy.hs 0000644 0000000 0000000 00000036272 13242054727 016127 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-
Copyright (c) 2002, Warrick Gray
Copyright (c) 2002-2005, Ian Lynagh
Copyright (c) 2003-2006, Bjorn Bringert
Copyright (c) 2004, Andre Furtado
Copyright (c) 2004-2005, Dominic Steinitz
Copyright (c) 2007, Robin Bate Boerop
Copyright (c) 2008-2010, Sigbjorn Finne
Copyright (c) 2009, Eric Kow
Copyright (c) 2010, Antoine Latter
Copyright (c) 2004, 2010-2011, Ganesh Sittampalam
Copyright (c) 2011, Duncan Coutts
Copyright (c) 2011, Matthew Gruen
Copyright (c) 2011, Jeremy Yallop
Copyright (c) 2011, Eric Hesselink
Copyright (c) 2011, Yi Huang
Copyright (c) 2011, Tom Lokhorst
Copyright (c) 2017, Vassil Keremidchiev
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above
copyright notice, this list of conditions and the following
disclaimer in the documentation and/or other materials provided
with the distribution.
* The names of contributors may not be used to endorse or promote
products derived from this software without specific prior
written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}
module Network.HTTP.Proxy( ProxyProtocol(..), EnvHelper(..),
systemProxyHelper, envHelper,
httpProtocol,
ProxySettings ) where
import qualified Control.Applicative as A
import Control.Arrow (first)
import Control.Monad (guard)
import qualified Data.ByteString.Char8 as S8
import Data.Char (toLower)
import qualified Data.Map as Map
import qualified Data.Text as T
import Data.Text.Read (decimal)
import Network.HTTP.Client.Request (applyBasicProxyAuth,
extractBasicAuthInfo)
import Network.HTTP.Client.Types (HttpExceptionContent (..),
Proxy (..), Request (..),
throwHttp)
import qualified Network.URI as U
import System.Environment (getEnvironment)
#if defined(mingw32_HOST_OS)
import Control.Exception (IOException, bracket, catch, try)
import Control.Monad (join, liftM, mplus, when)
import Data.List (isInfixOf, isPrefixOf)
import Foreign (Storable (peek, sizeOf), alloca,
castPtr, toBool)
import Network.URI (parseAbsoluteURI)
import Safe (readDef)
import System.IO
import System.Win32.Registry (hKEY_CURRENT_USER, rEG_DWORD,
regCloseKey, regOpenKey,
regQueryValue, regQueryValueEx)
import System.Win32.Types (DWORD, HKEY)
#endif
type EnvName = T.Text
type HostAddress = S8.ByteString
type UserName = S8.ByteString
type Password = S8.ByteString
-- There are other proxy protocols like SOCKS, FTP, etc.
data ProxyProtocol = HTTPProxy | HTTPSProxy
instance Show ProxyProtocol where
show HTTPProxy = "http"
show HTTPSProxy = "https"
data ProxySettings = ProxySettings { _proxyHost :: Proxy,
_proxyAuth :: Maybe (UserName, Password) }
deriving Show
httpProtocol :: Bool -> ProxyProtocol
httpProtocol True = HTTPSProxy
httpProtocol False = HTTPProxy
data EnvHelper = EHFromRequest
| EHNoProxy
| EHUseProxy Proxy
headJust :: [Maybe a] -> Maybe a
headJust [] = Nothing
headJust (Nothing:xs) = headJust xs
headJust ((y@(Just _)):_) = y
systemProxyHelper :: Maybe T.Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
systemProxyHelper envOveride prot eh = do
let envName' Nothing = envName prot
envName' (Just name) = name
modifier <- envHelper (envName' envOveride)
-- Under Windows try first env. variables override then Windows proxy settings
#if defined(mingw32_HOST_OS)
modifier' <- systemProxy prot
let modifiers = [modifier, modifier']
#else
let modifiers = [modifier]
#endif
let chooseMod :: Request -> Maybe ProxySettings
chooseMod req = headJust . map (\m -> m . host $ req) $ modifiers
noEnvProxy = case eh of
EHFromRequest -> id
EHNoProxy -> \req -> req { proxy = Nothing }
EHUseProxy p -> \req -> req { proxy = Just p }
let result req = toRequest . chooseMod $ req where
toRequest Nothing = noEnvProxy req
toRequest (Just (ProxySettings p muserpass)) = maybe id (uncurry applyBasicProxyAuth) muserpass
req { proxy = Just p }
return result
#if defined(mingw32_HOST_OS)
windowsProxyString :: ProxyProtocol -> IO (Maybe (String, String))
windowsProxyString proto = do
mProxy <- registryProxyString
return $ do
(proxies, exceptions) <- mProxy
protoProxy <- parseWindowsProxy proto proxies
return (protoProxy, exceptions)
registryProxyLoc :: (HKEY,String)
registryProxyLoc = (hive, path)
where
-- some sources say proxy settings should be at
-- HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows
-- \CurrentVersion\Internet Settings\ProxyServer
-- but if the user sets them with IE connection panel they seem to
-- end up in the following place:
hive = hKEY_CURRENT_USER
path = "Software\\Microsoft\\Windows\\CurrentVersion\\Internet Settings"
-- read proxy settings from the windows registry; this is just a best
-- effort and may not work on all setups.
registryProxyString :: IO (Maybe (String, String))
registryProxyString = catch
(bracket (uncurry regOpenKey registryProxyLoc) regCloseKey $ \hkey -> do
enable <- toBool . maybe 0 id A.<$> regQueryValueDWORD hkey "ProxyEnable"
if enable
then do
#if MIN_VERSION_Win32(2, 6, 0)
server <- regQueryValue hkey "ProxyServer"
exceptions <- try $ regQueryValue hkey "ProxyOverride" :: IO (Either IOException String)
#else
server <- regQueryValue hkey (Just "ProxyServer")
exceptions <- try $ regQueryValue hkey (Just "ProxyOverride") :: IO (Either IOException String)
#endif
return $ Just (server, either (const "") id exceptions)
else return Nothing)
hideError where
hideError :: IOException -> IO (Maybe (String, String))
hideError _ = return Nothing
-- the proxy string is in the format "http=x.x.x.x:yyyy;https=...;ftp=...;socks=..."
-- even though the following article indicates otherwise
-- https://support.microsoft.com/en-us/kb/819961
--
-- to be sure, parse strings where each entry in the ';'-separated list above is
-- either in the format "protocol=..." or "protocol://..."
parseWindowsProxy :: ProxyProtocol -> String -> Maybe String
parseWindowsProxy proto s =
case proxies of
x:_ -> Just x
_ -> Nothing
where
parts = split ';' s
pr x = case break (== '=') x of
(p, []) -> p -- might be in format http://
(p, u) -> p ++ "://" ++ drop 1 u
protoPrefix = (show proto) ++ "://"
proxies = filter (isPrefixOf protoPrefix) . map pr $ parts
split :: Eq a => a -> [a] -> [[a]]
split _ [] = []
split a xs = case break (a ==) xs of
(ys, []) -> [ys]
(ys, _:zs) -> ys:split a zs
-- Extract proxy settings from Windows registry. This is a standard way in Windows OS.
systemProxy :: ProxyProtocol -> IO (HostAddress -> Maybe ProxySettings)
systemProxy proto = do
let isURLlocal "127.0.0.1" = True
isURLlocal "localhost" = True
isURLlocal _ = False
hasLocal exceptions = "" `isInfixOf` exceptions
settings <- fetchProxy proto
return $ \url -> do
(proxy, exceptions) <- settings
-- Skip proxy for local hosts if it's enabled in IE settings
-- TODO Implement skipping for address patterns, like (*.google.com)
if (isURLlocal url && hasLocal exceptions) || (url `S8.isInfixOf` (S8.pack exceptions)) then Nothing
else Just proxy
-- | @fetchProxy flg@ gets the local proxy settings and parse the string
-- into a @Proxy@ value.
-- Proxy settings are sourced from IE/WinInet's proxy
-- setting in the Registry.
fetchProxy :: ProxyProtocol -> IO (Maybe (ProxySettings, String))
fetchProxy proto = do
mstr <- windowsProxyString proto
case mstr of
Nothing -> return Nothing
Just (proxy, except) -> case parseProxy proto proxy of
Just p -> return $ Just (p, except)
Nothing ->
throwHttp . InvalidProxySettings . T.pack . unlines $
[ "Invalid http proxy uri: " ++ show proxy
, "proxy uri must be http with a hostname"
, "ignoring http proxy, trying a direct connection"
]
-- | @parseProxy str@ translates a proxy server string into a @ProxySettings@ value;
-- returns @Nothing@ if not well-formed.
parseProxy :: ProxyProtocol -> String -> Maybe ProxySettings
parseProxy proto str = join
. fmap (uri2proxy proto)
$ parseHttpURI str
`mplus` parseHttpURI (protoPrefix ++ str)
where
protoPrefix = (show proto) ++ "://"
parseHttpURI str' =
case parseAbsoluteURI str' of
Just uri@U.URI{U.uriAuthority = Just{}} -> Just (fixUserInfo uri)
_ -> Nothing
-- Note: we need to be able to parse non-URIs like @\"wwwcache.example.com:80\"@
-- which lack the @\"http://\"@ URI scheme. The problem is that
-- @\"wwwcache.example.com:80\"@ is in fact a valid URI but with scheme
-- @\"wwwcache.example.com:\"@, no authority part and a path of @\"80\"@.
--
-- So our strategy is to try parsing as normal uri first and if it lacks the
-- 'uriAuthority' then we try parsing again with a @\"http://\"@ prefix.
--
-- | @dropWhileTail p ls@ chops off trailing elements from @ls@
-- until @p@ returns @False@.
dropWhileTail :: (a -> Bool) -> [a] -> [a]
dropWhileTail f ls =
case foldr chop Nothing ls of { Just xs -> xs; Nothing -> [] }
where
chop x (Just xs) = Just (x:xs)
chop x _
| f x = Nothing
| otherwise = Just [x]
-- | @chopAtDelim elt ls@ breaks up @ls@ into two at first occurrence
-- of @elt@; @elt@ is elided too. If @elt@ does not occur, the second
-- list is empty and the first is equal to @ls@.
chopAtDelim :: Eq a => a -> [a] -> ([a],[a])
chopAtDelim elt xs =
case break (==elt) xs of
(_,[]) -> (xs,[])
(as,_:bs) -> (as,bs)
-- | tidy up user portion, don't want the trailing "\@".
fixUserInfo :: U.URI -> U.URI
fixUserInfo uri = uri{ U.uriAuthority = f `fmap` U.uriAuthority uri }
where
f a@U.URIAuth{U.uriUserInfo=s} = a{U.uriUserInfo=dropWhileTail (=='@') s}
defaultHTTPport :: ProxyProtocol -> Int
defaultHTTPport HTTPProxy = 80
defaultHTTPport HTTPSProxy = 443
uri2proxy :: ProxyProtocol -> U.URI -> Maybe ProxySettings
uri2proxy proto uri@U.URI{ U.uriAuthority = Just (U.URIAuth auth' hst prt) } =
if (show proto ++ ":") == U.uriScheme uri then
Just (ProxySettings (Proxy (S8.pack hst) (port prt)) auth) else Nothing
where
port (':':xs) = readDef (defaultHTTPport proto) xs
port _ = (defaultHTTPport proto)
auth =
case auth' of
[] -> Nothing
as -> Just ((S8.pack . U.unEscapeString $ usr), (S8.pack . U.unEscapeString $ pwd))
where
(usr,pwd) = chopAtDelim ':' as
uri2proxy _ _ = Nothing
regQueryValueDWORD :: HKEY -> String -> IO (Maybe DWORD)
regQueryValueDWORD hkey name = alloca $ \ptr -> do
key <- regQueryValueEx hkey name (castPtr ptr) (sizeOf (undefined :: DWORD))
if key == rEG_DWORD then
Just A.<$> peek ptr
else return Nothing
-- defined(mingw32_HOST_OS)
#endif
envName :: ProxyProtocol -> EnvName
envName proto = T.pack $ show proto ++ "_proxy"
-- Extract proxy settings from environment variables. This is a standard way in Linux.
envHelper :: EnvName -> IO (HostAddress -> Maybe ProxySettings)
envHelper name = do
env <- getEnvironment
let lenv = Map.fromList $ map (first $ T.toLower . T.pack) env
lookupEnvVar n = lookup (T.unpack n) env A.<|> Map.lookup n lenv
noProxyDomains = domainSuffixes (lookupEnvVar "no_proxy")
case lookupEnvVar name of
Nothing -> return . const $ Nothing
Just "" -> return . const $ Nothing
Just str -> do
let invalid = throwHttp $ InvalidProxyEnvironmentVariable name (T.pack str)
(p, muserpass) <- maybe invalid return $ do
let allowedScheme x = x == "http:"
uri <- case U.parseURI str of
Just u | allowedScheme (U.uriScheme u) -> return u
_ -> U.parseURI $ "http://" ++ str
guard $ allowedScheme $ U.uriScheme uri
guard $ null (U.uriPath uri) || U.uriPath uri == "/"
guard $ null $ U.uriQuery uri
guard $ null $ U.uriFragment uri
auth <- U.uriAuthority uri
port' <-
case U.uriPort auth of
"" -> Just 80
':':rest ->
case decimal $ T.pack rest of
Right (p, "") -> Just p
_ -> Nothing
_ -> Nothing
Just (Proxy (S8.pack $ U.uriRegName auth) port', extractBasicAuthInfo uri)
return $ \hostRequest ->
if hostRequest `hasDomainSuffixIn` noProxyDomains
then Nothing
else Just $ ProxySettings p muserpass
where prefixed s | S8.head s == '.' = s
| otherwise = S8.cons '.' s
domainSuffixes Nothing = []
domainSuffixes (Just "") = []
domainSuffixes (Just no_proxy) = [prefixed $ S8.dropWhile (== ' ') suffix | suffix <- S8.split ',' (S8.pack (map toLower no_proxy)), not (S8.null suffix)]
hasDomainSuffixIn host' = any (`S8.isSuffixOf` prefixed (S8.map toLower host'))
http-client-0.5.14/publicsuffixlist/Network/PublicSuffixList/Lookup.hs 0000644 0000000 0000000 00000007726 12632352123 024331 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Network.PublicSuffixList.Lookup (effectiveTLDPlusOne, effectiveTLDPlusOne', isSuffix, isSuffix') where
import qualified Data.Map as M
import Data.Maybe (isNothing)
import qualified Data.Text as T
import qualified Network.PublicSuffixList.DataStructure as DS
import Network.PublicSuffixList.Types
{-|
OffEnd's Bool argument represents whether we fell off a
leaf or whether we fell off a non-leaf. True means that
we fell off a leaf. Its Text argument is the component
that pushed us off the end, along with all the components
to the right of that one, interspersed with "."s
-}
data LookupResult = Inside | AtLeaf | OffEnd Bool T.Text
deriving (Eq)
{-|
This function returns whether or not this domain is owned by a
registrar or a regular person. 'Nothing' means that this is a registrar
domain; 'Just x' means it's owned by a person. This is used to determine
if a cookie is allowed to bet set for a particular domain. For
example, you shouldn't be able to set a cookie for \"com\".
If the value is 'Just x', then the x value is what is known as the
effective TLD plus one. This is one segment more than the suffix of the
domain. For example, the eTLD+1 for "this.is.a.subdom.com" is Just
"subdom.com"
Note that this function expects lowercase ASCII strings. These strings
should be gotten from the toASCII algorithm as described in RFC 3490.
These strings should not start or end with the \'.\' character, and should
not have two \'.\' characters next to each other.
(The toASCII algorithm is implemented in the \'idna\' hackage package,
though that package doesn't always map strings to lowercase)
-}
effectiveTLDPlusOne' :: DataStructure -> T.Text -> Maybe T.Text
effectiveTLDPlusOne' dataStructure s
-- Any TLD is a suffix
| length ss == 1 = Nothing
| otherwise = output rulesResult exceptionResult
where ss = T.splitOn "." s
ps = reverse ss
exceptionResult = recurse ps [] $ snd dataStructure
rulesResult = recurse ps [] $ fst dataStructure
-- If we fell off, did we do it at a leaf? Otherwise, what's the
-- subtree that we're at
getNext :: Tree T.Text -> T.Text -> Either Bool (Tree T.Text)
getNext t s' = case M.lookup s' $ children t of
Nothing -> Left (M.null $ children t)
Just t' -> Right t'
-- Look up the component we're looking for...
getNextWithStar t s' = case getNext t s' of
-- and if that fails, look up "*"
Left _ -> getNext t "*"
r -> r
recurse :: [T.Text] -> [T.Text] -> Tree T.Text -> LookupResult
recurse [] _ t
| M.null $ children t = AtLeaf
| otherwise = Inside
recurse (c : cs) prev t = case getNextWithStar t c of
Left b -> OffEnd b $ T.intercalate "." (c : prev)
Right t' -> recurse cs (c : prev) t'
-- Only match against the exception rules if we have a full match
output _ AtLeaf = Just s
output _ (OffEnd True x) = Just $ T.intercalate "." $ tail $ T.splitOn "." x
-- If we have a subdomain on an existing rule, we're not a suffix
output (OffEnd _ x) _
-- A single level domain can never be a eTLD+1
| isNothing $ T.find (== '.') x = Just $ T.intercalate "." $ drop (length ss - 2) ss
| otherwise = Just x
-- Otherwise, we're a suffix of a suffix, which is a suffix
output _ _ = Nothing
-- | >>> effectiveTLDPlusOne = effectiveTLDPlusOne' Network.PublicSuffixList.DataStructure.dataStructure
effectiveTLDPlusOne :: T.Text -> Maybe T.Text
effectiveTLDPlusOne = effectiveTLDPlusOne' DS.dataStructure
-- | >>> isSuffix' dataStructure = isNothing . effectiveTLDPlusOne' dataStructure
isSuffix' :: DataStructure -> T.Text -> Bool
isSuffix' dataStructure = isNothing . effectiveTLDPlusOne' dataStructure
-- | >>> isSuffix = isSuffix' Network.PublicSuffixList.DataStructure.dataStructure
isSuffix :: T.Text -> Bool
isSuffix = isNothing . effectiveTLDPlusOne
http-client-0.5.14/publicsuffixlist/Network/PublicSuffixList/Types.hs 0000644 0000000 0000000 00000000714 12632352123 024152 0 ustar 00 0000000 0000000 {-|
This module is only exported for the use of the 'publicsuffixlistcreate' package.
Every one else should consider everything in this file to be opaque.
-}
module Network.PublicSuffixList.Types where
import qualified Data.Map as M
import qualified Data.Text as T
newtype Tree e = Node { children :: M.Map e (Tree e) }
deriving (Show, Eq)
def :: Ord e => Tree e
def = Node M.empty
type DataStructure = (Tree T.Text, Tree T.Text)
http-client-0.5.14/publicsuffixlist/Network/PublicSuffixList/Serialize.hs 0000644 0000000 0000000 00000003715 13025776351 025013 0 ustar 00 0000000 0000000 module Network.PublicSuffixList.Serialize (getDataStructure, putDataStructure) where
import Blaze.ByteString.Builder (Builder, fromWord8,
toByteString)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
import qualified Data.ByteString as BS
import Data.Foldable (foldMap)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid (mappend)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Network.PublicSuffixList.Types
getTree :: BS.ByteString -> (Tree T.Text, BS.ByteString)
getTree =
loop Map.empty
where
loop m bs
| BS.null bs = (Node m, bs)
| BS.head bs == 0 = (Node m, BS.drop 1 bs)
| otherwise =
let (k, v, bs') = getPair bs
in loop (Map.insert k v m) bs'
getPair :: BS.ByteString -> (T.Text, Tree T.Text, BS.ByteString)
getPair bs0 =
(k, v, bs2)
where
(k, bs1) = getText bs0
(v, bs2) = getTree bs1
getText :: BS.ByteString -> (T.Text, BS.ByteString)
getText bs0 =
(TE.decodeUtf8 v, BS.drop 1 bs1)
where
(v, bs1) = BS.break (== 0) bs0
getDataStructure :: BS.ByteString -> DataStructure
getDataStructure bs0 =
(x, y)
where
(x, bs1) = getTree bs0
(y, _) = getTree bs1
putTree :: Tree T.Text -> Builder
putTree = putMap . children
putMap :: Map T.Text (Tree T.Text) -> Builder
putMap m = Data.Foldable.foldMap putPair (Map.toList m) `mappend` fromWord8 0
putPair :: (T.Text, Tree T.Text) -> Builder
putPair (x, y) = putText x `mappend` putTree y
putText :: T.Text -> Builder
putText t = fromText t `Data.Monoid.mappend` fromWord8 0
putDataStructure :: DataStructure -> BS.ByteString
putDataStructure (x, y) = toByteString $ putTree x `mappend` putTree y
http-client-0.5.14/publicsuffixlist/Network/PublicSuffixList/DataStructure.hs 0000644 0000000 0000000 00000316150 12632352123 025644 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
-- DO NOT MODIFY! This file has been automatically generated from the Create.hs script at 2015-04-29 04:59:31.367899 UTC
module Network.PublicSuffixList.DataStructure (dataStructure) where
import Data.ByteString.Char8 ()
import Network.PublicSuffixList.Types
#if !defined(RUNTIMELIST)
import qualified Data.ByteString as BS
import Network.PublicSuffixList.Serialize
#else
import qualified Network.PublicSuffixList.Create as PSLC
import qualified Data.Conduit as C
import Data.Conduit.Binary (sourceFile)
import System.IO.Unsafe (unsafePerformIO)
#endif
-- We could just put the raw data structure here, but if we do that, there will be lots of
-- static string literals, which makes GHC really slow when compiling. Instead, we can manually
-- serialize the datastructure ourself, so there's only one string literal.
{-|
The opaque data structure that 'isSuffix' can query. This data structure was generated at 2015-04-29 04:59:31.367899 UTC
-}
dataStructure :: DataStructure
#if defined(RUNTIMELIST)
{-# NOINLINE dataStructure #-}
dataStructure = unsafePerformIO $ C.runResourceT $ sourceFile RUNTIMELIST C.$$ PSLC.sink
#else
dataStructure = getDataStructure serializedDataStructure
serializedDataStructure :: BS.ByteString
serializedDataStructure = "aaa\NUL\NULabb\NUL\NULabbott\NUL\NULabogado\NUL\NULac\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULacademy\NUL\NULaccenture\NUL\NULaccountant\NUL\NULaccountants\NUL\NULaco\NUL\NULactive\NUL\NULactor\NUL\NULad\NULnom\NUL\NUL\NULads\NUL\NULadult\NUL\NULae\NULac\NUL\NULblogspot\NUL\NULco\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NUL\NULaeg\NUL\NULaero\NULaccident-investigation\NUL\NULaccident-prevention\NUL\NULaerobatic\NUL\NULaeroclub\NUL\NULaerodrome\NUL\NULagents\NUL\NULair-surveillance\NUL\NULair-traffic-control\NUL\NULaircraft\NUL\NULairline\NUL\NULairport\NUL\NULairtraffic\NUL\NULambulance\NUL\NULamusement\NUL\NULassociation\NUL\NULauthor\NUL\NULballooning\NUL\NULbroker\NUL\NULcaa\NUL\NULcargo\NUL\NULcatering\NUL\NULcertification\NUL\NULchampionship\NUL\NULcharter\NUL\NULcivilaviation\NUL\NULclub\NUL\NULconference\NUL\NULconsultant\NUL\NULconsulting\NUL\NULcontrol\NUL\NULcouncil\NUL\NULcrew\NUL\NULdesign\NUL\NULdgca\NUL\NULeducator\NUL\NULemergency\NUL\NULengine\NUL\NULengineer\NUL\NULentertainment\NUL\NULequipment\NUL\NULexchange\NUL\NULexpress\NUL\NULfederation\NUL\NULflight\NUL\NULfreight\NUL\NULfuel\NUL\NULgliding\NUL\NULgovernment\NUL\NULgroundhandling\NUL\NULgroup\NUL\NULhanggliding\NUL\NULhomebuilt\NUL\NULinsurance\NUL\NULjournal\NUL\NULjournalist\NUL\NULleasing\NUL\NULlogistics\NUL\NULmagazine\NUL\NULmaintenance\NUL\NULmarketplace\NUL\NULmedia\NUL\NULmicrolight\NUL\NULmodelling\NUL\NULnavigation\NUL\NULparachuting\NUL\NULparagliding\NUL\NULpassenger-association\NUL\NULpilot\NUL\NULpress\NUL\NULproduction\NUL\NULrecreation\NUL\NULrepbody\NUL\NULres\NUL\NULresearch\NUL\NULrotorcraft\NUL\NULsafety\NUL\NULscientist\NUL\NULservices\NUL\NULshow\NUL\NULskydiving\NUL\NULsoftware\NUL\NULstudent\NUL\NULtaxi\NUL\NULtrader\NUL\NULtrading\NUL\NULtrainer\NUL\NULunion\NUL\NULworkinggroup\NUL\NULworks\NUL\NUL\NULaf\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULafl\NUL\NULafrica\NUL\NULafricamagic\NUL\NULag\NULco\NUL\NULcom\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NUL\NULagency\NUL\NULai\NULcom\NUL\NULnet\NUL\NULoff\NUL\NULorg\NUL\NUL\NULaig\NUL\NULairforce\NUL\NULairtel\NUL\NULal\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULalibaba\NUL\NULalipay\NUL\NULallfinanz\NUL\NULalsace\NUL\NULam\NUL\NULamsterdam\NUL\NULan\NULcom\NUL\NULedu\NUL\NULnet\NUL\NULorg\NUL\NUL\NULanalytics\NUL\NULandroid\NUL\NULanquan\NUL\NULao\NULco\NUL\NULed\NUL\NULgv\NUL\NULit\NUL\NULog\NUL\NULpb\NUL\NUL\NULapartments\NUL\NULaq\NUL\NULaquarelle\NUL\NULar\NULcom\NULblogspot\NUL\NUL\NULedu\NUL\NULgob\NUL\NULgov\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULtur\NUL\NUL\NULaramco\NUL\NULarchi\NUL\NULarmy\NUL\NULarpa\NULe164\NUL\NULin-addr\NUL\NULip6\NUL\NULiris\NUL\NULuri\NUL\NULurn\NUL\NUL\NULarte\NUL\NULas\NULgov\NUL\NUL\NULasia\NUL\NULassociates\NUL\NULat\NULac\NUL\NULbiz\NUL\NULco\NULblogspot\NUL\NUL\NULgv\NUL\NULinfo\NUL\NULor\NUL\NULpriv\NUL\NUL\NULattorney\NUL\NULau\NULact\NUL\NULasn\NUL\NULcom\NULblogspot\NUL\NUL\NULconf\NUL\NULedu\NULact\NUL\NULnsw\NUL\NULnt\NUL\NULqld\NUL\NULsa\NUL\NULtas\NUL\NULvic\NUL\NULwa\NUL\NUL\NULgov\NULqld\NUL\NULsa\NUL\NULtas\NUL\NULvic\NUL\NULwa\NUL\NUL\NULid\NUL\NULinfo\NUL\NULnet\NUL\NULnsw\NUL\NULnt\NUL\NULorg\NUL\NULoz\NUL\NULqld\NUL\NULsa\NUL\NULtas\NUL\NULvic\NUL\NULwa\NUL\NUL\NULauction\NUL\NULaudio\NUL\NULauthor\NUL\NULauto\NUL\NULautos\NUL\NULavianca\NUL\NULaw\NULcom\NUL\NUL\NULax\NUL\NULaxa\NUL\NULaz\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpp\NUL\NULpro\NUL\NUL\NULazure\NUL\NULba\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULrs\NUL\NULunbi\NUL\NULunsa\NUL\NUL\NULbaidu\NUL\NULband\NUL\NULbank\NUL\NULbar\NUL\NULbarcelona\NUL\NULbarclaycard\NUL\NULbarclays\NUL\NULbargains\NUL\NULbauhaus\NUL\NULbayern\NUL\NULbb\NULbiz\NUL\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULnet\NUL\NULorg\NUL\NULstore\NUL\NULtv\NUL\NUL\NULbbc\NUL\NULbbva\NUL\NULbcg\NUL\NULbcn\NUL\NULbd\NUL*\NUL\NUL\NULbe\NULac\NUL\NULblogspot\NUL\NUL\NULbeer\NUL\NULbentley\NUL\NULberlin\NUL\NULbest\NUL\NULbf\NULgov\NUL\NUL\NULbg\NUL0\NUL\NUL1\NUL\NUL2\NUL\NUL3\NUL\NUL4\NUL\NUL5\NUL\NUL6\NUL\NUL7\NUL\NUL8\NUL\NUL9\NUL\NULa\NUL\NULb\NUL\NULc\NUL\NULd\NUL\NULe\NUL\NULf\NUL\NULg\NUL\NULh\NUL\NULi\NUL\NULj\NUL\NULk\NUL\NULl\NUL\NULm\NUL\NULn\NUL\NULo\NUL\NULp\NUL\NULq\NUL\NULr\NUL\NULs\NUL\NULt\NUL\NULu\NUL\NULv\NUL\NULw\NUL\NULx\NUL\NULy\NUL\NULz\NUL\NUL\NULbh\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULbharti\NUL\NULbi\NULco\NUL\NULcom\NUL\NULedu\NUL\NULor\NUL\NULorg\NUL\NUL\NULbible\NUL\NULbid\NUL\NULbike\NUL\NULbing\NUL\NULbingo\NUL\NULbio\NUL\NULbiz\NULdyndns\NUL\NULfor-better\NUL\NULfor-more\NUL\NULfor-some\NUL\NULfor-the\NUL\NULselfip\NUL\NULwebhop\NUL\NUL\NULbj\NULasso\NUL\NULbarreau\NUL\NULblogspot\NUL\NULgouv\NUL\NUL\NULblack\NUL\NULblackfriday\NUL\NULbloomberg\NUL\NULblue\NUL\NULbm\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULbms\NUL\NULbmw\NUL\NULbn\NUL*\NUL\NUL\NULbnl\NUL\NULbnpparibas\NUL\NULbo\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULgov\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULtv\NUL\NUL\NULboats\NUL\NULbom\NUL\NULbond\NUL\NULboo\NUL\NULboots\NUL\NULbot\NUL\NULboutique\NUL\NULbr\NULadm\NUL\NULadv\NUL\NULagr\NUL\NULam\NUL\NULarq\NUL\NULart\NUL\NULato\NUL\NULb\NUL\NULbio\NUL\NULblog\NUL\NULbmd\NUL\NULcim\NUL\NULcng\NUL\NULcnt\NUL\NULcom\NULblogspot\NUL\NUL\NULcoop\NUL\NULecn\NUL\NULeco\NUL\NULedu\NUL\NULemp\NUL\NULeng\NUL\NULesp\NUL\NULetc\NUL\NULeti\NUL\NULfar\NUL\NULflog\NUL\NULfm\NUL\NULfnd\NUL\NULfot\NUL\NULfst\NUL\NULg12\NUL\NULggf\NUL\NULgov\NUL\NULimb\NUL\NULind\NUL\NULinf\NUL\NULjor\NUL\NULjus\NUL\NULleg\NUL\NULlel\NUL\NULmat\NUL\NULmed\NUL\NULmil\NUL\NULmp\NUL\NULmus\NUL\NULnet\NUL\NULnom\NUL*\NUL\NUL\NULnot\NUL\NULntr\NUL\NULodo\NUL\NULorg\NUL\NULppg\NUL\NULpro\NUL\NULpsc\NUL\NULpsi\NUL\NULqsl\NUL\NULradio\NUL\NULrec\NUL\NULslg\NUL\NULsrv\NUL\NULtaxi\NUL\NULteo\NUL\NULtmp\NUL\NULtrd\NUL\NULtur\NUL\NULtv\NUL\NULvet\NUL\NULvlog\NUL\NULwiki\NUL\NULzlg\NUL\NUL\NULbradesco\NUL\NULbridgestone\NUL\NULbroadway\NUL\NULbroker\NUL\NULbrother\NUL\NULbrussels\NUL\NULbs\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULbt\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULbudapest\NUL\NULbuild\NUL\NULbuilders\NUL\NULbusiness\NUL\NULbuy\NUL\NULbuzz\NUL\NULbv\NUL\NULbw\NULco\NUL\NULorg\NUL\NUL\NULby\NULcom\NUL\NULgov\NUL\NULmil\NUL\NULof\NUL\NUL\NULbz\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULza\NUL\NUL\NULbzh\NUL\NULca\NULab\NUL\NULbc\NUL\NULblogspot\NUL\NULco\NUL\NULgc\NUL\NULmb\NUL\NULnb\NUL\NULnf\NUL\NULnl\NUL\NULns\NUL\NULnt\NUL\NULnu\NUL\NULon\NUL\NULpe\NUL\NULqc\NUL\NULsk\NUL\NULyk\NUL\NUL\NULcab\NUL\NULcafe\NUL\NULcal\NUL\NULcall\NUL\NULcamera\NUL\NULcamp\NUL\NULcancerresearch\NUL\NULcanon\NUL\NULcapetown\NUL\NULcapital\NUL\NULcar\NUL\NULcaravan\NUL\NULcards\NUL\NULcare\NUL\NULcareer\NUL\NULcareers\NUL\NULcars\NUL\NULcartier\NUL\NULcasa\NUL\NULcash\NUL\NULcasino\NUL\NULcat\NUL\NULcatering\NUL\NULcba\NUL\NULcbn\NUL\NULcc\NULftpaccess\NUL\NULgame-server\NUL\NULmyphotos\NUL\NULscrapping\NUL\NUL\NULcd\NULgov\NUL\NUL\NULcenter\NUL\NULceo\NUL\NULcern\NUL\NULcf\NULblogspot\NUL\NUL\NULcfa\NUL\NULcfd\NUL\NULcg\NUL\NULch\NULblogspot\NUL\NUL\NULchannel\NUL\NULchat\NUL\NULcheap\NUL\NULchloe\NUL\NULchristmas\NUL\NULchrome\NUL\NULchurch\NUL\NULci\NULac\NUL\NULasso\NUL\NULco\NUL\NULcom\NUL\NULed\NUL\NULedu\NUL\NULgo\NUL\NULgouv\NUL\NULint\NUL\NULmd\NUL\NULnet\NUL\NULor\NUL\NULorg\NUL\NULpresse\NUL\NULxn--aroport-bya\NUL\NUL\NULcipriani\NUL\NULcircle\NUL\NULcisco\NUL\NULcitic\NUL\NULcity\NUL\NULcityeats\NUL\NULck\NUL*\NUL\NUL\NULcl\NULco\NUL\NULgob\NUL\NULgov\NUL\NULmil\NUL\NUL\NULclaims\NUL\NULcleaning\NUL\NULclick\NUL\NULclinic\NUL\NULclothing\NUL\NULclub\NUL\NULcm\NULco\NUL\NULcom\NUL\NULgov\NUL\NULnet\NUL\NUL\NULcn\NULac\NUL\NULah\NUL\NULamazonaws\NULcompute\NUL\NUL\NULbj\NUL\NULcom\NUL\NULcq\NUL\NULedu\NUL\NULfj\NUL\NULgd\NUL\NULgov\NUL\NULgs\NUL\NULgx\NUL\NULgz\NUL\NULha\NUL\NULhb\NUL\NULhe\NUL\NULhi\NUL\NULhk\NUL\NULhl\NUL\NULhn\NUL\NULjl\NUL\NULjs\NUL\NULjx\NUL\NULln\NUL\NULmil\NUL\NULmo\NUL\NULnet\NUL\NULnm\NUL\NULnx\NUL\NULorg\NUL\NULqh\NUL\NULsc\NUL\NULsd\NUL\NULsh\NUL\NULsn\NUL\NULsx\NUL\NULtj\NUL\NULtw\NUL\NULxj\NUL\NULxn--55qx5d\NUL\NULxn--io0a7i\NUL\NULxn--od0alg\NUL\NULxz\NUL\NULyn\NUL\NULzj\NUL\NUL\NULco\NULarts\NUL\NULcom\NUL\NULedu\NUL\NULfirm\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NULrec\NUL\NULweb\NUL\NUL\NULcoach\NUL\NULcodes\NUL\NULcoffee\NUL\NULcollege\NUL\NULcologne\NUL\NULcom\NUL1kapp\NUL\NULafrica\NUL\NULamazonaws\NULcompute\NULeu-central-1\NUL\NULeu-west-1\NUL\NULsa-east-1\NUL\NULus-gov-west-1\NUL\NULus-west-1\NUL\NULus-west-2\NUL\NUL\NULcompute-1\NULz-1\NUL\NULz-2\NUL\NUL\NULelb\NUL\NULs3\NUL\NULs3-ap-northeast-1\NUL\NULs3-ap-southeast-1\NUL\NULs3-ap-southeast-2\NUL\NULs3-eu-west-1\NUL\NULs3-fips-us-gov-west-1\NUL\NULs3-sa-east-1\NUL\NULs3-us-gov-west-1\NUL\NULs3-us-west-1\NUL\NULs3-us-west-2\NUL\NULs3-website-ap-northeast-1\NUL\NULs3-website-ap-southeast-1\NUL\NULs3-website-ap-southeast-2\NUL\NULs3-website-eu-west-1\NUL\NULs3-website-sa-east-1\NUL\NULs3-website-us-east-1\NUL\NULs3-website-us-gov-west-1\NUL\NULs3-website-us-west-1\NUL\NULs3-website-us-west-2\NUL\NULus-east-1\NUL\NUL\NULappspot\NUL\NULar\NUL\NULbetainabox\NUL\NULblogdns\NUL\NULblogspot\NUL\NULbr\NUL\NULcechire\NUL\NULcloudcontrolapp\NUL\NULcloudcontrolled\NUL\NULcn\NUL\NULco\NUL\NULcodespot\NUL\NULde\NUL\NULdnsalias\NUL\NULdnsdojo\NUL\NULdoesntexist\NUL\NULdontexist\NUL\NULdoomdns\NUL\NULdreamhosters\NUL\NULdyn-o-saur\NUL\NULdynalias\NUL\NULdyndns-at-home\NUL\NULdyndns-at-work\NUL\NULdyndns-blog\NUL\NULdyndns-free\NUL\NULdyndns-home\NUL\NULdyndns-ip\NUL\NULdyndns-mail\NUL\NULdyndns-office\NUL\NULdyndns-pics\NUL\NULdyndns-remote\NUL\NULdyndns-server\NUL\NULdyndns-web\NUL\NULdyndns-wiki\NUL\NULdyndns-work\NUL\NULelasticbeanstalk\NUL\NULest-a-la-maison\NUL\NULest-a-la-masion\NUL\NULest-le-patron\NUL\NULest-mon-blogueur\NUL\NULeu\NUL\NULfirebaseapp\NUL\NULflynnhub\NUL\NULfrom-ak\NUL\NULfrom-al\NUL\NULfrom-ar\NUL\NULfrom-ca\NUL\NULfrom-ct\NUL\NULfrom-dc\NUL\NULfrom-de\NUL\NULfrom-fl\NUL\NULfrom-ga\NUL\NULfrom-hi\NUL\NULfrom-ia\NUL\NULfrom-id\NUL\NULfrom-il\NUL\NULfrom-in\NUL\NULfrom-ks\NUL\NULfrom-ky\NUL\NULfrom-ma\NUL\NULfrom-md\NUL\NULfrom-mi\NUL\NULfrom-mn\NUL\NULfrom-mo\NUL\NULfrom-ms\NUL\NULfrom-mt\NUL\NULfrom-nc\NUL\NULfrom-nd\NUL\NULfrom-ne\NUL\NULfrom-nh\NUL\NULfrom-nj\NUL\NULfrom-nm\NUL\NULfrom-nv\NUL\NULfrom-oh\NUL\NULfrom-ok\NUL\NULfrom-or\NUL\NULfrom-pa\NUL\NULfrom-pr\NUL\NULfrom-ri\NUL\NULfrom-sc\NUL\NULfrom-sd\NUL\NULfrom-tn\NUL\NULfrom-tx\NUL\NULfrom-ut\NUL\NULfrom-va\NUL\NULfrom-vt\NUL\NULfrom-wa\NUL\NULfrom-wi\NUL\NULfrom-wv\NUL\NULfrom-wy\NUL\NULgb\NUL\NULgetmyip\NUL\NULgithubusercontent\NUL\NULgoogleapis\NUL\NULgooglecode\NUL\NULgotdns\NUL\NULgr\NUL\NULherokuapp\NUL\NULherokussl\NUL\NULhk\NUL\NULhobby-site\NUL\NULhomelinux\NUL\NULhomeunix\NUL\NULhu\NUL\NULiamallama\NUL\NULis-a-anarchist\NUL\NULis-a-blogger\NUL\NULis-a-bookkeeper\NUL\NULis-a-bulls-fan\NUL\NULis-a-caterer\NUL\NULis-a-chef\NUL\NULis-a-conservative\NUL\NULis-a-cpa\NUL\NULis-a-cubicle-slave\NUL\NULis-a-democrat\NUL\NULis-a-designer\NUL\NULis-a-doctor\NUL\NULis-a-financialadvisor\NUL\NULis-a-geek\NUL\NULis-a-green\NUL\NULis-a-guru\NUL\NULis-a-hard-worker\NUL\NULis-a-hunter\NUL\NULis-a-landscaper\NUL\NULis-a-lawyer\NUL\NULis-a-liberal\NUL\NULis-a-libertarian\NUL\NULis-a-llama\NUL\NULis-a-musician\NUL\NULis-a-nascarfan\NUL\NULis-a-nurse\NUL\NULis-a-painter\NUL\NULis-a-personaltrainer\NUL\NULis-a-photographer\NUL\NULis-a-player\NUL\NULis-a-republican\NUL\NULis-a-rockstar\NUL\NULis-a-socialist\NUL\NULis-a-student\NUL\NULis-a-teacher\NUL\NULis-a-techie\NUL\NULis-a-therapist\NUL\NULis-an-accountant\NUL\NULis-an-actor\NUL\NULis-an-actress\NUL\NULis-an-anarchist\NUL\NULis-an-artist\NUL\NULis-an-engineer\NUL\NULis-an-entertainer\NUL\NULis-certified\NUL\NULis-gone\NUL\NULis-into-anime\NUL\NULis-into-cars\NUL\NULis-into-cartoons\NUL\NULis-into-games\NUL\NULis-leet\NUL\NULis-not-certified\NUL\NULis-slick\NUL\NULis-uberleet\NUL\NULis-with-theband\NUL\NULisa-geek\NUL\NULisa-hockeynut\NUL\NULissmarterthanyou\NUL\NULjpn\NUL\NULkr\NUL\NULlikes-pie\NUL\NULlikescandy\NUL\NULmex\NUL\NULneat-url\NUL\NULnfshost\NUL\NULno\NUL\NULoperaunite\NUL\NULoutsystemscloud\NUL\NULpagespeedmobilizer\NUL\NULqc\NUL\NULrhcloud\NUL\NULro\NUL\NULru\NUL\NULsa\NUL\NULsaves-the-whales\NUL\NULse\NUL\NULselfip\NUL\NULsells-for-less\NUL\NULsells-for-u\NUL\NULservebbs\NUL\NULsimple-url\NUL\NULsinaapp\NUL\NULspace-to-rent\NUL\NULteaches-yoga\NUL\NULuk\NUL\NULus\NUL\NULuy\NUL\NULvipsinaapp\NUL\NULwithgoogle\NUL\NULwritesthisblog\NUL\NULyolasite\NUL\NULza\NUL\NUL\NULcommbank\NUL\NULcommunity\NUL\NULcompany\NUL\NULcomputer\NUL\NULcomsec\NUL\NULcondos\NUL\NULconstruction\NUL\NULconsulting\NUL\NULcontact\NUL\NULcontractors\NUL\NULcooking\NUL\NULcool\NUL\NULcoop\NUL\NULcorsica\NUL\NULcountry\NUL\NULcoupon\NUL\NULcoupons\NUL\NULcourses\NUL\NULcr\NULac\NUL\NULco\NUL\NULed\NUL\NULfi\NUL\NULgo\NUL\NULor\NUL\NULsa\NUL\NUL\NULcredit\NUL\NULcreditcard\NUL\NULcreditunion\NUL\NULcricket\NUL\NULcrown\NUL\NULcrs\NUL\NULcruises\NUL\NULcsc\NUL\NULcu\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinf\NUL\NULnet\NUL\NULorg\NUL\NUL\NULcuisinella\NUL\NULcv\NULblogspot\NUL\NUL\NULcw\NULcom\NUL\NULedu\NUL\NULnet\NUL\NULorg\NUL\NUL\NULcx\NULath\NUL\NULgov\NUL\NUL\NULcy\NUL*\NUL\NUL\NULcymru\NUL\NULcyou\NUL\NULcz\NULblogspot\NUL\NUL\NULdabur\NUL\NULdad\NUL\NULdance\NUL\NULdate\NUL\NULdating\NUL\NULdatsun\NUL\NULday\NUL\NULdclk\NUL\NULde\NULblogspot\NUL\NULcom\NUL\NULfuettertdasnetz\NUL\NUListeingeek\NUL\NUListmein\NUL\NULlebtimnetz\NUL\NULleitungsen\NUL\NULtraeumtgerade\NUL\NUL\NULdealer\NUL\NULdeals\NUL\NULdegree\NUL\NULdelivery\NUL\NULdell\NUL\NULdelta\NUL\NULdemocrat\NUL\NULdental\NUL\NULdentist\NUL\NULdesi\NUL\NULdesign\NUL\NULdev\NUL\NULdiamonds\NUL\NULdiet\NUL\NULdigital\NUL\NULdirect\NUL\NULdirectory\NUL\NULdiscount\NUL\NULdj\NUL\NULdk\NULblogspot\NUL\NUL\NULdm\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULdnp\NUL\NULdo\NULart\NUL\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULsld\NUL\NULweb\NUL\NUL\NULdocs\NUL\NULdog\NUL\NULdoha\NUL\NULdomains\NUL\NULdoosan\NUL\NULdownload\NUL\NULdrive\NUL\NULdstv\NUL\NULdubai\NUL\NULdurban\NUL\NULdvag\NUL\NULdz\NULart\NUL\NULasso\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULpol\NUL\NUL\NULearth\NUL\NULeat\NUL\NULec\NULcom\NUL\NULedu\NUL\NULfin\NUL\NULgob\NUL\NULgov\NUL\NULinfo\NUL\NULk12\NUL\NULmed\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NUL\NULedeka\NUL\NULedu\NUL\NULeducation\NUL\NULee\NULaip\NUL\NULcom\NUL\NULedu\NUL\NULfie\NUL\NULgov\NUL\NULlib\NUL\NULmed\NUL\NULorg\NUL\NULpri\NUL\NULriik\NUL\NUL\NULeg\NULcom\NUL\NULedu\NUL\NULeun\NUL\NULgov\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULsci\NUL\NUL\NULemail\NUL\NULemerck\NUL\NULenergy\NUL\NULengineer\NUL\NULengineering\NUL\NULenterprises\NUL\NULepson\NUL\NULequipment\NUL\NULer\NUL*\NUL\NUL\NULerni\NUL\NULes\NULcom\NULblogspot\NUL\NUL\NULedu\NUL\NULgob\NUL\NULnom\NUL\NULorg\NUL\NUL\NULesq\NUL\NULestate\NUL\NULet\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULname\NUL\NULorg\NUL\NUL\NULeu\NUL\NULeurovision\NUL\NULeus\NUL\NULevents\NUL\NULeverbank\NUL\NULexchange\NUL\NULexpert\NUL\NULexposed\NUL\NULexpress\NUL\NULfage\NUL\NULfail\NUL\NULfairwinds\NUL\NULfaith\NUL\NULfamily\NUL\NULfan\NUL\NULfans\NUL\NULfarm\NUL\NULfashion\NUL\NULfast\NUL\NULfeedback\NUL\NULferrero\NUL\NULfi\NULaland\NUL\NULblogspot\NUL\NULiki\NUL\NUL\NULfilm\NUL\NULfinal\NUL\NULfinance\NUL\NULfinancial\NUL\NULfirestone\NUL\NULfirmdale\NUL\NULfish\NUL\NULfishing\NUL\NULfit\NUL\NULfitness\NUL\NULfj\NUL*\NUL\NUL\NULfk\NUL*\NUL\NUL\NULflickr\NUL\NULflights\NUL\NULflorist\NUL\NULflowers\NUL\NULflsmidth\NUL\NULfly\NUL\NULfm\NUL\NULfo\NUL\NULfoo\NUL\NULfootball\NUL\NULford\NUL\NULforex\NUL\NULforsale\NUL\NULforum\NUL\NULfoundation\NUL\NULfr\NULaeroport\NUL\NULassedic\NUL\NULasso\NUL\NULavocat\NUL\NULavoues\NUL\NULblogspot\NUL\NULcci\NUL\NULchambagri\NUL\NULchirurgiens-dentistes\NUL\NULcom\NUL\NULexperts-comptables\NUL\NULgeometre-expert\NUL\NULgouv\NUL\NULgreta\NUL\NULhuissier-justice\NUL\NULmedecin\NUL\NULnom\NUL\NULnotaires\NUL\NULpharmacien\NUL\NULport\NUL\NULprd\NUL\NULpresse\NUL\NULtm\NUL\NULveterinaire\NUL\NUL\NULfrl\NUL\NULfrogans\NUL\NULfrontier\NUL\NULfund\NUL\NULfurniture\NUL\NULfutbol\NUL\NULfyi\NUL\NULga\NUL\NULgal\NUL\NULgallery\NUL\NULgallup\NUL\NULgarden\NUL\NULgb\NUL\NULgbiz\NUL\NULgd\NUL\NULgdn\NUL\NULge\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULpvt\NUL\NUL\NULgea\NUL\NULgent\NUL\NULgenting\NUL\NULgf\NUL\NULgg\NULco\NUL\NULnet\NUL\NULorg\NUL\NUL\NULggee\NUL\NULgh\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULorg\NUL\NUL\NULgi\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULltd\NUL\NULmod\NUL\NULorg\NUL\NUL\NULgift\NUL\NULgifts\NUL\NULgives\NUL\NULgiving\NUL\NULgl\NUL\NULglass\NUL\NULgle\NUL\NULglobal\NUL\NULglobo\NUL\NULgm\NUL\NULgmail\NUL\NULgmo\NUL\NULgmx\NUL\NULgn\NULac\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULgold\NUL\NULgoldpoint\NUL\NULgolf\NUL\NULgoo\NUL\NULgoog\NUL\NULgoogle\NUL\NULgop\NUL\NULgot\NUL\NULgotv\NUL\NULgov\NUL\NULgp\NULasso\NUL\NULcom\NUL\NULedu\NUL\NULmobi\NUL\NULnet\NUL\NULorg\NUL\NUL\NULgq\NUL\NULgr\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULgraphics\NUL\NULgratis\NUL\NULgreen\NUL\NULgripe\NUL\NULgroup\NUL\NULgs\NUL\NULgt\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULind\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULgu\NUL*\NUL\NUL\NULgucci\NUL\NULguge\NUL\NULguide\NUL\NULguitars\NUL\NULguru\NUL\NULgw\NUL\NULgy\NULco\NUL\NULcom\NUL\NULnet\NUL\NUL\NULhamburg\NUL\NULhangout\NUL\NULhaus\NUL\NULhdfcbank\NUL\NULhealth\NUL\NULhealthcare\NUL\NULhelp\NUL\NULhelsinki\NUL\NULhere\NUL\NULhermes\NUL\NULhiphop\NUL\NULhitachi\NUL\NULhiv\NUL\NULhk\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULidv\NUL\NULinc\NUL\NULltd\NUL\NULnet\NUL\NULorg\NUL\NULxn--55qx5d\NUL\NULxn--ciqpn\NUL\NULxn--gmq050i\NUL\NULxn--gmqw5a\NUL\NULxn--io0a7i\NUL\NULxn--lcvr32d\NUL\NULxn--mk0axi\NUL\NULxn--mxtq1m\NUL\NULxn--od0alg\NUL\NULxn--od0aq3b\NUL\NULxn--tn0ag\NUL\NULxn--uc0atv\NUL\NULxn--uc0ay4a\NUL\NULxn--wcvs22d\NUL\NULxn--zf0avx\NUL\NUL\NULhm\NUL\NULhn\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULhockey\NUL\NULholdings\NUL\NULholiday\NUL\NULhomedepot\NUL\NULhomes\NUL\NULhonda\NUL\NULhorse\NUL\NULhost\NUL\NULhosting\NUL\NULhoteles\NUL\NULhotmail\NUL\NULhouse\NUL\NULhow\NUL\NULhr\NULcom\NUL\NULfrom\NUL\NULiz\NUL\NULname\NUL\NUL\NULhsbc\NUL\NULht\NULadult\NUL\NULart\NUL\NULasso\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULfirm\NUL\NULgouv\NUL\NULinfo\NUL\NULmed\NUL\NULnet\NUL\NULorg\NUL\NULperso\NUL\NULpol\NUL\NULpro\NUL\NULrel\NUL\NULshop\NUL\NUL\NULhtc\NUL\NULhu\NUL2000\NUL\NULagrar\NUL\NULblogspot\NUL\NULbolt\NUL\NULcasino\NUL\NULcity\NUL\NULco\NUL\NULerotica\NUL\NULerotika\NUL\NULfilm\NUL\NULforum\NUL\NULgames\NUL\NULhotel\NUL\NULinfo\NUL\NULingatlan\NUL\NULjogasz\NUL\NULkonyvelo\NUL\NULlakas\NUL\NULmedia\NUL\NULnews\NUL\NULorg\NUL\NULpriv\NUL\NULreklam\NUL\NULsex\NUL\NULshop\NUL\NULsport\NUL\NULsuli\NUL\NULszex\NUL\NULtm\NUL\NULtozsde\NUL\NULutazas\NUL\NULvideo\NUL\NUL\NULibm\NUL\NULicbc\NUL\NULice\NUL\NULicu\NUL\NULid\NULac\NUL\NULbiz\NUL\NULco\NUL\NULdesa\NUL\NULgo\NUL\NULmil\NUL\NULmy\NUL\NULnet\NUL\NULor\NUL\NULsch\NUL\NULweb\NUL\NUL\NULie\NULblogspot\NUL\NULgov\NUL\NUL\NULifm\NUL\NULiinet\NUL\NULil\NUL*\NUL\NULco\NULblogspot\NUL\NUL\NUL\NULim\NULac\NUL\NULco\NULltd\NUL\NULplc\NUL\NUL\NULcom\NUL\NULnet\NUL\NULorg\NUL\NULtt\NUL\NULtv\NUL\NUL\NULimmo\NUL\NULimmobilien\NUL\NULin\NULac\NUL\NULblogspot\NUL\NULco\NUL\NULedu\NUL\NULfirm\NUL\NULgen\NUL\NULgov\NUL\NULind\NUL\NULmil\NUL\NULnet\NUL\NULnic\NUL\NULorg\NUL\NULres\NUL\NUL\NULindustries\NUL\NULinfiniti\NUL\NULinfo\NULbarrel-of-knowledge\NUL\NULbarrell-of-knowledge\NUL\NULdyndns\NUL\NULfor-our\NUL\NULgroks-the\NUL\NULgroks-this\NUL\NULhere-for-more\NUL\NULknowsitall\NUL\NULselfip\NUL\NULwebhop\NUL\NUL\NULing\NUL\NULink\NUL\NULinstitute\NUL\NULinsurance\NUL\NULinsure\NUL\NULint\NULeu\NUL\NUL\NULinternational\NUL\NULinvestments\NUL\NULio\NULcom\NUL\NULgithub\NUL\NULnid\NUL\NUL\NULipiranga\NUL\NULiq\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULir\NULac\NUL\NULco\NUL\NULgov\NUL\NULid\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NULxn--mgba3a4f16a\NUL\NULxn--mgba3a4fra\NUL\NUL\NULirish\NUL\NULis\NULcom\NUL\NULcupcake\NUL\NULedu\NUL\NULgov\NUL\NULint\NUL\NULnet\NUL\NULorg\NUL\NUL\NULiselect\NUL\NUList\NUL\NUListanbul\NUL\NULit\NULabr\NUL\NULabruzzo\NUL\NULag\NUL\NULagrigento\NUL\NULal\NUL\NULalessandria\NUL\NULalto-adige\NUL\NULaltoadige\NUL\NULan\NUL\NULancona\NUL\NULandria-barletta-trani\NUL\NULandria-trani-barletta\NUL\NULandriabarlettatrani\NUL\NULandriatranibarletta\NUL\NULao\NUL\NULaosta\NUL\NULaosta-valley\NUL\NULaostavalley\NUL\NULaoste\NUL\NULap\NUL\NULaq\NUL\NULaquila\NUL\NULar\NUL\NULarezzo\NUL\NULascoli-piceno\NUL\NULascolipiceno\NUL\NULasti\NUL\NULat\NUL\NULav\NUL\NULavellino\NUL\NULba\NUL\NULbalsan\NUL\NULbari\NUL\NULbarletta-trani-andria\NUL\NULbarlettatraniandria\NUL\NULbas\NUL\NULbasilicata\NUL\NULbelluno\NUL\NULbenevento\NUL\NULbergamo\NUL\NULbg\NUL\NULbi\NUL\NULbiella\NUL\NULbl\NUL\NULblogspot\NUL\NULbn\NUL\NULbo\NUL\NULbologna\NUL\NULbolzano\NUL\NULbozen\NUL\NULbr\NUL\NULbrescia\NUL\NULbrindisi\NUL\NULbs\NUL\NULbt\NUL\NULbz\NUL\NULca\NUL\NULcagliari\NUL\NULcal\NUL\NULcalabria\NUL\NULcaltanissetta\NUL\NULcam\NUL\NULcampania\NUL\NULcampidano-medio\NUL\NULcampidanomedio\NUL\NULcampobasso\NUL\NULcarbonia-iglesias\NUL\NULcarboniaiglesias\NUL\NULcarrara-massa\NUL\NULcarraramassa\NUL\NULcaserta\NUL\NULcatania\NUL\NULcatanzaro\NUL\NULcb\NUL\NULce\NUL\NULcesena-forli\NUL\NULcesenaforli\NUL\NULch\NUL\NULchieti\NUL\NULci\NUL\NULcl\NUL\NULcn\NUL\NULco\NUL\NULcomo\NUL\NULcosenza\NUL\NULcr\NUL\NULcremona\NUL\NULcrotone\NUL\NULcs\NUL\NULct\NUL\NULcuneo\NUL\NULcz\NUL\NULdell-ogliastra\NUL\NULdellogliastra\NUL\NULedu\NUL\NULemilia-romagna\NUL\NULemiliaromagna\NUL\NULemr\NUL\NULen\NUL\NULenna\NUL\NULfc\NUL\NULfe\NUL\NULfermo\NUL\NULferrara\NUL\NULfg\NUL\NULfi\NUL\NULfirenze\NUL\NULflorence\NUL\NULfm\NUL\NULfoggia\NUL\NULforli-cesena\NUL\NULforlicesena\NUL\NULfr\NUL\NULfriuli-v-giulia\NUL\NULfriuli-ve-giulia\NUL\NULfriuli-vegiulia\NUL\NULfriuli-venezia-giulia\NUL\NULfriuli-veneziagiulia\NUL\NULfriuli-vgiulia\NUL\NULfriuliv-giulia\NUL\NULfriulive-giulia\NUL\NULfriulivegiulia\NUL\NULfriulivenezia-giulia\NUL\NULfriuliveneziagiulia\NUL\NULfriulivgiulia\NUL\NULfrosinone\NUL\NULfvg\NUL\NULge\NUL\NULgenoa\NUL\NULgenova\NUL\NULgo\NUL\NULgorizia\NUL\NULgov\NUL\NULgr\NUL\NULgrosseto\NUL\NULiglesias-carbonia\NUL\NULiglesiascarbonia\NUL\NULim\NUL\NULimperia\NUL\NULis\NUL\NULisernia\NUL\NULkr\NUL\NULla-spezia\NUL\NULlaquila\NUL\NULlaspezia\NUL\NULlatina\NUL\NULlaz\NUL\NULlazio\NUL\NULlc\NUL\NULle\NUL\NULlecce\NUL\NULlecco\NUL\NULli\NUL\NULlig\NUL\NULliguria\NUL\NULlivorno\NUL\NULlo\NUL\NULlodi\NUL\NULlom\NUL\NULlombardia\NUL\NULlombardy\NUL\NULlt\NUL\NULlu\NUL\NULlucania\NUL\NULlucca\NUL\NULmacerata\NUL\NULmantova\NUL\NULmar\NUL\NULmarche\NUL\NULmassa-carrara\NUL\NULmassacarrara\NUL\NULmatera\NUL\NULmb\NUL\NULmc\NUL\NULme\NUL\NULmedio-campidano\NUL\NULmediocampidano\NUL\NULmessina\NUL\NULmi\NUL\NULmilan\NUL\NULmilano\NUL\NULmn\NUL\NULmo\NUL\NULmodena\NUL\NULmol\NUL\NULmolise\NUL\NULmonza\NUL\NULmonza-brianza\NUL\NULmonza-e-della-brianza\NUL\NULmonzabrianza\NUL\NULmonzaebrianza\NUL\NULmonzaedellabrianza\NUL\NULms\NUL\NULmt\NUL\NULna\NUL\NULnaples\NUL\NULnapoli\NUL\NULno\NUL\NULnovara\NUL\NULnu\NUL\NULnuoro\NUL\NULog\NUL\NULogliastra\NUL\NULolbia-tempio\NUL\NULolbiatempio\NUL\NULor\NUL\NULoristano\NUL\NULot\NUL\NULpa\NUL\NULpadova\NUL\NULpadua\NUL\NULpalermo\NUL\NULparma\NUL\NULpavia\NUL\NULpc\NUL\NULpd\NUL\NULpe\NUL\NULperugia\NUL\NULpesaro-urbino\NUL\NULpesarourbino\NUL\NULpescara\NUL\NULpg\NUL\NULpi\NUL\NULpiacenza\NUL\NULpiedmont\NUL\NULpiemonte\NUL\NULpisa\NUL\NULpistoia\NUL\NULpmn\NUL\NULpn\NUL\NULpo\NUL\NULpordenone\NUL\NULpotenza\NUL\NULpr\NUL\NULprato\NUL\NULpt\NUL\NULpu\NUL\NULpug\NUL\NULpuglia\NUL\NULpv\NUL\NULpz\NUL\NULra\NUL\NULragusa\NUL\NULravenna\NUL\NULrc\NUL\NULre\NUL\NULreggio-calabria\NUL\NULreggio-emilia\NUL\NULreggiocalabria\NUL\NULreggioemilia\NUL\NULrg\NUL\NULri\NUL\NULrieti\NUL\NULrimini\NUL\NULrm\NUL\NULrn\NUL\NULro\NUL\NULroma\NUL\NULrome\NUL\NULrovigo\NUL\NULsa\NUL\NULsalerno\NUL\NULsar\NUL\NULsardegna\NUL\NULsardinia\NUL\NULsassari\NUL\NULsavona\NUL\NULsi\NUL\NULsic\NUL\NULsicilia\NUL\NULsicily\NUL\NULsiena\NUL\NULsiracusa\NUL\NULso\NUL\NULsondrio\NUL\NULsp\NUL\NULsr\NUL\NULss\NUL\NULsuedtirol\NUL\NULsv\NUL\NULta\NUL\NULtaa\NUL\NULtaranto\NUL\NULte\NUL\NULtempio-olbia\NUL\NULtempioolbia\NUL\NULteramo\NUL\NULterni\NUL\NULtn\NUL\NULto\NUL\NULtorino\NUL\NULtos\NUL\NULtoscana\NUL\NULtp\NUL\NULtr\NUL\NULtrani-andria-barletta\NUL\NULtrani-barletta-andria\NUL\NULtraniandriabarletta\NUL\NULtranibarlettaandria\NUL\NULtrapani\NUL\NULtrentino\NUL\NULtrentino-a-adige\NUL\NULtrentino-aadige\NUL\NULtrentino-alto-adige\NUL\NULtrentino-altoadige\NUL\NULtrentino-s-tirol\NUL\NULtrentino-stirol\NUL\NULtrentino-sud-tirol\NUL\NULtrentino-sudtirol\NUL\NULtrentino-sued-tirol\NUL\NULtrentino-suedtirol\NUL\NULtrentinoa-adige\NUL\NULtrentinoaadige\NUL\NULtrentinoalto-adige\NUL\NULtrentinoaltoadige\NUL\NULtrentinos-tirol\NUL\NULtrentinostirol\NUL\NULtrentinosud-tirol\NUL\NULtrentinosudtirol\NUL\NULtrentinosued-tirol\NUL\NULtrentinosuedtirol\NUL\NULtrento\NUL\NULtreviso\NUL\NULtrieste\NUL\NULts\NUL\NULturin\NUL\NULtuscany\NUL\NULtv\NUL\NULud\NUL\NULudine\NUL\NULumb\NUL\NULumbria\NUL\NULurbino-pesaro\NUL\NULurbinopesaro\NUL\NULva\NUL\NULval-d-aosta\NUL\NULval-daosta\NUL\NULvald-aosta\NUL\NULvaldaosta\NUL\NULvalle-aosta\NUL\NULvalle-d-aosta\NUL\NULvalle-daosta\NUL\NULvalleaosta\NUL\NULvalled-aosta\NUL\NULvalledaosta\NUL\NULvallee-aoste\NUL\NULvalleeaoste\NUL\NULvao\NUL\NULvarese\NUL\NULvb\NUL\NULvc\NUL\NULvda\NUL\NULve\NUL\NULven\NUL\NULveneto\NUL\NULvenezia\NUL\NULvenice\NUL\NULverbania\NUL\NULvercelli\NUL\NULverona\NUL\NULvi\NUL\NULvibo-valentia\NUL\NULvibovalentia\NUL\NULvicenza\NUL\NULviterbo\NUL\NULvr\NUL\NULvs\NUL\NULvt\NUL\NULvv\NUL\NUL\NULitau\NUL\NULiwc\NUL\NULjaguar\NUL\NULjava\NUL\NULjcb\NUL\NULje\NULco\NUL\NULnet\NUL\NULorg\NUL\NUL\NULjetzt\NUL\NULjewelry\NUL\NULjio\NUL\NULjlc\NUL\NULjll\NUL\NULjm\NUL*\NUL\NUL\NULjmp\NUL\NULjo\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NUL\NULjobs\NUL\NULjoburg\NUL\NULjot\NUL\NULjoy\NUL\NULjp\NULac\NUL\NULad\NUL\NULaichi\NULaisai\NUL\NULama\NUL\NULanjo\NUL\NULasuke\NUL\NULchiryu\NUL\NULchita\NUL\NULfuso\NUL\NULgamagori\NUL\NULhanda\NUL\NULhazu\NUL\NULhekinan\NUL\NULhigashiura\NUL\NULichinomiya\NUL\NULinazawa\NUL\NULinuyama\NUL\NULisshiki\NUL\NULiwakura\NUL\NULkanie\NUL\NULkariya\NUL\NULkasugai\NUL\NULkira\NUL\NULkiyosu\NUL\NULkomaki\NUL\NULkonan\NUL\NULkota\NUL\NULmihama\NUL\NULmiyoshi\NUL\NULnishio\NUL\NULnisshin\NUL\NULobu\NUL\NULoguchi\NUL\NULoharu\NUL\NULokazaki\NUL\NULowariasahi\NUL\NULseto\NUL\NULshikatsu\NUL\NULshinshiro\NUL\NULshitara\NUL\NULtahara\NUL\NULtakahama\NUL\NULtobishima\NUL\NULtoei\NUL\NULtogo\NUL\NULtokai\NUL\NULtokoname\NUL\NULtoyoake\NUL\NULtoyohashi\NUL\NULtoyokawa\NUL\NULtoyone\NUL\NULtoyota\NUL\NULtsushima\NUL\NULyatomi\NUL\NUL\NULakita\NULakita\NUL\NULdaisen\NUL\NULfujisato\NUL\NULgojome\NUL\NULhachirogata\NUL\NULhappou\NUL\NULhigashinaruse\NUL\NULhonjo\NUL\NULhonjyo\NUL\NULikawa\NUL\NULkamikoani\NUL\NULkamioka\NUL\NULkatagami\NUL\NULkazuno\NUL\NULkitaakita\NUL\NULkosaka\NUL\NULkyowa\NUL\NULmisato\NUL\NULmitane\NUL\NULmoriyoshi\NUL\NULnikaho\NUL\NULnoshiro\NUL\NULodate\NUL\NULoga\NUL\NULogata\NUL\NULsemboku\NUL\NULyokote\NUL\NULyurihonjo\NUL\NUL\NULaomori\NULaomori\NUL\NULgonohe\NUL\NULhachinohe\NUL\NULhashikami\NUL\NULhiranai\NUL\NULhirosaki\NUL\NULitayanagi\NUL\NULkuroishi\NUL\NULmisawa\NUL\NULmutsu\NUL\NULnakadomari\NUL\NULnoheji\NUL\NULoirase\NUL\NULowani\NUL\NULrokunohe\NUL\NULsannohe\NUL\NULshichinohe\NUL\NULshingo\NUL\NULtakko\NUL\NULtowada\NUL\NULtsugaru\NUL\NULtsuruta\NUL\NUL\NULblogspot\NUL\NULchiba\NULabiko\NUL\NULasahi\NUL\NULchonan\NUL\NULchosei\NUL\NULchoshi\NUL\NULchuo\NUL\NULfunabashi\NUL\NULfuttsu\NUL\NULhanamigawa\NUL\NULichihara\NUL\NULichikawa\NUL\NULichinomiya\NUL\NULinzai\NUL\NULisumi\NUL\NULkamagaya\NUL\NULkamogawa\NUL\NULkashiwa\NUL\NULkatori\NUL\NULkatsuura\NUL\NULkimitsu\NUL\NULkisarazu\NUL\NULkozaki\NUL\NULkujukuri\NUL\NULkyonan\NUL\NULmatsudo\NUL\NULmidori\NUL\NULmihama\NUL\NULminamiboso\NUL\NULmobara\NUL\NULmutsuzawa\NUL\NULnagara\NUL\NULnagareyama\NUL\NULnarashino\NUL\NULnarita\NUL\NULnoda\NUL\NULoamishirasato\NUL\NULomigawa\NUL\NULonjuku\NUL\NULotaki\NUL\NULsakae\NUL\NULsakura\NUL\NULshimofusa\NUL\NULshirako\NUL\NULshiroi\NUL\NULshisui\NUL\NULsodegaura\NUL\NULsosa\NUL\NULtako\NUL\NULtateyama\NUL\NULtogane\NUL\NULtohnosho\NUL\NULtomisato\NUL\NULurayasu\NUL\NULyachimata\NUL\NULyachiyo\NUL\NULyokaichiba\NUL\NULyokoshibahikari\NUL\NULyotsukaido\NUL\NUL\NULco\NUL\NULed\NUL\NULehime\NULainan\NUL\NULhonai\NUL\NULikata\NUL\NULimabari\NUL\NULiyo\NUL\NULkamijima\NUL\NULkihoku\NUL\NULkumakogen\NUL\NULmasaki\NUL\NULmatsuno\NUL\NULmatsuyama\NUL\NULnamikata\NUL\NULniihama\NUL\NULozu\NUL\NULsaijo\NUL\NULseiyo\NUL\NULshikokuchuo\NUL\NULtobe\NUL\NULtoon\NUL\NULuchiko\NUL\NULuwajima\NUL\NULyawatahama\NUL\NUL\NULfukui\NULechizen\NUL\NULeiheiji\NUL\NULfukui\NUL\NULikeda\NUL\NULkatsuyama\NUL\NULmihama\NUL\NULminamiechizen\NUL\NULobama\NUL\NULohi\NUL\NULono\NUL\NULsabae\NUL\NULsakai\NUL\NULtakahama\NUL\NULtsuruga\NUL\NULwakasa\NUL\NUL\NULfukuoka\NULashiya\NUL\NULbuzen\NUL\NULchikugo\NUL\NULchikuho\NUL\NULchikujo\NUL\NULchikushino\NUL\NULchikuzen\NUL\NULchuo\NUL\NULdazaifu\NUL\NULfukuchi\NUL\NULhakata\NUL\NULhigashi\NUL\NULhirokawa\NUL\NULhisayama\NUL\NULiizuka\NUL\NULinatsuki\NUL\NULkaho\NUL\NULkasuga\NUL\NULkasuya\NUL\NULkawara\NUL\NULkeisen\NUL\NULkoga\NUL\NULkurate\NUL\NULkurogi\NUL\NULkurume\NUL\NULminami\NUL\NULmiyako\NUL\NULmiyama\NUL\NULmiyawaka\NUL\NULmizumaki\NUL\NULmunakata\NUL\NULnakagawa\NUL\NULnakama\NUL\NULnishi\NUL\NULnogata\NUL\NULogori\NUL\NULokagaki\NUL\NULokawa\NUL\NULoki\NUL\NULomuta\NUL\NULonga\NUL\NULonojo\NUL\NULoto\NUL\NULsaigawa\NUL\NULsasaguri\NUL\NULshingu\NUL\NULshinyoshitomi\NUL\NULshonai\NUL\NULsoeda\NUL\NULsue\NUL\NULtachiarai\NUL\NULtagawa\NUL\NULtakata\NUL\NULtoho\NUL\NULtoyotsu\NUL\NULtsuiki\NUL\NULukiha\NUL\NULumi\NUL\NULusui\NUL\NULyamada\NUL\NULyame\NUL\NULyanagawa\NUL\NULyukuhashi\NUL\NUL\NULfukushima\NULaizubange\NUL\NULaizumisato\NUL\NULaizuwakamatsu\NUL\NULasakawa\NUL\NULbandai\NUL\NULdate\NUL\NULfukushima\NUL\NULfurudono\NUL\NULfutaba\NUL\NULhanawa\NUL\NULhigashi\NUL\NULhirata\NUL\NULhirono\NUL\NULiitate\NUL\NULinawashiro\NUL\NULishikawa\NUL\NULiwaki\NUL\NULizumizaki\NUL\NULkagamiishi\NUL\NULkaneyama\NUL\NULkawamata\NUL\NULkitakata\NUL\NULkitashiobara\NUL\NULkoori\NUL\NULkoriyama\NUL\NULkunimi\NUL\NULmiharu\NUL\NULmishima\NUL\NULnamie\NUL\NULnango\NUL\NULnishiaizu\NUL\NULnishigo\NUL\NULokuma\NUL\NULomotego\NUL\NULono\NUL\NULotama\NUL\NULsamegawa\NUL\NULshimogo\NUL\NULshirakawa\NUL\NULshowa\NUL\NULsoma\NUL\NULsukagawa\NUL\NULtaishin\NUL\NULtamakawa\NUL\NULtanagura\NUL\NULtenei\NUL\NULyabuki\NUL\NULyamato\NUL\NULyamatsuri\NUL\NULyanaizu\NUL\NULyugawa\NUL\NUL\NULgifu\NULanpachi\NUL\NULena\NUL\NULgifu\NUL\NULginan\NUL\NULgodo\NUL\NULgujo\NUL\NULhashima\NUL\NULhichiso\NUL\NULhida\NUL\NULhigashishirakawa\NUL\NULibigawa\NUL\NULikeda\NUL\NULkakamigahara\NUL\NULkani\NUL\NULkasahara\NUL\NULkasamatsu\NUL\NULkawaue\NUL\NULkitagata\NUL\NULmino\NUL\NULminokamo\NUL\NULmitake\NUL\NULmizunami\NUL\NULmotosu\NUL\NULnakatsugawa\NUL\NULogaki\NUL\NULsakahogi\NUL\NULseki\NUL\NULsekigahara\NUL\NULshirakawa\NUL\NULtajimi\NUL\NULtakayama\NUL\NULtarui\NUL\NULtoki\NUL\NULtomika\NUL\NULwanouchi\NUL\NULyamagata\NUL\NULyaotsu\NUL\NULyoro\NUL\NUL\NULgo\NUL\NULgr\NUL\NULgunma\NULannaka\NUL\NULchiyoda\NUL\NULfujioka\NUL\NULhigashiagatsuma\NUL\NULisesaki\NUL\NULitakura\NUL\NULkanna\NUL\NULkanra\NUL\NULkatashina\NUL\NULkawaba\NUL\NULkiryu\NUL\NULkusatsu\NUL\NULmaebashi\NUL\NULmeiwa\NUL\NULmidori\NUL\NULminakami\NUL\NULnaganohara\NUL\NULnakanojo\NUL\NULnanmoku\NUL\NULnumata\NUL\NULoizumi\NUL\NULora\NUL\NULota\NUL\NULshibukawa\NUL\NULshimonita\NUL\NULshinto\NUL\NULshowa\NUL\NULtakasaki\NUL\NULtakayama\NUL\NULtamamura\NUL\NULtatebayashi\NUL\NULtomioka\NUL\NULtsukiyono\NUL\NULtsumagoi\NUL\NULueno\NUL\NULyoshioka\NUL\NUL\NULhiroshima\NULasaminami\NUL\NULdaiwa\NUL\NULetajima\NUL\NULfuchu\NUL\NULfukuyama\NUL\NULhatsukaichi\NUL\NULhigashihiroshima\NUL\NULhongo\NUL\NULjinsekikogen\NUL\NULkaita\NUL\NULkui\NUL\NULkumano\NUL\NULkure\NUL\NULmihara\NUL\NULmiyoshi\NUL\NULnaka\NUL\NULonomichi\NUL\NULosakikamijima\NUL\NULotake\NUL\NULsaka\NUL\NULsera\NUL\NULseranishi\NUL\NULshinichi\NUL\NULshobara\NUL\NULtakehara\NUL\NUL\NULhokkaido\NULabashiri\NUL\NULabira\NUL\NULaibetsu\NUL\NULakabira\NUL\NULakkeshi\NUL\NULasahikawa\NUL\NULashibetsu\NUL\NULashoro\NUL\NULassabu\NUL\NULatsuma\NUL\NULbibai\NUL\NULbiei\NUL\NULbifuka\NUL\NULbihoro\NUL\NULbiratori\NUL\NULchippubetsu\NUL\NULchitose\NUL\NULdate\NUL\NULebetsu\NUL\NULembetsu\NUL\NULeniwa\NUL\NULerimo\NUL\NULesan\NUL\NULesashi\NUL\NULfukagawa\NUL\NULfukushima\NUL\NULfurano\NUL\NULfurubira\NUL\NULhaboro\NUL\NULhakodate\NUL\NULhamatonbetsu\NUL\NULhidaka\NUL\NULhigashikagura\NUL\NULhigashikawa\NUL\NULhiroo\NUL\NULhokuryu\NUL\NULhokuto\NUL\NULhonbetsu\NUL\NULhorokanai\NUL\NULhoronobe\NUL\NULikeda\NUL\NULimakane\NUL\NULishikari\NUL\NULiwamizawa\NUL\NULiwanai\NUL\NULkamifurano\NUL\NULkamikawa\NUL\NULkamishihoro\NUL\NULkamisunagawa\NUL\NULkamoenai\NUL\NULkayabe\NUL\NULkembuchi\NUL\NULkikonai\NUL\NULkimobetsu\NUL\NULkitahiroshima\NUL\NULkitami\NUL\NULkiyosato\NUL\NULkoshimizu\NUL\NULkunneppu\NUL\NULkuriyama\NUL\NULkuromatsunai\NUL\NULkushiro\NUL\NULkutchan\NUL\NULkyowa\NUL\NULmashike\NUL\NULmatsumae\NUL\NULmikasa\NUL\NULminamifurano\NUL\NULmombetsu\NUL\NULmoseushi\NUL\NULmukawa\NUL\NULmuroran\NUL\NULnaie\NUL\NULnakagawa\NUL\NULnakasatsunai\NUL\NULnakatombetsu\NUL\NULnanae\NUL\NULnanporo\NUL\NULnayoro\NUL\NULnemuro\NUL\NULniikappu\NUL\NULniki\NUL\NULnishiokoppe\NUL\NULnoboribetsu\NUL\NULnumata\NUL\NULobihiro\NUL\NULobira\NUL\NULoketo\NUL\NULokoppe\NUL\NULotaru\NUL\NULotobe\NUL\NULotofuke\NUL\NULotoineppu\NUL\NULoumu\NUL\NULozora\NUL\NULpippu\NUL\NULrankoshi\NUL\NULrebun\NUL\NULrikubetsu\NUL\NULrishiri\NUL\NULrishirifuji\NUL\NULsaroma\NUL\NULsarufutsu\NUL\NULshakotan\NUL\NULshari\NUL\NULshibecha\NUL\NULshibetsu\NUL\NULshikabe\NUL\NULshikaoi\NUL\NULshimamaki\NUL\NULshimizu\NUL\NULshimokawa\NUL\NULshinshinotsu\NUL\NULshintoku\NUL\NULshiranuka\NUL\NULshiraoi\NUL\NULshiriuchi\NUL\NULsobetsu\NUL\NULsunagawa\NUL\NULtaiki\NUL\NULtakasu\NUL\NULtakikawa\NUL\NULtakinoue\NUL\NULteshikaga\NUL\NULtobetsu\NUL\NULtohma\NUL\NULtomakomai\NUL\NULtomari\NUL\NULtoya\NUL\NULtoyako\NUL\NULtoyotomi\NUL\NULtoyoura\NUL\NULtsubetsu\NUL\NULtsukigata\NUL\NULurakawa\NUL\NULurausu\NUL\NULuryu\NUL\NULutashinai\NUL\NULwakkanai\NUL\NULwassamu\NUL\NULyakumo\NUL\NULyoichi\NUL\NUL\NULhyogo\NULaioi\NUL\NULakashi\NUL\NULako\NUL\NULamagasaki\NUL\NULaogaki\NUL\NULasago\NUL\NULashiya\NUL\NULawaji\NUL\NULfukusaki\NUL\NULgoshiki\NUL\NULharima\NUL\NULhimeji\NUL\NULichikawa\NUL\NULinagawa\NUL\NULitami\NUL\NULkakogawa\NUL\NULkamigori\NUL\NULkamikawa\NUL\NULkasai\NUL\NULkasuga\NUL\NULkawanishi\NUL\NULmiki\NUL\NULminamiawaji\NUL\NULnishinomiya\NUL\NULnishiwaki\NUL\NULono\NUL\NULsanda\NUL\NULsannan\NUL\NULsasayama\NUL\NULsayo\NUL\NULshingu\NUL\NULshinonsen\NUL\NULshiso\NUL\NULsumoto\NUL\NULtaishi\NUL\NULtaka\NUL\NULtakarazuka\NUL\NULtakasago\NUL\NULtakino\NUL\NULtamba\NUL\NULtatsuno\NUL\NULtoyooka\NUL\NULyabu\NUL\NULyashiro\NUL\NULyoka\NUL\NULyokawa\NUL\NUL\NULibaraki\NULami\NUL\NULasahi\NUL\NULbando\NUL\NULchikusei\NUL\NULdaigo\NUL\NULfujishiro\NUL\NULhitachi\NUL\NULhitachinaka\NUL\NULhitachiomiya\NUL\NULhitachiota\NUL\NULibaraki\NUL\NULina\NUL\NULinashiki\NUL\NULitako\NUL\NULiwama\NUL\NULjoso\NUL\NULkamisu\NUL\NULkasama\NUL\NULkashima\NUL\NULkasumigaura\NUL\NULkoga\NUL\NULmiho\NUL\NULmito\NUL\NULmoriya\NUL\NULnaka\NUL\NULnamegata\NUL\NULoarai\NUL\NULogawa\NUL\NULomitama\NUL\NULryugasaki\NUL\NULsakai\NUL\NULsakuragawa\NUL\NULshimodate\NUL\NULshimotsuma\NUL\NULshirosato\NUL\NULsowa\NUL\NULsuifu\NUL\NULtakahagi\NUL\NULtamatsukuri\NUL\NULtokai\NUL\NULtomobe\NUL\NULtone\NUL\NULtoride\NUL\NULtsuchiura\NUL\NULtsukuba\NUL\NULuchihara\NUL\NULushiku\NUL\NULyachiyo\NUL\NULyamagata\NUL\NULyawara\NUL\NULyuki\NUL\NUL\NULishikawa\NULanamizu\NUL\NULhakui\NUL\NULhakusan\NUL\NULkaga\NUL\NULkahoku\NUL\NULkanazawa\NUL\NULkawakita\NUL\NULkomatsu\NUL\NULnakanoto\NUL\NULnanao\NUL\NULnomi\NUL\NULnonoichi\NUL\NULnoto\NUL\NULshika\NUL\NULsuzu\NUL\NULtsubata\NUL\NULtsurugi\NUL\NULuchinada\NUL\NULwajima\NUL\NUL\NULiwate\NULfudai\NUL\NULfujisawa\NUL\NULhanamaki\NUL\NULhiraizumi\NUL\NULhirono\NUL\NULichinohe\NUL\NULichinoseki\NUL\NULiwaizumi\NUL\NULiwate\NUL\NULjoboji\NUL\NULkamaishi\NUL\NULkanegasaki\NUL\NULkarumai\NUL\NULkawai\NUL\NULkitakami\NUL\NULkuji\NUL\NULkunohe\NUL\NULkuzumaki\NUL\NULmiyako\NUL\NULmizusawa\NUL\NULmorioka\NUL\NULninohe\NUL\NULnoda\NUL\NULofunato\NUL\NULoshu\NUL\NULotsuchi\NUL\NULrikuzentakata\NUL\NULshiwa\NUL\NULshizukuishi\NUL\NULsumita\NUL\NULtanohata\NUL\NULtono\NUL\NULyahaba\NUL\NULyamada\NUL\NUL\NULkagawa\NULayagawa\NUL\NULhigashikagawa\NUL\NULkanonji\NUL\NULkotohira\NUL\NULmanno\NUL\NULmarugame\NUL\NULmitoyo\NUL\NULnaoshima\NUL\NULsanuki\NUL\NULtadotsu\NUL\NULtakamatsu\NUL\NULtonosho\NUL\NULuchinomi\NUL\NULutazu\NUL\NULzentsuji\NUL\NUL\NULkagoshima\NULakune\NUL\NULamami\NUL\NULhioki\NUL\NULisa\NUL\NULisen\NUL\NULizumi\NUL\NULkagoshima\NUL\NULkanoya\NUL\NULkawanabe\NUL\NULkinko\NUL\NULkouyama\NUL\NULmakurazaki\NUL\NULmatsumoto\NUL\NULminamitane\NUL\NULnakatane\NUL\NULnishinoomote\NUL\NULsatsumasendai\NUL\NULsoo\NUL\NULtarumizu\NUL\NULyusui\NUL\NUL\NULkanagawa\NULaikawa\NUL\NULatsugi\NUL\NULayase\NUL\NULchigasaki\NUL\NULebina\NUL\NULfujisawa\NUL\NULhadano\NUL\NULhakone\NUL\NULhiratsuka\NUL\NULisehara\NUL\NULkaisei\NUL\NULkamakura\NUL\NULkiyokawa\NUL\NULmatsuda\NUL\NULminamiashigara\NUL\NULmiura\NUL\NULnakai\NUL\NULninomiya\NUL\NULodawara\NUL\NULoi\NUL\NULoiso\NUL\NULsagamihara\NUL\NULsamukawa\NUL\NULtsukui\NUL\NULyamakita\NUL\NULyamato\NUL\NULyokosuka\NUL\NULyugawara\NUL\NULzama\NUL\NULzushi\NUL\NUL\NULkawasaki\NUL*\NUL\NUL\NULkitakyushu\NUL*\NUL\NUL\NULkobe\NUL*\NUL\NUL\NULkochi\NULaki\NUL\NULgeisei\NUL\NULhidaka\NUL\NULhigashitsuno\NUL\NULino\NUL\NULkagami\NUL\NULkami\NUL\NULkitagawa\NUL\NULkochi\NUL\NULmihara\NUL\NULmotoyama\NUL\NULmuroto\NUL\NULnahari\NUL\NULnakamura\NUL\NULnankoku\NUL\NULnishitosa\NUL\NULniyodogawa\NUL\NULochi\NUL\NULokawa\NUL\NULotoyo\NUL\NULotsuki\NUL\NULsakawa\NUL\NULsukumo\NUL\NULsusaki\NUL\NULtosa\NUL\NULtosashimizu\NUL\NULtoyo\NUL\NULtsuno\NUL\NULumaji\NUL\NULyasuda\NUL\NULyusuhara\NUL\NUL\NULkumamoto\NULamakusa\NUL\NULarao\NUL\NULaso\NUL\NULchoyo\NUL\NULgyokuto\NUL\NULhitoyoshi\NUL\NULkamiamakusa\NUL\NULkashima\NUL\NULkikuchi\NUL\NULkosa\NUL\NULkumamoto\NUL\NULmashiki\NUL\NULmifune\NUL\NULminamata\NUL\NULminamioguni\NUL\NULnagasu\NUL\NULnishihara\NUL\NULoguni\NUL\NULozu\NUL\NULsumoto\NUL\NULtakamori\NUL\NULuki\NUL\NULuto\NUL\NULyamaga\NUL\NULyamato\NUL\NULyatsushiro\NUL\NUL\NULkyoto\NULayabe\NUL\NULfukuchiyama\NUL\NULhigashiyama\NUL\NULide\NUL\NULine\NUL\NULjoyo\NUL\NULkameoka\NUL\NULkamo\NUL\NULkita\NUL\NULkizu\NUL\NULkumiyama\NUL\NULkyotamba\NUL\NULkyotanabe\NUL\NULkyotango\NUL\NULmaizuru\NUL\NULminami\NUL\NULminamiyamashiro\NUL\NULmiyazu\NUL\NULmuko\NUL\NULnagaokakyo\NUL\NULnakagyo\NUL\NULnantan\NUL\NULoyamazaki\NUL\NULsakyo\NUL\NULseika\NUL\NULtanabe\NUL\NULuji\NUL\NULujitawara\NUL\NULwazuka\NUL\NULyamashina\NUL\NULyawata\NUL\NUL\NULlg\NUL\NULmie\NULasahi\NUL\NULinabe\NUL\NULise\NUL\NULkameyama\NUL\NULkawagoe\NUL\NULkiho\NUL\NULkisosaki\NUL\NULkiwa\NUL\NULkomono\NUL\NULkumano\NUL\NULkuwana\NUL\NULmatsusaka\NUL\NULmeiwa\NUL\NULmihama\NUL\NULminamiise\NUL\NULmisugi\NUL\NULmiyama\NUL\NULnabari\NUL\NULshima\NUL\NULsuzuka\NUL\NULtado\NUL\NULtaiki\NUL\NULtaki\NUL\NULtamaki\NUL\NULtoba\NUL\NULtsu\NUL\NULudono\NUL\NULureshino\NUL\NULwatarai\NUL\NULyokkaichi\NUL\NUL\NULmiyagi\NULfurukawa\NUL\NULhigashimatsushima\NUL\NULishinomaki\NUL\NULiwanuma\NUL\NULkakuda\NUL\NULkami\NUL\NULkawasaki\NUL\NULkesennuma\NUL\NULmarumori\NUL\NULmatsushima\NUL\NULminamisanriku\NUL\NULmisato\NUL\NULmurata\NUL\NULnatori\NUL\NULogawara\NUL\NULohira\NUL\NULonagawa\NUL\NULosaki\NUL\NULrifu\NUL\NULsemine\NUL\NULshibata\NUL\NULshichikashuku\NUL\NULshikama\NUL\NULshiogama\NUL\NULshiroishi\NUL\NULtagajo\NUL\NULtaiwa\NUL\NULtome\NUL\NULtomiya\NUL\NULwakuya\NUL\NULwatari\NUL\NULyamamoto\NUL\NULzao\NUL\NUL\NULmiyazaki\NULaya\NUL\NULebino\NUL\NULgokase\NUL\NULhyuga\NUL\NULkadogawa\NUL\NULkawaminami\NUL\NULkijo\NUL\NULkitagawa\NUL\NULkitakata\NUL\NULkitaura\NUL\NULkobayashi\NUL\NULkunitomi\NUL\NULkushima\NUL\NULmimata\NUL\NULmiyakonojo\NUL\NULmiyazaki\NUL\NULmorotsuka\NUL\NULnichinan\NUL\NULnishimera\NUL\NULnobeoka\NUL\NULsaito\NUL\NULshiiba\NUL\NULshintomi\NUL\NULtakaharu\NUL\NULtakanabe\NUL\NULtakazaki\NUL\NULtsuno\NUL\NUL\NULnagano\NULachi\NUL\NULagematsu\NUL\NULanan\NUL\NULaoki\NUL\NULasahi\NUL\NULazumino\NUL\NULchikuhoku\NUL\NULchikuma\NUL\NULchino\NUL\NULfujimi\NUL\NULhakuba\NUL\NULhara\NUL\NULhiraya\NUL\NULiida\NUL\NULiijima\NUL\NULiiyama\NUL\NULiizuna\NUL\NULikeda\NUL\NULikusaka\NUL\NULina\NUL\NULkaruizawa\NUL\NULkawakami\NUL\NULkiso\NUL\NULkisofukushima\NUL\NULkitaaiki\NUL\NULkomagane\NUL\NULkomoro\NUL\NULmatsukawa\NUL\NULmatsumoto\NUL\NULmiasa\NUL\NULminamiaiki\NUL\NULminamimaki\NUL\NULminamiminowa\NUL\NULminowa\NUL\NULmiyada\NUL\NULmiyota\NUL\NULmochizuki\NUL\NULnagano\NUL\NULnagawa\NUL\NULnagiso\NUL\NULnakagawa\NUL\NULnakano\NUL\NULnozawaonsen\NUL\NULobuse\NUL\NULogawa\NUL\NULokaya\NUL\NULomachi\NUL\NULomi\NUL\NULookuwa\NUL\NULooshika\NUL\NULotaki\NUL\NULotari\NUL\NULsakae\NUL\NULsakaki\NUL\NULsaku\NUL\NULsakuho\NUL\NULshimosuwa\NUL\NULshinanomachi\NUL\NULshiojiri\NUL\NULsuwa\NUL\NULsuzaka\NUL\NULtakagi\NUL\NULtakamori\NUL\NULtakayama\NUL\NULtateshina\NUL\NULtatsuno\NUL\NULtogakushi\NUL\NULtogura\NUL\NULtomi\NUL\NULueda\NUL\NULwada\NUL\NULyamagata\NUL\NULyamanouchi\NUL\NULyasaka\NUL\NULyasuoka\NUL\NUL\NULnagasaki\NULchijiwa\NUL\NULfutsu\NUL\NULgoto\NUL\NULhasami\NUL\NULhirado\NUL\NULiki\NUL\NULisahaya\NUL\NULkawatana\NUL\NULkuchinotsu\NUL\NULmatsuura\NUL\NULnagasaki\NUL\NULobama\NUL\NULomura\NUL\NULoseto\NUL\NULsaikai\NUL\NULsasebo\NUL\NULseihi\NUL\NULshimabara\NUL\NULshinkamigoto\NUL\NULtogitsu\NUL\NULtsushima\NUL\NULunzen\NUL\NUL\NULnagoya\NUL*\NUL\NUL\NULnara\NULando\NUL\NULgose\NUL\NULheguri\NUL\NULhigashiyoshino\NUL\NULikaruga\NUL\NULikoma\NUL\NULkamikitayama\NUL\NULkanmaki\NUL\NULkashiba\NUL\NULkashihara\NUL\NULkatsuragi\NUL\NULkawai\NUL\NULkawakami\NUL\NULkawanishi\NUL\NULkoryo\NUL\NULkurotaki\NUL\NULmitsue\NUL\NULmiyake\NUL\NULnara\NUL\NULnosegawa\NUL\NULoji\NUL\NULouda\NUL\NULoyodo\NUL\NULsakurai\NUL\NULsango\NUL\NULshimoichi\NUL\NULshimokitayama\NUL\NULshinjo\NUL\NULsoni\NUL\NULtakatori\NUL\NULtawaramoto\NUL\NULtenkawa\NUL\NULtenri\NUL\NULuda\NUL\NULyamatokoriyama\NUL\NULyamatotakada\NUL\NULyamazoe\NUL\NULyoshino\NUL\NUL\NULne\NUL\NULniigata\NULaga\NUL\NULagano\NUL\NULgosen\NUL\NULitoigawa\NUL\NULizumozaki\NUL\NULjoetsu\NUL\NULkamo\NUL\NULkariwa\NUL\NULkashiwazaki\NUL\NULminamiuonuma\NUL\NULmitsuke\NUL\NULmuika\NUL\NULmurakami\NUL\NULmyoko\NUL\NULnagaoka\NUL\NULniigata\NUL\NULojiya\NUL\NULomi\NUL\NULsado\NUL\NULsanjo\NUL\NULseiro\NUL\NULseirou\NUL\NULsekikawa\NUL\NULshibata\NUL\NULtagami\NUL\NULtainai\NUL\NULtochio\NUL\NULtokamachi\NUL\NULtsubame\NUL\NULtsunan\NUL\NULuonuma\NUL\NULyahiko\NUL\NULyoita\NUL\NULyuzawa\NUL\NUL\NULoita\NULbeppu\NUL\NULbungoono\NUL\NULbungotakada\NUL\NULhasama\NUL\NULhiji\NUL\NULhimeshima\NUL\NULhita\NUL\NULkamitsue\NUL\NULkokonoe\NUL\NULkuju\NUL\NULkunisaki\NUL\NULkusu\NUL\NULoita\NUL\NULsaiki\NUL\NULtaketa\NUL\NULtsukumi\NUL\NULusa\NUL\NULusuki\NUL\NULyufu\NUL\NUL\NULokayama\NULakaiwa\NUL\NULasakuchi\NUL\NULbizen\NUL\NULhayashima\NUL\NULibara\NUL\NULkagamino\NUL\NULkasaoka\NUL\NULkibichuo\NUL\NULkumenan\NUL\NULkurashiki\NUL\NULmaniwa\NUL\NULmisaki\NUL\NULnagi\NUL\NULniimi\NUL\NULnishiawakura\NUL\NULokayama\NUL\NULsatosho\NUL\NULsetouchi\NUL\NULshinjo\NUL\NULshoo\NUL\NULsoja\NUL\NULtakahashi\NUL\NULtamano\NUL\NULtsuyama\NUL\NULwake\NUL\NULyakage\NUL\NUL\NULokinawa\NULaguni\NUL\NULginowan\NUL\NULginoza\NUL\NULgushikami\NUL\NULhaebaru\NUL\NULhigashi\NUL\NULhirara\NUL\NULiheya\NUL\NULishigaki\NUL\NULishikawa\NUL\NULitoman\NUL\NULizena\NUL\NULkadena\NUL\NULkin\NUL\NULkitadaito\NUL\NULkitanakagusuku\NUL\NULkumejima\NUL\NULkunigami\NUL\NULminamidaito\NUL\NULmotobu\NUL\NULnago\NUL\NULnaha\NUL\NULnakagusuku\NUL\NULnakijin\NUL\NULnanjo\NUL\NULnishihara\NUL\NULogimi\NUL\NULokinawa\NUL\NULonna\NUL\NULshimoji\NUL\NULtaketomi\NUL\NULtarama\NUL\NULtokashiki\NUL\NULtomigusuku\NUL\NULtonaki\NUL\NULurasoe\NUL\NULuruma\NUL\NULyaese\NUL\NULyomitan\NUL\NULyonabaru\NUL\NULyonaguni\NUL\NULzamami\NUL\NUL\NULor\NUL\NULosaka\NULabeno\NUL\NULchihayaakasaka\NUL\NULchuo\NUL\NULdaito\NUL\NULfujiidera\NUL\NULhabikino\NUL\NULhannan\NUL\NULhigashiosaka\NUL\NULhigashisumiyoshi\NUL\NULhigashiyodogawa\NUL\NULhirakata\NUL\NULibaraki\NUL\NULikeda\NUL\NULizumi\NUL\NULizumiotsu\NUL\NULizumisano\NUL\NULkadoma\NUL\NULkaizuka\NUL\NULkanan\NUL\NULkashiwara\NUL\NULkatano\NUL\NULkawachinagano\NUL\NULkishiwada\NUL\NULkita\NUL\NULkumatori\NUL\NULmatsubara\NUL\NULminato\NUL\NULminoh\NUL\NULmisaki\NUL\NULmoriguchi\NUL\NULneyagawa\NUL\NULnishi\NUL\NULnose\NUL\NULosakasayama\NUL\NULsakai\NUL\NULsayama\NUL\NULsennan\NUL\NULsettsu\NUL\NULshijonawate\NUL\NULshimamoto\NUL\NULsuita\NUL\NULtadaoka\NUL\NULtaishi\NUL\NULtajiri\NUL\NULtakaishi\NUL\NULtakatsuki\NUL\NULtondabayashi\NUL\NULtoyonaka\NUL\NULtoyono\NUL\NULyao\NUL\NUL\NULsaga\NULariake\NUL\NULarita\NUL\NULfukudomi\NUL\NULgenkai\NUL\NULhamatama\NUL\NULhizen\NUL\NULimari\NUL\NULkamimine\NUL\NULkanzaki\NUL\NULkaratsu\NUL\NULkashima\NUL\NULkitagata\NUL\NULkitahata\NUL\NULkiyama\NUL\NULkouhoku\NUL\NULkyuragi\NUL\NULnishiarita\NUL\NULogi\NUL\NULomachi\NUL\NULouchi\NUL\NULsaga\NUL\NULshiroishi\NUL\NULtaku\NUL\NULtara\NUL\NULtosu\NUL\NULyoshinogari\NUL\NUL\NULsaitama\NULarakawa\NUL\NULasaka\NUL\NULchichibu\NUL\NULfujimi\NUL\NULfujimino\NUL\NULfukaya\NUL\NULhanno\NUL\NULhanyu\NUL\NULhasuda\NUL\NULhatogaya\NUL\NULhatoyama\NUL\NULhidaka\NUL\NULhigashichichibu\NUL\NULhigashimatsuyama\NUL\NULhonjo\NUL\NULina\NUL\NULiruma\NUL\NULiwatsuki\NUL\NULkamiizumi\NUL\NULkamikawa\NUL\NULkamisato\NUL\NULkasukabe\NUL\NULkawagoe\NUL\NULkawaguchi\NUL\NULkawajima\NUL\NULkazo\NUL\NULkitamoto\NUL\NULkoshigaya\NUL\NULkounosu\NUL\NULkuki\NUL\NULkumagaya\NUL\NULmatsubushi\NUL\NULminano\NUL\NULmisato\NUL\NULmiyashiro\NUL\NULmiyoshi\NUL\NULmoroyama\NUL\NULnagatoro\NUL\NULnamegawa\NUL\NULniiza\NUL\NULogano\NUL\NULogawa\NUL\NULogose\NUL\NULokegawa\NUL\NULomiya\NUL\NULotaki\NUL\NULranzan\NUL\NULryokami\NUL\NULsaitama\NUL\NULsakado\NUL\NULsatte\NUL\NULsayama\NUL\NULshiki\NUL\NULshiraoka\NUL\NULsoka\NUL\NULsugito\NUL\NULtoda\NUL\NULtokigawa\NUL\NULtokorozawa\NUL\NULtsurugashima\NUL\NULurawa\NUL\NULwarabi\NUL\NULyashio\NUL\NULyokoze\NUL\NULyono\NUL\NULyorii\NUL\NULyoshida\NUL\NULyoshikawa\NUL\NULyoshimi\NUL\NUL\NULsapporo\NUL*\NUL\NUL\NULsendai\NUL*\NUL\NUL\NULshiga\NULaisho\NUL\NULgamo\NUL\NULhigashiomi\NUL\NULhikone\NUL\NULkoka\NUL\NULkonan\NUL\NULkosei\NUL\NULkoto\NUL\NULkusatsu\NUL\NULmaibara\NUL\NULmoriyama\NUL\NULnagahama\NUL\NULnishiazai\NUL\NULnotogawa\NUL\NULomihachiman\NUL\NULotsu\NUL\NULritto\NUL\NULryuoh\NUL\NULtakashima\NUL\NULtakatsuki\NUL\NULtorahime\NUL\NULtoyosato\NUL\NULyasu\NUL\NUL\NULshimane\NULakagi\NUL\NULama\NUL\NULgotsu\NUL\NULhamada\NUL\NULhigashiizumo\NUL\NULhikawa\NUL\NULhikimi\NUL\NULizumo\NUL\NULkakinoki\NUL\NULmasuda\NUL\NULmatsue\NUL\NULmisato\NUL\NULnishinoshima\NUL\NULohda\NUL\NULokinoshima\NUL\NULokuizumo\NUL\NULshimane\NUL\NULtamayu\NUL\NULtsuwano\NUL\NULunnan\NUL\NULyakumo\NUL\NULyasugi\NUL\NULyatsuka\NUL\NUL\NULshizuoka\NULarai\NUL\NULatami\NUL\NULfuji\NUL\NULfujieda\NUL\NULfujikawa\NUL\NULfujinomiya\NUL\NULfukuroi\NUL\NULgotemba\NUL\NULhaibara\NUL\NULhamamatsu\NUL\NULhigashiizu\NUL\NULito\NUL\NULiwata\NUL\NULizu\NUL\NULizunokuni\NUL\NULkakegawa\NUL\NULkannami\NUL\NULkawanehon\NUL\NULkawazu\NUL\NULkikugawa\NUL\NULkosai\NUL\NULmakinohara\NUL\NULmatsuzaki\NUL\NULminamiizu\NUL\NULmishima\NUL\NULmorimachi\NUL\NULnishiizu\NUL\NULnumazu\NUL\NULomaezaki\NUL\NULshimada\NUL\NULshimizu\NUL\NULshimoda\NUL\NULshizuoka\NUL\NULsusono\NUL\NULyaizu\NUL\NULyoshida\NUL\NUL\NULtochigi\NULashikaga\NUL\NULbato\NUL\NULhaga\NUL\NULichikai\NUL\NULiwafune\NUL\NULkaminokawa\NUL\NULkanuma\NUL\NULkarasuyama\NUL\NULkuroiso\NUL\NULmashiko\NUL\NULmibu\NUL\NULmoka\NUL\NULmotegi\NUL\NULnasu\NUL\NULnasushiobara\NUL\NULnikko\NUL\NULnishikata\NUL\NULnogi\NUL\NULohira\NUL\NULohtawara\NUL\NULoyama\NUL\NULsakura\NUL\NULsano\NUL\NULshimotsuke\NUL\NULshioya\NUL\NULtakanezawa\NUL\NULtochigi\NUL\NULtsuga\NUL\NULujiie\NUL\NULutsunomiya\NUL\NULyaita\NUL\NUL\NULtokushima\NULaizumi\NUL\NULanan\NUL\NULichiba\NUL\NULitano\NUL\NULkainan\NUL\NULkomatsushima\NUL\NULmatsushige\NUL\NULmima\NUL\NULminami\NUL\NULmiyoshi\NUL\NULmugi\NUL\NULnakagawa\NUL\NULnaruto\NUL\NULsanagochi\NUL\NULshishikui\NUL\NULtokushima\NUL\NULwajiki\NUL\NUL\NULtokyo\NULadachi\NUL\NULakiruno\NUL\NULakishima\NUL\NULaogashima\NUL\NULarakawa\NUL\NULbunkyo\NUL\NULchiyoda\NUL\NULchofu\NUL\NULchuo\NUL\NULedogawa\NUL\NULfuchu\NUL\NULfussa\NUL\NULhachijo\NUL\NULhachioji\NUL\NULhamura\NUL\NULhigashikurume\NUL\NULhigashimurayama\NUL\NULhigashiyamato\NUL\NULhino\NUL\NULhinode\NUL\NULhinohara\NUL\NULinagi\NUL\NULitabashi\NUL\NULkatsushika\NUL\NULkita\NUL\NULkiyose\NUL\NULkodaira\NUL\NULkoganei\NUL\NULkokubunji\NUL\NULkomae\NUL\NULkoto\NUL\NULkouzushima\NUL\NULkunitachi\NUL\NULmachida\NUL\NULmeguro\NUL\NULminato\NUL\NULmitaka\NUL\NULmizuho\NUL\NULmusashimurayama\NUL\NULmusashino\NUL\NULnakano\NUL\NULnerima\NUL\NULogasawara\NUL\NULokutama\NUL\NULome\NUL\NULoshima\NUL\NULota\NUL\NULsetagaya\NUL\NULshibuya\NUL\NULshinagawa\NUL\NULshinjuku\NUL\NULsuginami\NUL\NULsumida\NUL\NULtachikawa\NUL\NULtaito\NUL\NULtama\NUL\NULtoshima\NUL\NUL\NULtottori\NULchizu\NUL\NULhino\NUL\NULkawahara\NUL\NULkoge\NUL\NULkotoura\NUL\NULmisasa\NUL\NULnanbu\NUL\NULnichinan\NUL\NULsakaiminato\NUL\NULtottori\NUL\NULwakasa\NUL\NULyazu\NUL\NULyonago\NUL\NUL\NULtoyama\NULasahi\NUL\NULfuchu\NUL\NULfukumitsu\NUL\NULfunahashi\NUL\NULhimi\NUL\NULimizu\NUL\NULinami\NUL\NULjohana\NUL\NULkamiichi\NUL\NULkurobe\NUL\NULnakaniikawa\NUL\NULnamerikawa\NUL\NULnanto\NUL\NULnyuzen\NUL\NULoyabe\NUL\NULtaira\NUL\NULtakaoka\NUL\NULtateyama\NUL\NULtoga\NUL\NULtonami\NUL\NULtoyama\NUL\NULunazuki\NUL\NULuozu\NUL\NULyamada\NUL\NUL\NULwakayama\NULarida\NUL\NULaridagawa\NUL\NULgobo\NUL\NULhashimoto\NUL\NULhidaka\NUL\NULhirogawa\NUL\NULinami\NUL\NULiwade\NUL\NULkainan\NUL\NULkamitonda\NUL\NULkatsuragi\NUL\NULkimino\NUL\NULkinokawa\NUL\NULkitayama\NUL\NULkoya\NUL\NULkoza\NUL\NULkozagawa\NUL\NULkudoyama\NUL\NULkushimoto\NUL\NULmihama\NUL\NULmisato\NUL\NULnachikatsuura\NUL\NULshingu\NUL\NULshirahama\NUL\NULtaiji\NUL\NULtanabe\NUL\NULwakayama\NUL\NULyuasa\NUL\NULyura\NUL\NUL\NULxn--0trq7p7nn\NUL\NULxn--1ctwo\NUL\NULxn--1lqs03n\NUL\NULxn--1lqs71d\NUL\NULxn--2m4a15e\NUL\NULxn--32vp30h\NUL\NULxn--4it168d\NUL\NULxn--4it797k\NUL\NULxn--4pvxs\NUL\NULxn--5js045d\NUL\NULxn--5rtp49c\NUL\NULxn--5rtq34k\NUL\NULxn--6btw5a\NUL\NULxn--6orx2r\NUL\NULxn--7t0a264c\NUL\NULxn--8ltr62k\NUL\NULxn--8pvr4u\NUL\NULxn--c3s14m\NUL\NULxn--d5qv7z876c\NUL\NULxn--djrs72d6uy\NUL\NULxn--djty4k\NUL\NULxn--efvn9s\NUL\NULxn--ehqz56n\NUL\NULxn--elqq16h\NUL\NULxn--f6qx53a\NUL\NULxn--k7yn95e\NUL\NULxn--kbrq7o\NUL\NULxn--klt787d\NUL\NULxn--kltp7d\NUL\NULxn--kltx9a\NUL\NULxn--klty5x\NUL\NULxn--mkru45i\NUL\NULxn--nit225k\NUL\NULxn--ntso0iqx3a\NUL\NULxn--ntsq17g\NUL\NULxn--pssu33l\NUL\NULxn--qqqt11m\NUL\NULxn--rht27z\NUL\NULxn--rht3d\NUL\NULxn--rht61e\NUL\NULxn--rny31h\NUL\NULxn--tor131o\NUL\NULxn--uist22h\NUL\NULxn--uisz3g\NUL\NULxn--uuwu58a\NUL\NULxn--vgu402c\NUL\NULxn--zbx025d\NUL\NULyamagata\NULasahi\NUL\NULfunagata\NUL\NULhigashine\NUL\NULiide\NUL\NULkahoku\NUL\NULkaminoyama\NUL\NULkaneyama\NUL\NULkawanishi\NUL\NULmamurogawa\NUL\NULmikawa\NUL\NULmurayama\NUL\NULnagai\NUL\NULnakayama\NUL\NULnanyo\NUL\NULnishikawa\NUL\NULobanazawa\NUL\NULoe\NUL\NULoguni\NUL\NULohkura\NUL\NULoishida\NUL\NULsagae\NUL\NULsakata\NUL\NULsakegawa\NUL\NULshinjo\NUL\NULshirataka\NUL\NULshonai\NUL\NULtakahata\NUL\NULtendo\NUL\NULtozawa\NUL\NULtsuruoka\NUL\NULyamagata\NUL\NULyamanobe\NUL\NULyonezawa\NUL\NULyuza\NUL\NUL\NULyamaguchi\NULabu\NUL\NULhagi\NUL\NULhikari\NUL\NULhofu\NUL\NULiwakuni\NUL\NULkudamatsu\NUL\NULmitou\NUL\NULnagato\NUL\NULoshima\NUL\NULshimonoseki\NUL\NULshunan\NUL\NULtabuse\NUL\NULtokuyama\NUL\NULtoyota\NUL\NULube\NUL\NULyuu\NUL\NUL\NULyamanashi\NULchuo\NUL\NULdoshi\NUL\NULfuefuki\NUL\NULfujikawa\NUL\NULfujikawaguchiko\NUL\NULfujiyoshida\NUL\NULhayakawa\NUL\NULhokuto\NUL\NULichikawamisato\NUL\NULkai\NUL\NULkofu\NUL\NULkoshu\NUL\NULkosuge\NUL\NULminami-alps\NUL\NULminobu\NUL\NULnakamichi\NUL\NULnanbu\NUL\NULnarusawa\NUL\NULnirasaki\NUL\NULnishikatsura\NUL\NULoshino\NUL\NULotsuki\NUL\NULshowa\NUL\NULtabayama\NUL\NULtsuru\NUL\NULuenohara\NUL\NULyamanakako\NUL\NULyamanashi\NUL\NUL\NULyokohama\NUL*\NUL\NUL\NUL\NULjprs\NUL\NULjuegos\NUL\NULkaufen\NUL\NULkddi\NUL\NULke\NUL*\NUL\NUL\NULkfh\NUL\NULkg\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULkh\NUL*\NUL\NUL\NULki\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULnet\NUL\NULorg\NUL\NUL\NULkim\NUL\NULkinder\NUL\NULkitchen\NUL\NULkiwi\NUL\NULkm\NULass\NUL\NULasso\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgouv\NUL\NULgov\NUL\NULmedecin\NUL\NULmil\NUL\NULnom\NUL\NULnotaires\NUL\NULorg\NUL\NULpharmaciens\NUL\NULprd\NUL\NULpresse\NUL\NULtm\NUL\NULveterinaire\NUL\NUL\NULkn\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULkoeln\NUL\NULkomatsu\NUL\NULkp\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULorg\NUL\NULrep\NUL\NULtra\NUL\NUL\NULkpn\NUL\NULkr\NULac\NUL\NULblogspot\NUL\NULbusan\NUL\NULchungbuk\NUL\NULchungnam\NUL\NULco\NUL\NULdaegu\NUL\NULdaejeon\NUL\NULes\NUL\NULgangwon\NUL\NULgo\NUL\NULgwangju\NUL\NULgyeongbuk\NUL\NULgyeonggi\NUL\NULgyeongnam\NUL\NULhs\NUL\NULincheon\NUL\NULjeju\NUL\NULjeonbuk\NUL\NULjeonnam\NUL\NULkg\NUL\NULmil\NUL\NULms\NUL\NULne\NUL\NULor\NUL\NULpe\NUL\NULre\NUL\NULsc\NUL\NULseoul\NUL\NULulsan\NUL\NUL\NULkrd\NUL\NULkred\NUL\NULkw\NUL*\NUL\NUL\NULky\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULkyknet\NUL\NULkyoto\NUL\NULkz\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULla\NULc\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULnet\NUL\NULorg\NUL\NULper\NUL\NUL\NULlacaixa\NUL\NULlancaster\NUL\NULland\NUL\NULlandrover\NUL\NULlasalle\NUL\NULlat\NUL\NULlatrobe\NUL\NULlaw\NUL\NULlawyer\NUL\NULlb\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULlc\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULlds\NUL\NULlease\NUL\NULleclerc\NUL\NULlegal\NUL\NULlgbt\NUL\NULli\NUL\NULliaison\NUL\NULlidl\NUL\NULlife\NUL\NULlifeinsurance\NUL\NULlifestyle\NUL\NULlighting\NUL\NULlike\NUL\NULlimited\NUL\NULlimo\NUL\NULlincoln\NUL\NULlinde\NUL\NULlink\NUL\NULlive\NUL\NULlixil\NUL\NULlk\NULassn\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULgrp\NUL\NULhotel\NUL\NULint\NUL\NULltd\NUL\NULnet\NUL\NULngo\NUL\NULorg\NUL\NULsch\NUL\NULsoc\NUL\NULweb\NUL\NUL\NULloan\NUL\NULloans\NUL\NULlol\NUL\NULlondon\NUL\NULlotte\NUL\NULlotto\NUL\NULlove\NUL\NULlr\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULls\NULco\NUL\NULorg\NUL\NUL\NULlt\NULgov\NUL\NUL\NULltd\NUL\NULltda\NUL\NULlu\NUL\NULlupin\NUL\NULluxe\NUL\NULluxury\NUL\NULlv\NULasn\NUL\NULcom\NUL\NULconf\NUL\NULedu\NUL\NULgov\NUL\NULid\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULly\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULid\NUL\NULmed\NUL\NULnet\NUL\NULorg\NUL\NULplc\NUL\NULsch\NUL\NUL\NULma\NULac\NUL\NULco\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULpress\NUL\NUL\NULmadrid\NUL\NULmaif\NUL\NULmaison\NUL\NULmakeup\NUL\NULman\NUL\NULmanagement\NUL\NULmango\NUL\NULmarket\NUL\NULmarketing\NUL\NULmarkets\NUL\NULmarriott\NUL\NULmba\NUL\NULmc\NULasso\NUL\NULtm\NUL\NUL\NULmd\NUL\NULme\NULac\NUL\NULco\NUL\NULedu\NUL\NULgov\NUL\NULits\NUL\NULnet\NUL\NULorg\NUL\NULpriv\NUL\NUL\NULmedia\NUL\NULmeet\NUL\NULmelbourne\NUL\NULmeme\NUL\NULmemorial\NUL\NULmen\NUL\NULmenu\NUL\NULmeo\NUL\NULmg\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnom\NUL\NULorg\NUL\NULprd\NUL\NULtm\NUL\NUL\NULmh\NUL\NULmiami\NUL\NULmicrosoft\NUL\NULmil\NUL\NULmini\NUL\NULmk\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinf\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NUL\NULml\NULcom\NUL\NULedu\NUL\NULgouv\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULpresse\NUL\NUL\NULmm\NUL*\NUL\NUL\NULmma\NUL\NULmn\NULedu\NUL\NULgov\NUL\NULnyc\NUL\NULorg\NUL\NUL\NULmnet\NUL\NULmo\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmobi\NUL\NULmobily\NUL\NULmoda\NUL\NULmoe\NUL\NULmoi\NUL\NULmonash\NUL\NULmoney\NUL\NULmontblanc\NUL\NULmormon\NUL\NULmortgage\NUL\NULmoscow\NUL\NULmotorcycles\NUL\NULmov\NUL\NULmovie\NUL\NULmovistar\NUL\NULmp\NUL\NULmq\NUL\NULmr\NULblogspot\NUL\NULgov\NUL\NUL\NULms\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmt\NULcom\NUL\NULedu\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmtn\NUL\NULmtpc\NUL\NULmtr\NUL\NULmu\NULac\NUL\NULco\NUL\NULcom\NUL\NULgov\NUL\NULnet\NUL\NULor\NUL\NULorg\NUL\NUL\NULmultichoice\NUL\NULmuseum\NULacademy\NUL\NULagriculture\NUL\NULair\NUL\NULairguard\NUL\NULalabama\NUL\NULalaska\NUL\NULamber\NUL\NULambulance\NUL\NULamerican\NUL\NULamericana\NUL\NULamericanantiques\NUL\NULamericanart\NUL\NULamsterdam\NUL\NULand\NUL\NULannefrank\NUL\NULanthro\NUL\NULanthropology\NUL\NULantiques\NUL\NULaquarium\NUL\NULarboretum\NUL\NULarchaeological\NUL\NULarchaeology\NUL\NULarchitecture\NUL\NULart\NUL\NULartanddesign\NUL\NULartcenter\NUL\NULartdeco\NUL\NULarteducation\NUL\NULartgallery\NUL\NULarts\NUL\NULartsandcrafts\NUL\NULasmatart\NUL\NULassassination\NUL\NULassisi\NUL\NULassociation\NUL\NULastronomy\NUL\NULatlanta\NUL\NULaustin\NUL\NULaustralia\NUL\NULautomotive\NUL\NULaviation\NUL\NULaxis\NUL\NULbadajoz\NUL\NULbaghdad\NUL\NULbahn\NUL\NULbale\NUL\NULbaltimore\NUL\NULbarcelona\NUL\NULbaseball\NUL\NULbasel\NUL\NULbaths\NUL\NULbauern\NUL\NULbeauxarts\NUL\NULbeeldengeluid\NUL\NULbellevue\NUL\NULbergbau\NUL\NULberkeley\NUL\NULberlin\NUL\NULbern\NUL\NULbible\NUL\NULbilbao\NUL\NULbill\NUL\NULbirdart\NUL\NULbirthplace\NUL\NULbonn\NUL\NULboston\NUL\NULbotanical\NUL\NULbotanicalgarden\NUL\NULbotanicgarden\NUL\NULbotany\NUL\NULbrandywinevalley\NUL\NULbrasil\NUL\NULbristol\NUL\NULbritish\NUL\NULbritishcolumbia\NUL\NULbroadcast\NUL\NULbrunel\NUL\NULbrussel\NUL\NULbrussels\NUL\NULbruxelles\NUL\NULbuilding\NUL\NULburghof\NUL\NULbus\NUL\NULbushey\NUL\NULcadaques\NUL\NULcalifornia\NUL\NULcambridge\NUL\NULcan\NUL\NULcanada\NUL\NULcapebreton\NUL\NULcarrier\NUL\NULcartoonart\NUL\NULcasadelamoneda\NUL\NULcastle\NUL\NULcastres\NUL\NULceltic\NUL\NULcenter\NUL\NULchattanooga\NUL\NULcheltenham\NUL\NULchesapeakebay\NUL\NULchicago\NUL\NULchildren\NUL\NULchildrens\NUL\NULchildrensgarden\NUL\NULchiropractic\NUL\NULchocolate\NUL\NULchristiansburg\NUL\NULcincinnati\NUL\NULcinema\NUL\NULcircus\NUL\NULcivilisation\NUL\NULcivilization\NUL\NULcivilwar\NUL\NULclinton\NUL\NULclock\NUL\NULcoal\NUL\NULcoastaldefence\NUL\NULcody\NUL\NULcoldwar\NUL\NULcollection\NUL\NULcolonialwilliamsburg\NUL\NULcoloradoplateau\NUL\NULcolumbia\NUL\NULcolumbus\NUL\NULcommunication\NUL\NULcommunications\NUL\NULcommunity\NUL\NULcomputer\NUL\NULcomputerhistory\NUL\NULcontemporary\NUL\NULcontemporaryart\NUL\NULconvent\NUL\NULcopenhagen\NUL\NULcorporation\NUL\NULcorvette\NUL\NULcostume\NUL\NULcountryestate\NUL\NULcounty\NUL\NULcrafts\NUL\NULcranbrook\NUL\NULcreation\NUL\NULcultural\NUL\NULculturalcenter\NUL\NULculture\NUL\NULcyber\NUL\NULcymru\NUL\NULdali\NUL\NULdallas\NUL\NULdatabase\NUL\NULddr\NUL\NULdecorativearts\NUL\NULdelaware\NUL\NULdelmenhorst\NUL\NULdenmark\NUL\NULdepot\NUL\NULdesign\NUL\NULdetroit\NUL\NULdinosaur\NUL\NULdiscovery\NUL\NULdolls\NUL\NULdonostia\NUL\NULdurham\NUL\NULeastafrica\NUL\NULeastcoast\NUL\NULeducation\NUL\NULeducational\NUL\NULegyptian\NUL\NULeisenbahn\NUL\NULelburg\NUL\NULelvendrell\NUL\NULembroidery\NUL\NULencyclopedic\NUL\NULengland\NUL\NULentomology\NUL\NULenvironment\NUL\NULenvironmentalconservation\NUL\NULepilepsy\NUL\NULessex\NUL\NULestate\NUL\NULethnology\NUL\NULexeter\NUL\NULexhibition\NUL\NULfamily\NUL\NULfarm\NUL\NULfarmequipment\NUL\NULfarmers\NUL\NULfarmstead\NUL\NULfield\NUL\NULfigueres\NUL\NULfilatelia\NUL\NULfilm\NUL\NULfineart\NUL\NULfinearts\NUL\NULfinland\NUL\NULflanders\NUL\NULflorida\NUL\NULforce\NUL\NULfortmissoula\NUL\NULfortworth\NUL\NULfoundation\NUL\NULfrancaise\NUL\NULfrankfurt\NUL\NULfranziskaner\NUL\NULfreemasonry\NUL\NULfreiburg\NUL\NULfribourg\NUL\NULfrog\NUL\NULfundacio\NUL\NULfurniture\NUL\NULgallery\NUL\NULgarden\NUL\NULgateway\NUL\NULgeelvinck\NUL\NULgemological\NUL\NULgeology\NUL\NULgeorgia\NUL\NULgiessen\NUL\NULglas\NUL\NULglass\NUL\NULgorge\NUL\NULgrandrapids\NUL\NULgraz\NUL\NULguernsey\NUL\NULhalloffame\NUL\NULhamburg\NUL\NULhandson\NUL\NULharvestcelebration\NUL\NULhawaii\NUL\NULhealth\NUL\NULheimatunduhren\NUL\NULhellas\NUL\NULhelsinki\NUL\NULhembygdsforbund\NUL\NULheritage\NUL\NULhistoire\NUL\NULhistorical\NUL\NULhistoricalsociety\NUL\NULhistorichouses\NUL\NULhistorisch\NUL\NULhistorisches\NUL\NULhistory\NUL\NULhistoryofscience\NUL\NULhorology\NUL\NULhouse\NUL\NULhumanities\NUL\NULillustration\NUL\NULimageandsound\NUL\NULindian\NUL\NULindiana\NUL\NULindianapolis\NUL\NULindianmarket\NUL\NULintelligence\NUL\NULinteractive\NUL\NULiraq\NUL\NULiron\NUL\NULisleofman\NUL\NULjamison\NUL\NULjefferson\NUL\NULjerusalem\NUL\NULjewelry\NUL\NULjewish\NUL\NULjewishart\NUL\NULjfk\NUL\NULjournalism\NUL\NULjudaica\NUL\NULjudygarland\NUL\NULjuedisches\NUL\NULjuif\NUL\NULkarate\NUL\NULkarikatur\NUL\NULkids\NUL\NULkoebenhavn\NUL\NULkoeln\NUL\NULkunst\NUL\NULkunstsammlung\NUL\NULkunstunddesign\NUL\NULlabor\NUL\NULlabour\NUL\NULlajolla\NUL\NULlancashire\NUL\NULlandes\NUL\NULlans\NUL\NULlarsson\NUL\NULlewismiller\NUL\NULlincoln\NUL\NULlinz\NUL\NULliving\NUL\NULlivinghistory\NUL\NULlocalhistory\NUL\NULlondon\NUL\NULlosangeles\NUL\NULlouvre\NUL\NULloyalist\NUL\NULlucerne\NUL\NULluxembourg\NUL\NULluzern\NUL\NULmad\NUL\NULmadrid\NUL\NULmallorca\NUL\NULmanchester\NUL\NULmansion\NUL\NULmansions\NUL\NULmanx\NUL\NULmarburg\NUL\NULmaritime\NUL\NULmaritimo\NUL\NULmaryland\NUL\NULmarylhurst\NUL\NULmedia\NUL\NULmedical\NUL\NULmedizinhistorisches\NUL\NULmeeres\NUL\NULmemorial\NUL\NULmesaverde\NUL\NULmichigan\NUL\NULmidatlantic\NUL\NULmilitary\NUL\NULmill\NUL\NULminers\NUL\NULmining\NUL\NULminnesota\NUL\NULmissile\NUL\NULmissoula\NUL\NULmodern\NUL\NULmoma\NUL\NULmoney\NUL\NULmonmouth\NUL\NULmonticello\NUL\NULmontreal\NUL\NULmoscow\NUL\NULmotorcycle\NUL\NULmuenchen\NUL\NULmuenster\NUL\NULmulhouse\NUL\NULmuncie\NUL\NULmuseet\NUL\NULmuseumcenter\NUL\NULmuseumvereniging\NUL\NULmusic\NUL\NULnational\NUL\NULnationalfirearms\NUL\NULnationalheritage\NUL\NULnativeamerican\NUL\NULnaturalhistory\NUL\NULnaturalhistorymuseum\NUL\NULnaturalsciences\NUL\NULnature\NUL\NULnaturhistorisches\NUL\NULnatuurwetenschappen\NUL\NULnaumburg\NUL\NULnaval\NUL\NULnebraska\NUL\NULneues\NUL\NULnewhampshire\NUL\NULnewjersey\NUL\NULnewmexico\NUL\NULnewport\NUL\NULnewspaper\NUL\NULnewyork\NUL\NULniepce\NUL\NULnorfolk\NUL\NULnorth\NUL\NULnrw\NUL\NULnuernberg\NUL\NULnuremberg\NUL\NULnyc\NUL\NULnyny\NUL\NULoceanographic\NUL\NULoceanographique\NUL\NULomaha\NUL\NULonline\NUL\NULontario\NUL\NULopenair\NUL\NULoregon\NUL\NULoregontrail\NUL\NULotago\NUL\NULoxford\NUL\NULpacific\NUL\NULpaderborn\NUL\NULpalace\NUL\NULpaleo\NUL\NULpalmsprings\NUL\NULpanama\NUL\NULparis\NUL\NULpasadena\NUL\NULpharmacy\NUL\NULphiladelphia\NUL\NULphiladelphiaarea\NUL\NULphilately\NUL\NULphoenix\NUL\NULphotography\NUL\NULpilots\NUL\NULpittsburgh\NUL\NULplanetarium\NUL\NULplantation\NUL\NULplants\NUL\NULplaza\NUL\NULportal\NUL\NULportland\NUL\NULportlligat\NUL\NULposts-and-telecommunications\NUL\NULpreservation\NUL\NULpresidio\NUL\NULpress\NUL\NULproject\NUL\NULpublic\NUL\NULpubol\NUL\NULquebec\NUL\NULrailroad\NUL\NULrailway\NUL\NULresearch\NUL\NULresistance\NUL\NULriodejaneiro\NUL\NULrochester\NUL\NULrockart\NUL\NULroma\NUL\NULrussia\NUL\NULsaintlouis\NUL\NULsalem\NUL\NULsalvadordali\NUL\NULsalzburg\NUL\NULsandiego\NUL\NULsanfrancisco\NUL\NULsantabarbara\NUL\NULsantacruz\NUL\NULsantafe\NUL\NULsaskatchewan\NUL\NULsatx\NUL\NULsavannahga\NUL\NULschlesisches\NUL\NULschoenbrunn\NUL\NULschokoladen\NUL\NULschool\NUL\NULschweiz\NUL\NULscience\NUL\NULscience-fiction\NUL\NULscienceandhistory\NUL\NULscienceandindustry\NUL\NULsciencecenter\NUL\NULsciencecenters\NUL\NULsciencehistory\NUL\NULsciences\NUL\NULsciencesnaturelles\NUL\NULscotland\NUL\NULseaport\NUL\NULsettlement\NUL\NULsettlers\NUL\NULshell\NUL\NULsherbrooke\NUL\NULsibenik\NUL\NULsilk\NUL\NULski\NUL\NULskole\NUL\NULsociety\NUL\NULsologne\NUL\NULsoundandvision\NUL\NULsouthcarolina\NUL\NULsouthwest\NUL\NULspace\NUL\NULspy\NUL\NULsquare\NUL\NULstadt\NUL\NULstalbans\NUL\NULstarnberg\NUL\NULstate\NUL\NULstateofdelaware\NUL\NULstation\NUL\NULsteam\NUL\NULsteiermark\NUL\NULstjohn\NUL\NULstockholm\NUL\NULstpetersburg\NUL\NULstuttgart\NUL\NULsuisse\NUL\NULsurgeonshall\NUL\NULsurrey\NUL\NULsvizzera\NUL\NULsweden\NUL\NULsydney\NUL\NULtank\NUL\NULtcm\NUL\NULtechnology\NUL\NULtelekommunikation\NUL\NULtelevision\NUL\NULtexas\NUL\NULtextile\NUL\NULtheater\NUL\NULtime\NUL\NULtimekeeping\NUL\NULtopology\NUL\NULtorino\NUL\NULtouch\NUL\NULtown\NUL\NULtransport\NUL\NULtree\NUL\NULtrolley\NUL\NULtrust\NUL\NULtrustee\NUL\NULuhren\NUL\NULulm\NUL\NULundersea\NUL\NULuniversity\NUL\NULusa\NUL\NULusantiques\NUL\NULusarts\NUL\NULuscountryestate\NUL\NULusculture\NUL\NULusdecorativearts\NUL\NULusgarden\NUL\NULushistory\NUL\NULushuaia\NUL\NULuslivinghistory\NUL\NULutah\NUL\NULuvic\NUL\NULvalley\NUL\NULvantaa\NUL\NULversailles\NUL\NULviking\NUL\NULvillage\NUL\NULvirginia\NUL\NULvirtual\NUL\NULvirtuel\NUL\NULvlaanderen\NUL\NULvolkenkunde\NUL\NULwales\NUL\NULwallonie\NUL\NULwar\NUL\NULwashingtondc\NUL\NULwatch-and-clock\NUL\NULwatchandclock\NUL\NULwestern\NUL\NULwestfalen\NUL\NULwhaling\NUL\NULwildlife\NUL\NULwilliamsburg\NUL\NULwindmill\NUL\NULworkshop\NUL\NULxn--9dbhblg6di\NUL\NULxn--comunicaes-v6a2o\NUL\NULxn--correios-e-telecomunicaes-ghc29a\NUL\NULxn--h1aegh\NUL\NULxn--lns-qla\NUL\NULyork\NUL\NULyorkshire\NUL\NULyosemite\NUL\NULyouth\NUL\NULzoological\NUL\NULzoology\NUL\NUL\NULmutual\NUL\NULmv\NULaero\NUL\NULbiz\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULmil\NUL\NULmuseum\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NUL\NULmw\NULac\NUL\NULbiz\NUL\NULco\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgov\NUL\NULint\NUL\NULmuseum\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmx\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmy\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NUL\NULmz\NUL*\NUL\NUL\NULmzansimagic\NUL\NULna\NULca\NUL\NULcc\NUL\NULco\NUL\NULcom\NUL\NULdr\NUL\NULin\NUL\NULinfo\NUL\NULmobi\NUL\NULmx\NUL\NULname\NUL\NULor\NUL\NULorg\NUL\NULpro\NUL\NULschool\NUL\NULtv\NUL\NULus\NUL\NULws\NUL\NUL\NULnadex\NUL\NULnagoya\NUL\NULname\NULher\NULforgot\NUL\NUL\NULhis\NULforgot\NUL\NUL\NUL\NULnaspers\NUL\NULnatura\NUL\NULnavy\NUL\NULnc\NULasso\NUL\NUL\NULne\NUL\NULnec\NUL\NULnet\NULat-band-camp\NUL\NULazure-mobile\NUL\NULazurewebsites\NUL\NULblogdns\NUL\NULbroke-it\NUL\NULbuyshouses\NUL\NULcloudapp\NUL\NULcloudfront\NUL\NULdnsalias\NUL\NULdnsdojo\NUL\NULdoes-it\NUL\NULdontexist\NUL\NULdynalias\NUL\NULdynathome\NUL\NULendofinternet\NUL\NULfastly\NULprod\NULa\NUL\NULglobal\NUL\NUL\NULssl\NULa\NUL\NULb\NUL\NULglobal\NUL\NUL\NUL\NULfrom-az\NUL\NULfrom-co\NUL\NULfrom-la\NUL\NULfrom-ny\NUL\NULgb\NUL\NULgets-it\NUL\NULham-radio-op\NUL\NULhomeftp\NUL\NULhomeip\NUL\NULhomelinux\NUL\NULhomeunix\NUL\NULhu\NUL\NULin\NUL\NULin-the-band\NUL\NULis-a-chef\NUL\NULis-a-geek\NUL\NULisa-geek\NUL\NULjp\NUL\NULkicks-ass\NUL\NULoffice-on-the\NUL\NULpodzone\NUL\NULscrapper-site\NUL\NULse\NUL\NULselfip\NUL\NULsells-it\NUL\NULservebbs\NUL\NULserveftp\NUL\NULthruhere\NUL\NULuk\NUL\NULwebhop\NUL\NULza\NUL\NUL\NULnetbank\NUL\NULnetwork\NUL\NULneustar\NUL\NULnew\NUL\NULnews\NUL\NULnexus\NUL\NULnf\NULarts\NUL\NULcom\NUL\NULfirm\NUL\NULinfo\NUL\NULnet\NUL\NULother\NUL\NULper\NUL\NULrec\NUL\NULstore\NUL\NULweb\NUL\NUL\NULng\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULmobi\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NUL\NULngo\NUL\NULnhk\NUL\NULni\NUL*\NUL\NUL\NULnico\NUL\NULninja\NUL\NULnissan\NUL\NULnl\NULblogspot\NUL\NULbv\NUL\NULco\NUL\NUL\NULno\NULaa\NULgs\NUL\NUL\NULaarborte\NUL\NULaejrie\NUL\NULafjord\NUL\NULagdenes\NUL\NULah\NULgs\NUL\NUL\NULakershus\NULnes\NUL\NUL\NULaknoluokta\NUL\NULakrehamn\NUL\NULal\NUL\NULalaheadju\NUL\NULalesund\NUL\NULalgard\NUL\NULalstahaug\NUL\NULalta\NUL\NULalvdal\NUL\NULamli\NUL\NULamot\NUL\NULandasuolo\NUL\NULandebu\NUL\NULandoy\NUL\NULardal\NUL\NULaremark\NUL\NULarendal\NUL\NULarna\NUL\NULaseral\NUL\NULasker\NUL\NULaskim\NUL\NULaskoy\NUL\NULaskvoll\NUL\NULasnes\NUL\NULaudnedaln\NUL\NULaukra\NUL\NULaure\NUL\NULaurland\NUL\NULaurskog-holand\NUL\NULaustevoll\NUL\NULaustrheim\NUL\NULaveroy\NUL\NULbadaddja\NUL\NULbahcavuotna\NUL\NULbahccavuotna\NUL\NULbaidar\NUL\NULbajddar\NUL\NULbalat\NUL\NULbalestrand\NUL\NULballangen\NUL\NULbalsfjord\NUL\NULbamble\NUL\NULbardu\NUL\NULbarum\NUL\NULbatsfjord\NUL\NULbearalvahki\NUL\NULbeardu\NUL\NULbeiarn\NUL\NULberg\NUL\NULbergen\NUL\NULberlevag\NUL\NULbievat\NUL\NULbindal\NUL\NULbirkenes\NUL\NULbjarkoy\NUL\NULbjerkreim\NUL\NULbjugn\NUL\NULblogspot\NUL\NULbodo\NUL\NULbokn\NUL\NULbomlo\NUL\NULbremanger\NUL\NULbronnoy\NUL\NULbronnoysund\NUL\NULbrumunddal\NUL\NULbryne\NUL\NULbu\NULgs\NUL\NUL\NULbudejju\NUL\NULbuskerud\NULnes\NUL\NUL\NULbygland\NUL\NULbykle\NUL\NULcahcesuolo\NUL\NULco\NUL\NULdavvenjarga\NUL\NULdavvesiida\NUL\NULdeatnu\NUL\NULdep\NUL\NULdielddanuorri\NUL\NULdivtasvuodna\NUL\NULdivttasvuotna\NUL\NULdonna\NUL\NULdovre\NUL\NULdrammen\NUL\NULdrangedal\NUL\NULdrobak\NUL\NULdyroy\NUL\NULegersund\NUL\NULeid\NUL\NULeidfjord\NUL\NULeidsberg\NUL\NULeidskog\NUL\NULeidsvoll\NUL\NULeigersund\NUL\NULelverum\NUL\NULenebakk\NUL\NULengerdal\NUL\NULetne\NUL\NULetnedal\NUL\NULevenassi\NUL\NULevenes\NUL\NULevje-og-hornnes\NUL\NULfarsund\NUL\NULfauske\NUL\NULfedje\NUL\NULfet\NUL\NULfetsund\NUL\NULfhs\NUL\NULfinnoy\NUL\NULfitjar\NUL\NULfjaler\NUL\NULfjell\NUL\NULfla\NUL\NULflakstad\NUL\NULflatanger\NUL\NULflekkefjord\NUL\NULflesberg\NUL\NULflora\NUL\NULfloro\NUL\NULfm\NULgs\NUL\NUL\NULfolkebibl\NUL\NULfolldal\NUL\NULforde\NUL\NULforsand\NUL\NULfosnes\NUL\NULfrana\NUL\NULfredrikstad\NUL\NULfrei\NUL\NULfrogn\NUL\NULfroland\NUL\NULfrosta\NUL\NULfroya\NUL\NULfuoisku\NUL\NULfuossko\NUL\NULfusa\NUL\NULfylkesbibl\NUL\NULfyresdal\NUL\NULgaivuotna\NUL\NULgalsa\NUL\NULgamvik\NUL\NULgangaviika\NUL\NULgaular\NUL\NULgausdal\NUL\NULgiehtavuoatna\NUL\NULgildeskal\NUL\NULgiske\NUL\NULgjemnes\NUL\NULgjerdrum\NUL\NULgjerstad\NUL\NULgjesdal\NUL\NULgjovik\NUL\NULgloppen\NUL\NULgol\NUL\NULgran\NUL\NULgrane\NUL\NULgranvin\NUL\NULgratangen\NUL\NULgrimstad\NUL\NULgrong\NUL\NULgrue\NUL\NULgulen\NUL\NULguovdageaidnu\NUL\NULha\NUL\NULhabmer\NUL\NULhadsel\NUL\NULhagebostad\NUL\NULhalden\NUL\NULhalsa\NUL\NULhamar\NUL\NULhamaroy\NUL\NULhammarfeasta\NUL\NULhammerfest\NUL\NULhapmir\NUL\NULharam\NUL\NULhareid\NUL\NULharstad\NUL\NULhasvik\NUL\NULhattfjelldal\NUL\NULhaugesund\NUL\NULhedmark\NULos\NUL\NULvaler\NUL\NULxn--vler-qoa\NUL\NUL\NULhemne\NUL\NULhemnes\NUL\NULhemsedal\NUL\NULherad\NUL\NULhitra\NUL\NULhjartdal\NUL\NULhjelmeland\NUL\NULhl\NULgs\NUL\NUL\NULhm\NULgs\NUL\NUL\NULhobol\NUL\NULhof\NUL\NULhokksund\NUL\NULhol\NUL\NULhole\NUL\NULholmestrand\NUL\NULholtalen\NUL\NULhonefoss\NUL\NULhordaland\NULos\NUL\NUL\NULhornindal\NUL\NULhorten\NUL\NULhoyanger\NUL\NULhoylandet\NUL\NULhurdal\NUL\NULhurum\NUL\NULhvaler\NUL\NULhyllestad\NUL\NULibestad\NUL\NULidrett\NUL\NULinderoy\NUL\NULiveland\NUL\NULivgu\NUL\NULjan-mayen\NULgs\NUL\NUL\NULjessheim\NUL\NULjevnaker\NUL\NULjolster\NUL\NULjondal\NUL\NULjorpeland\NUL\NULkafjord\NUL\NULkarasjohka\NUL\NULkarasjok\NUL\NULkarlsoy\NUL\NULkarmoy\NUL\NULkautokeino\NUL\NULkirkenes\NUL\NULklabu\NUL\NULklepp\NUL\NULkommune\NUL\NULkongsberg\NUL\NULkongsvinger\NUL\NULkopervik\NUL\NULkraanghke\NUL\NULkragero\NUL\NULkristiansand\NUL\NULkristiansund\NUL\NULkrodsherad\NUL\NULkrokstadelva\NUL\NULkvafjord\NUL\NULkvalsund\NUL\NULkvam\NUL\NULkvanangen\NUL\NULkvinesdal\NUL\NULkvinnherad\NUL\NULkviteseid\NUL\NULkvitsoy\NUL\NULlaakesvuemie\NUL\NULlahppi\NUL\NULlangevag\NUL\NULlardal\NUL\NULlarvik\NUL\NULlavagis\NUL\NULlavangen\NUL\NULleangaviika\NUL\NULlebesby\NUL\NULleikanger\NUL\NULleirfjord\NUL\NULleirvik\NUL\NULleka\NUL\NULleksvik\NUL\NULlenvik\NUL\NULlerdal\NUL\NULlesja\NUL\NULlevanger\NUL\NULlier\NUL\NULlierne\NUL\NULlillehammer\NUL\NULlillesand\NUL\NULlindas\NUL\NULlindesnes\NUL\NULloabat\NUL\NULlodingen\NUL\NULlom\NUL\NULloppa\NUL\NULlorenskog\NUL\NULloten\NUL\NULlund\NUL\NULlunner\NUL\NULluroy\NUL\NULluster\NUL\NULlyngdal\NUL\NULlyngen\NUL\NULmalatvuopmi\NUL\NULmalselv\NUL\NULmalvik\NUL\NULmandal\NUL\NULmarker\NUL\NULmarnardal\NUL\NULmasfjorden\NUL\NULmasoy\NUL\NULmatta-varjjat\NUL\NULmeland\NUL\NULmeldal\NUL\NULmelhus\NUL\NULmeloy\NUL\NULmeraker\NUL\NULmidsund\NUL\NULmidtre-gauldal\NUL\NULmil\NUL\NULmjondalen\NUL\NULmo-i-rana\NUL\NULmoareke\NUL\NULmodalen\NUL\NULmodum\NUL\NULmolde\NUL\NULmore-og-romsdal\NULheroy\NUL\NULsande\NUL\NUL\NULmosjoen\NUL\NULmoskenes\NUL\NULmoss\NUL\NULmosvik\NUL\NULmr\NULgs\NUL\NUL\NULmuosat\NUL\NULmuseum\NUL\NULnaamesjevuemie\NUL\NULnamdalseid\NUL\NULnamsos\NUL\NULnamsskogan\NUL\NULnannestad\NUL\NULnaroy\NUL\NULnarviika\NUL\NULnarvik\NUL\NULnaustdal\NUL\NULnavuotna\NUL\NULnedre-eiker\NUL\NULnesna\NUL\NULnesodden\NUL\NULnesoddtangen\NUL\NULnesseby\NUL\NULnesset\NUL\NULnissedal\NUL\NULnittedal\NUL\NULnl\NULgs\NUL\NUL\NULnord-aurdal\NUL\NULnord-fron\NUL\NULnord-odal\NUL\NULnorddal\NUL\NULnordkapp\NUL\NULnordland\NULbo\NUL\NULheroy\NUL\NULxn--b-5ga\NUL\NULxn--hery-ira\NUL\NUL\NULnordre-land\NUL\NULnordreisa\NUL\NULnore-og-uvdal\NUL\NULnotodden\NUL\NULnotteroy\NUL\NULnt\NULgs\NUL\NUL\NULodda\NUL\NULof\NULgs\NUL\NUL\NULoksnes\NUL\NULol\NULgs\NUL\NUL\NULomasvuotna\NUL\NULoppdal\NUL\NULoppegard\NUL\NULorkanger\NUL\NULorkdal\NUL\NULorland\NUL\NULorskog\NUL\NULorsta\NUL\NULosen\NUL\NULoslo\NULgs\NUL\NUL\NULosoyro\NUL\NULosteroy\NUL\NULostfold\NULvaler\NUL\NUL\NULostre-toten\NUL\NULoverhalla\NUL\NULovre-eiker\NUL\NULoyer\NUL\NULoygarden\NUL\NULoystre-slidre\NUL\NULporsanger\NUL\NULporsangu\NUL\NULporsgrunn\NUL\NULpriv\NUL\NULrade\NUL\NULradoy\NUL\NULrahkkeravju\NUL\NULraholt\NUL\NULraisa\NUL\NULrakkestad\NUL\NULralingen\NUL\NULrana\NUL\NULrandaberg\NUL\NULrauma\NUL\NULrendalen\NUL\NULrennebu\NUL\NULrennesoy\NUL\NULrindal\NUL\NULringebu\NUL\NULringerike\NUL\NULringsaker\NUL\NULrisor\NUL\NULrissa\NUL\NULrl\NULgs\NUL\NUL\NULroan\NUL\NULrodoy\NUL\NULrollag\NUL\NULromsa\NUL\NULromskog\NUL\NULroros\NUL\NULrost\NUL\NULroyken\NUL\NULroyrvik\NUL\NULruovat\NUL\NULrygge\NUL\NULsalangen\NUL\NULsalat\NUL\NULsaltdal\NUL\NULsamnanger\NUL\NULsandefjord\NUL\NULsandnes\NUL\NULsandnessjoen\NUL\NULsandoy\NUL\NULsarpsborg\NUL\NULsauda\NUL\NULsauherad\NUL\NULsel\NUL\NULselbu\NUL\NULselje\NUL\NULseljord\NUL\NULsf\NULgs\NUL\NUL\NULsiellak\NUL\NULsigdal\NUL\NULsiljan\NUL\NULsirdal\NUL\NULskanit\NUL\NULskanland\NUL\NULskaun\NUL\NULskedsmo\NUL\NULskedsmokorset\NUL\NULski\NUL\NULskien\NUL\NULskierva\NUL\NULskiptvet\NUL\NULskjak\NUL\NULskjervoy\NUL\NULskodje\NUL\NULslattum\NUL\NULsmola\NUL\NULsnaase\NUL\NULsnasa\NUL\NULsnillfjord\NUL\NULsnoasa\NUL\NULsogndal\NUL\NULsogne\NUL\NULsokndal\NUL\NULsola\NUL\NULsolund\NUL\NULsomna\NUL\NULsondre-land\NUL\NULsongdalen\NUL\NULsor-aurdal\NUL\NULsor-fron\NUL\NULsor-odal\NUL\NULsor-varanger\NUL\NULsorfold\NUL\NULsorreisa\NUL\NULsortland\NUL\NULsorum\NUL\NULspjelkavik\NUL\NULspydeberg\NUL\NULst\NULgs\NUL\NUL\NULstange\NUL\NULstat\NUL\NULstathelle\NUL\NULstavanger\NUL\NULstavern\NUL\NULsteigen\NUL\NULsteinkjer\NUL\NULstjordal\NUL\NULstjordalshalsen\NUL\NULstokke\NUL\NULstor-elvdal\NUL\NULstord\NUL\NULstordal\NUL\NULstorfjord\NUL\NULstrand\NUL\NULstranda\NUL\NULstryn\NUL\NULsula\NUL\NULsuldal\NUL\NULsund\NUL\NULsunndal\NUL\NULsurnadal\NUL\NULsvalbard\NULgs\NUL\NUL\NULsveio\NUL\NULsvelvik\NUL\NULsykkylven\NUL\NULtana\NUL\NULtananger\NUL\NULtelemark\NULbo\NUL\NULxn--b-5ga\NUL\NUL\NULtime\NUL\NULtingvoll\NUL\NULtinn\NUL\NULtjeldsund\NUL\NULtjome\NUL\NULtm\NULgs\NUL\NUL\NULtokke\NUL\NULtolga\NUL\NULtonsberg\NUL\NULtorsken\NUL\NULtr\NULgs\NUL\NUL\NULtrana\NUL\NULtranby\NUL\NULtranoy\NUL\NULtroandin\NUL\NULtrogstad\NUL\NULtromsa\NUL\NULtromso\NUL\NULtrondheim\NUL\NULtrysil\NUL\NULtvedestrand\NUL\NULtydal\NUL\NULtynset\NUL\NULtysfjord\NUL\NULtysnes\NUL\NULtysvar\NUL\NULullensaker\NUL\NULullensvang\NUL\NULulvik\NUL\NULunjarga\NUL\NULutsira\NUL\NULva\NULgs\NUL\NUL\NULvaapste\NUL\NULvadso\NUL\NULvaga\NUL\NULvagan\NUL\NULvagsoy\NUL\NULvaksdal\NUL\NULvalle\NUL\NULvang\NUL\NULvanylven\NUL\NULvardo\NUL\NULvarggat\NUL\NULvaroy\NUL\NULvefsn\NUL\NULvega\NUL\NULvegarshei\NUL\NULvennesla\NUL\NULverdal\NUL\NULverran\NUL\NULvestby\NUL\NULvestfold\NULsande\NUL\NUL\NULvestnes\NUL\NULvestre-slidre\NUL\NULvestre-toten\NUL\NULvestvagoy\NUL\NULvevelstad\NUL\NULvf\NULgs\NUL\NUL\NULvgs\NUL\NULvik\NUL\NULvikna\NUL\NULvindafjord\NUL\NULvoagat\NUL\NULvolda\NUL\NULvoss\NUL\NULvossevangen\NUL\NULxn--andy-ira\NUL\NULxn--asky-ira\NUL\NULxn--aurskog-hland-jnb\NUL\NULxn--avery-yua\NUL\NULxn--bdddj-mrabd\NUL\NULxn--bearalvhki-y4a\NUL\NULxn--berlevg-jxa\NUL\NULxn--bhcavuotna-s4a\NUL\NULxn--bhccavuotna-k7a\NUL\NULxn--bidr-5nac\NUL\NULxn--bievt-0qa\NUL\NULxn--bjarky-fya\NUL\NULxn--bjddar-pta\NUL\NULxn--blt-elab\NUL\NULxn--bmlo-gra\NUL\NULxn--bod-2na\NUL\NULxn--brnny-wuac\NUL\NULxn--brnnysund-m8ac\NUL\NULxn--brum-voa\NUL\NULxn--btsfjord-9za\NUL\NULxn--davvenjrga-y4a\NUL\NULxn--dnna-gra\NUL\NULxn--drbak-wua\NUL\NULxn--dyry-ira\NUL\NULxn--eveni-0qa01ga\NUL\NULxn--finny-yua\NUL\NULxn--fjord-lra\NUL\NULxn--fl-zia\NUL\NULxn--flor-jra\NUL\NULxn--frde-gra\NUL\NULxn--frna-woa\NUL\NULxn--frya-hra\NUL\NULxn--ggaviika-8ya47h\NUL\NULxn--gildeskl-g0a\NUL\NULxn--givuotna-8ya\NUL\NULxn--gjvik-wua\NUL\NULxn--gls-elac\NUL\NULxn--h-2fa\NUL\NULxn--hbmer-xqa\NUL\NULxn--hcesuolo-7ya35b\NUL\NULxn--hgebostad-g3a\NUL\NULxn--hmmrfeasta-s4ac\NUL\NULxn--hnefoss-q1a\NUL\NULxn--hobl-ira\NUL\NULxn--holtlen-hxa\NUL\NULxn--hpmir-xqa\NUL\NULxn--hyanger-q1a\NUL\NULxn--hylandet-54a\NUL\NULxn--indery-fya\NUL\NULxn--jlster-bya\NUL\NULxn--jrpeland-54a\NUL\NULxn--karmy-yua\NUL\NULxn--kfjord-iua\NUL\NULxn--klbu-woa\NUL\NULxn--koluokta-7ya57h\NUL\NULxn--krager-gya\NUL\NULxn--kranghke-b0a\NUL\NULxn--krdsherad-m8a\NUL\NULxn--krehamn-dxa\NUL\NULxn--krjohka-hwab49j\NUL\NULxn--ksnes-uua\NUL\NULxn--kvfjord-nxa\NUL\NULxn--kvitsy-fya\NUL\NULxn--kvnangen-k0a\NUL\NULxn--l-1fa\NUL\NULxn--laheadju-7ya\NUL\NULxn--langevg-jxa\NUL\NULxn--ldingen-q1a\NUL\NULxn--leagaviika-52b\NUL\NULxn--lesund-hua\NUL\NULxn--lgrd-poac\NUL\NULxn--lhppi-xqa\NUL\NULxn--linds-pra\NUL\NULxn--loabt-0qa\NUL\NULxn--lrdal-sra\NUL\NULxn--lrenskog-54a\NUL\NULxn--lt-liac\NUL\NULxn--lten-gra\NUL\NULxn--lury-ira\NUL\NULxn--mely-ira\NUL\NULxn--merker-kua\NUL\NULxn--mjndalen-64a\NUL\NULxn--mlatvuopmi-s4a\NUL\NULxn--mli-tla\NUL\NULxn--mlselv-iua\NUL\NULxn--moreke-jua\NUL\NULxn--mosjen-eya\NUL\NULxn--mot-tla\NUL\NULxn--mre-og-romsdal-qqb\NULsande\NUL\NULxn--hery-ira\NUL\NUL\NULxn--msy-ula0h\NUL\NULxn--mtta-vrjjat-k7af\NUL\NULxn--muost-0qa\NUL\NULxn--nmesjevuemie-tcba\NUL\NULxn--nry-yla5g\NUL\NULxn--nttery-byae\NUL\NULxn--nvuotna-hwa\NUL\NULxn--oppegrd-ixa\NUL\NULxn--ostery-fya\NUL\NULxn--osyro-wua\NUL\NULxn--porsgu-sta26f\NUL\NULxn--rady-ira\NUL\NULxn--rdal-poa\NUL\NULxn--rde-ula\NUL\NULxn--rdy-0nab\NUL\NULxn--rennesy-v1a\NUL\NULxn--rhkkervju-01af\NUL\NULxn--rholt-mra\NUL\NULxn--risa-5na\NUL\NULxn--risr-ira\NUL\NULxn--rland-uua\NUL\NULxn--rlingen-mxa\NUL\NULxn--rmskog-bya\NUL\NULxn--rros-gra\NUL\NULxn--rskog-uua\NUL\NULxn--rst-0na\NUL\NULxn--rsta-fra\NUL\NULxn--ryken-vua\NUL\NULxn--ryrvik-bya\NUL\NULxn--s-1fa\NUL\NULxn--sandnessjen-ogb\NUL\NULxn--sandy-yua\NUL\NULxn--seral-lra\NUL\NULxn--sgne-gra\NUL\NULxn--skierv-uta\NUL\NULxn--skjervy-v1a\NUL\NULxn--skjk-soa\NUL\NULxn--sknit-yqa\NUL\NULxn--sknland-fxa\NUL\NULxn--slat-5na\NUL\NULxn--slt-elab\NUL\NULxn--smla-hra\NUL\NULxn--smna-gra\NUL\NULxn--snase-nra\NUL\NULxn--sndre-land-0cb\NUL\NULxn--snes-poa\NUL\NULxn--snsa-roa\NUL\NULxn--sr-aurdal-l8a\NUL\NULxn--sr-fron-q1a\NUL\NULxn--sr-odal-q1a\NUL\NULxn--sr-varanger-ggb\NUL\NULxn--srfold-bya\NUL\NULxn--srreisa-q1a\NUL\NULxn--srum-gra\NUL\NULxn--stfold-9xa\NULxn--vler-qoa\NUL\NUL\NULxn--stjrdal-s1a\NUL\NULxn--stjrdalshalsen-sqb\NUL\NULxn--stre-toten-zcb\NUL\NULxn--tjme-hra\NUL\NULxn--tnsberg-q1a\NUL\NULxn--trany-yua\NUL\NULxn--trgstad-r1a\NUL\NULxn--trna-woa\NUL\NULxn--troms-zua\NUL\NULxn--tysvr-vra\NUL\NULxn--unjrga-rta\NUL\NULxn--vads-jra\NUL\NULxn--vard-jra\NUL\NULxn--vegrshei-c0a\NUL\NULxn--vestvgy-ixa6o\NUL\NULxn--vg-yiab\NUL\NULxn--vgan-qoa\NUL\NULxn--vgsy-qoa0j\NUL\NULxn--vre-eiker-k8a\NUL\NULxn--vrggt-xqad\NUL\NULxn--vry-yla5g\NUL\NULxn--yer-zna\NUL\NULxn--ygarden-p1a\NUL\NULxn--ystre-slidre-ujb\NUL\NUL\NULnokia\NUL\NULnorton\NUL\NULnowruz\NUL\NULnp\NUL*\NUL\NUL\NULnr\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULnet\NUL\NULorg\NUL\NUL\NULnra\NUL\NULnrw\NUL\NULntt\NUL\NULnu\NULmerseine\NUL\NULmine\NUL\NULshacknet\NUL\NUL\NULnyc\NUL\NULnz\NULac\NUL\NULco\NULblogspot\NUL\NUL\NULcri\NUL\NULgeek\NUL\NULgen\NUL\NULgovt\NUL\NULhealth\NUL\NULiwi\NUL\NULkiwi\NUL\NULmaori\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULparliament\NUL\NULschool\NUL\NULxn--mori-qsa\NUL\NUL\NULobi\NUL\NULoffice\NUL\NULokinawa\NUL\NULom\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmed\NUL\NULmuseum\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NUL\NULomega\NUL\NULone\NUL\NULong\NUL\NULonl\NUL\NULonline\NUL\NULooo\NUL\NULoracle\NUL\NULorange\NUL\NULorg\NULae\NUL\NULblogdns\NUL\NULblogsite\NUL\NULboldlygoingnowhere\NUL\NULdnsalias\NUL\NULdnsdojo\NUL\NULdoesntexist\NUL\NULdontexist\NUL\NULdoomdns\NUL\NULdvrdns\NUL\NULdynalias\NUL\NULdyndns\NULgo\NUL\NULhome\NUL\NUL\NULendofinternet\NUL\NULendoftheinternet\NUL\NULfrom-me\NUL\NULgame-host\NUL\NULgotdns\NUL\NULhk\NUL\NULhobby-site\NUL\NULhomedns\NUL\NULhomeftp\NUL\NULhomelinux\NUL\NULhomeunix\NUL\NULis-a-bruinsfan\NUL\NULis-a-candidate\NUL\NULis-a-celticsfan\NUL\NULis-a-chef\NUL\NULis-a-geek\NUL\NULis-a-knight\NUL\NULis-a-linux-user\NUL\NULis-a-patsfan\NUL\NULis-a-soxfan\NUL\NULis-found\NUL\NULis-lost\NUL\NULis-saved\NUL\NULis-very-bad\NUL\NULis-very-evil\NUL\NULis-very-good\NUL\NULis-very-nice\NUL\NULis-very-sweet\NUL\NULisa-geek\NUL\NULkicks-ass\NUL\NULmisconfused\NUL\NULpodzone\NUL\NULreadmyblog\NUL\NULselfip\NUL\NULsellsyourhome\NUL\NULservebbs\NUL\NULserveftp\NUL\NULservegame\NUL\NULstuff-4-sale\NUL\NULus\NUL\NULwebhop\NUL\NULza\NUL\NUL\NULorganic\NUL\NULorientexpress\NUL\NULosaka\NUL\NULotsuka\NUL\NULovh\NUL\NULpa\NULabo\NUL\NULac\NUL\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULing\NUL\NULmed\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NULsld\NUL\NUL\NULpage\NUL\NULpamperedchef\NUL\NULpanerai\NUL\NULparis\NUL\NULpars\NUL\NULpartners\NUL\NULparts\NUL\NULparty\NUL\NULpassagens\NUL\NULpayu\NUL\NULpe\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULmil\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NUL\NULpf\NULcom\NUL\NULedu\NUL\NULorg\NUL\NUL\NULpg\NUL*\NUL\NUL\NULph\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULi\NUL\NULmil\NUL\NULnet\NUL\NULngo\NUL\NULorg\NUL\NUL\NULpharmacy\NUL\NULphilips\NUL\NULphoto\NUL\NULphotography\NUL\NULphotos\NUL\NULphysio\NUL\NULpiaget\NUL\NULpics\NUL\NULpictet\NUL\NULpictures\NUL\NULpid\NUL\NULpin\NUL\NULpink\NUL\NULpizza\NUL\NULpk\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULfam\NUL\NULgob\NUL\NULgok\NUL\NULgon\NUL\NULgop\NUL\NULgos\NUL\NULgov\NUL\NULinfo\NUL\NULnet\NUL\NULorg\NUL\NULweb\NUL\NUL\NULpl\NULagro\NUL\NULaid\NUL\NULart\NUL\NULatm\NUL\NULaugustow\NUL\NULauto\NUL\NULbabia-gora\NUL\NULbedzin\NUL\NULbeskidy\NUL\NULbialowieza\NUL\NULbialystok\NUL\NULbielawa\NUL\NULbieszczady\NUL\NULbiz\NUL\NULboleslawiec\NUL\NULbydgoszcz\NUL\NULbytom\NUL\NULcieszyn\NUL\NULco\NUL\NULcom\NUL\NULczeladz\NUL\NULczest\NUL\NULdlugoleka\NUL\NULedu\NUL\NULelblag\NUL\NULelk\NUL\NULgda\NUL\NULgdansk\NUL\NULgdynia\NUL\NULgliwice\NUL\NULglogow\NUL\NULgmina\NUL\NULgniezno\NUL\NULgorlice\NUL\NULgov\NULpa\NUL\NULpo\NUL\NULso\NUL\NULsr\NUL\NULstarostwo\NUL\NULug\NUL\NULum\NUL\NULupow\NUL\NULuw\NUL\NUL\NULgrajewo\NUL\NULgsm\NUL\NULilawa\NUL\NULinfo\NUL\NULjaworzno\NUL\NULjelenia-gora\NUL\NULjgora\NUL\NULkalisz\NUL\NULkarpacz\NUL\NULkartuzy\NUL\NULkaszuby\NUL\NULkatowice\NUL\NULkazimierz-dolny\NUL\NULkepno\NUL\NULketrzyn\NUL\NULklodzko\NUL\NULkobierzyce\NUL\NULkolobrzeg\NUL\NULkonin\NUL\NULkonskowola\NUL\NULkrakow\NUL\NULkutno\NUL\NULlapy\NUL\NULlebork\NUL\NULlegnica\NUL\NULlezajsk\NUL\NULlimanowa\NUL\NULlomza\NUL\NULlowicz\NUL\NULlubin\NUL\NULlukow\NUL\NULmail\NUL\NULmalbork\NUL\NULmalopolska\NUL\NULmazowsze\NUL\NULmazury\NUL\NULmed\NUL\NULmedia\NUL\NULmiasta\NUL\NULmielec\NUL\NULmielno\NUL\NULmil\NUL\NULmragowo\NUL\NULnaklo\NUL\NULnet\NUL\NULnieruchomosci\NUL\NULnom\NUL\NULnowaruda\NUL\NULnysa\NUL\NULolawa\NUL\NULolecko\NUL\NULolkusz\NUL\NULolsztyn\NUL\NULopoczno\NUL\NULopole\NUL\NULorg\NUL\NULostroda\NUL\NULostroleka\NUL\NULostrowiec\NUL\NULostrowwlkp\NUL\NULpc\NUL\NULpila\NUL\NULpisz\NUL\NULpodhale\NUL\NULpodlasie\NUL\NULpolkowice\NUL\NULpomorskie\NUL\NULpomorze\NUL\NULpowiat\NUL\NULpoznan\NUL\NULpriv\NUL\NULprochowice\NUL\NULpruszkow\NUL\NULprzeworsk\NUL\NULpulawy\NUL\NULradom\NUL\NULrawa-maz\NUL\NULrealestate\NUL\NULrel\NUL\NULrybnik\NUL\NULrzeszow\NUL\NULsanok\NUL\NULsejny\NUL\NULsex\NUL\NULshop\NUL\NULsklep\NUL\NULskoczow\NUL\NULslask\NUL\NULslupsk\NUL\NULsopot\NUL\NULsos\NUL\NULsosnowiec\NUL\NULstalowa-wola\NUL\NULstarachowice\NUL\NULstargard\NUL\NULsuwalki\NUL\NULswidnica\NUL\NULswiebodzin\NUL\NULswinoujscie\NUL\NULszczecin\NUL\NULszczytno\NUL\NULszkola\NUL\NULtargi\NUL\NULtarnobrzeg\NUL\NULtgory\NUL\NULtm\NUL\NULtourism\NUL\NULtravel\NUL\NULturek\NUL\NULturystyka\NUL\NULtychy\NUL\NULustka\NUL\NULwalbrzych\NUL\NULwarmia\NUL\NULwarszawa\NUL\NULwaw\NUL\NULwegrow\NUL\NULwielun\NUL\NULwlocl\NUL\NULwloclawek\NUL\NULwodzislaw\NUL\NULwolomin\NUL\NULwroc\NUL\NULwroclaw\NUL\NULzachpomor\NUL\NULzagan\NUL\NULzakopane\NUL\NULzarow\NUL\NULzgora\NUL\NULzgorzelec\NUL\NUL\NULplace\NUL\NULplay\NUL\NULplumbing\NUL\NULplus\NUL\NULpm\NUL\NULpn\NULco\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULpohl\NUL\NULpoker\NUL\NULporn\NUL\NULpost\NUL\NULpr\NULac\NUL\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULest\NUL\NULgov\NUL\NULinfo\NUL\NULisla\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NULprof\NUL\NUL\NULpraxi\NUL\NULpress\NUL\NULpro\NULaca\NUL\NULbar\NUL\NULcpa\NUL\NULeng\NUL\NULjur\NUL\NULlaw\NUL\NULmed\NUL\NUL\NULprod\NUL\NULproductions\NUL\NULprof\NUL\NULpromo\NUL\NULproperties\NUL\NULproperty\NUL\NULps\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULplo\NUL\NULsec\NUL\NUL\NULpt\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULint\NUL\NULnet\NUL\NULnome\NUL\NULorg\NUL\NULpubl\NUL\NUL\NULpub\NUL\NULpw\NULbelau\NUL\NULco\NUL\NULed\NUL\NULgo\NUL\NULne\NUL\NULor\NUL\NUL\NULpy\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULqa\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULsch\NUL\NUL\NULqpon\NUL\NULquebec\NUL\NULquest\NUL\NULracing\NUL\NULre\NULasso\NUL\NULblogspot\NUL\NULcom\NUL\NULnom\NUL\NUL\NULread\NUL\NULrealtor\NUL\NULrealty\NUL\NULrecipes\NUL\NULred\NUL\NULredstone\NUL\NULredumbrella\NUL\NULrehab\NUL\NULreise\NUL\NULreisen\NUL\NULreit\NUL\NULreliance\NUL\NULren\NUL\NULrent\NUL\NULrentals\NUL\NULrepair\NUL\NULreport\NUL\NULrepublican\NUL\NULrest\NUL\NULrestaurant\NUL\NULreview\NUL\NULreviews\NUL\NULrich\NUL\NULricoh\NUL\NULril\NUL\NULrio\NUL\NULrip\NUL\NULro\NULarts\NUL\NULblogspot\NUL\NULcom\NUL\NULfirm\NUL\NULinfo\NUL\NULnom\NUL\NULnt\NUL\NULorg\NUL\NULrec\NUL\NULstore\NUL\NULtm\NUL\NULwww\NUL\NUL\NULrocher\NUL\NULrocks\NUL\NULrodeo\NUL\NULroom\NUL\NULrs\NULac\NUL\NULco\NUL\NULedu\NUL\NULgov\NUL\NULin\NUL\NULorg\NUL\NUL\NULrsvp\NUL\NULru\NULac\NUL\NULadygeya\NUL\NULaltai\NUL\NULamur\NUL\NULamursk\NUL\NULarkhangelsk\NUL\NULastrakhan\NUL\NULbaikal\NUL\NULbashkiria\NUL\NULbelgorod\NUL\NULbir\NUL\NULblogspot\NUL\NULbryansk\NUL\NULburyatia\NUL\NULcbg\NUL\NULchel\NUL\NULchelyabinsk\NUL\NULchita\NUL\NULchukotka\NUL\NULchuvashia\NUL\NULcmw\NUL\NULcom\NUL\NULdagestan\NUL\NULdudinka\NUL\NULe-burg\NUL\NULedu\NUL\NULfareast\NUL\NULgov\NUL\NULgrozny\NUL\NULint\NUL\NULirkutsk\NUL\NULivanovo\NUL\NULizhevsk\NUL\NULjamal\NUL\NULjar\NUL\NULjoshkar-ola\NUL\NULk-uralsk\NUL\NULkalmykia\NUL\NULkaluga\NUL\NULkamchatka\NUL\NULkarelia\NUL\NULkazan\NUL\NULkchr\NUL\NULkemerovo\NUL\NULkhabarovsk\NUL\NULkhakassia\NUL\NULkhv\NUL\NULkirov\NUL\NULkms\NUL\NULkoenig\NUL\NULkomi\NUL\NULkostroma\NUL\NULkrasnoyarsk\NUL\NULkuban\NUL\NULkurgan\NUL\NULkursk\NUL\NULkustanai\NUL\NULkuzbass\NUL\NULlipetsk\NUL\NULmagadan\NUL\NULmagnitka\NUL\NULmari\NUL\NULmari-el\NUL\NULmarine\NUL\NULmil\NUL\NULmordovia\NUL\NULmsk\NUL\NULmurmansk\NUL\NULmytis\NUL\NULnakhodka\NUL\NULnalchik\NUL\NULnet\NUL\NULnkz\NUL\NULnnov\NUL\NULnorilsk\NUL\NULnov\NUL\NULnovosibirsk\NUL\NULnsk\NUL\NULomsk\NUL\NULorenburg\NUL\NULorg\NUL\NULoryol\NUL\NULoskol\NUL\NULpalana\NUL\NULpenza\NUL\NULperm\NUL\NULpp\NUL\NULptz\NUL\NULpyatigorsk\NUL\NULrnd\NUL\NULrubtsovsk\NUL\NULryazan\NUL\NULsakhalin\NUL\NULsamara\NUL\NULsaratov\NUL\NULsimbirsk\NUL\NULsmolensk\NUL\NULsnz\NUL\NULspb\NUL\NULstavropol\NUL\NULstv\NUL\NULsurgut\NUL\NULsyzran\NUL\NULtambov\NUL\NULtatarstan\NUL\NULtest\NUL\NULtom\NUL\NULtomsk\NUL\NULtsaritsyn\NUL\NULtsk\NUL\NULtula\NUL\NULtuva\NUL\NULtver\NUL\NULtyumen\NUL\NULudm\NUL\NULudmurtia\NUL\NULulan-ude\NUL\NULvdonsk\NUL\NULvladikavkaz\NUL\NULvladimir\NUL\NULvladivostok\NUL\NULvolgograd\NUL\NULvologda\NUL\NULvoronezh\NUL\NULvrn\NUL\NULvyatka\NUL\NULyakutia\NUL\NULyamal\NUL\NULyaroslavl\NUL\NULyekaterinburg\NUL\NULyuzhno-sakhalinsk\NUL\NULzgrad\NUL\NUL\NULruhr\NUL\NULrun\NUL\NULrw\NULac\NUL\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgouv\NUL\NULgov\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NUL\NULrwe\NUL\NULryukyu\NUL\NULsa\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmed\NUL\NULnet\NUL\NULorg\NUL\NULpub\NUL\NULsch\NUL\NUL\NULsaarland\NUL\NULsafe\NUL\NULsafety\NUL\NULsakura\NUL\NULsale\NUL\NULsalon\NUL\NULsamsung\NUL\NULsandvik\NUL\NULsandvikcoromant\NUL\NULsanofi\NUL\NULsap\NUL\NULsapo\NUL\NULsarl\NUL\NULsas\NUL\NULsaxo\NUL\NULsb\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsbi\NUL\NULsbs\NUL\NULsc\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsca\NUL\NULscb\NUL\NULschmidt\NUL\NULscholarships\NUL\NULschool\NUL\NULschule\NUL\NULschwarz\NUL\NULscience\NUL\NULscor\NUL\NULscot\NUL\NULsd\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULmed\NUL\NULnet\NUL\NULorg\NUL\NULtv\NUL\NUL\NULse\NULa\NUL\NULac\NUL\NULb\NUL\NULbd\NUL\NULblogspot\NUL\NULbrand\NUL\NULc\NUL\NULcom\NUL\NULd\NUL\NULe\NUL\NULf\NUL\NULfh\NUL\NULfhsk\NUL\NULfhv\NUL\NULg\NUL\NULh\NUL\NULi\NUL\NULk\NUL\NULkomforb\NUL\NULkommunalforbund\NUL\NULkomvux\NUL\NULl\NUL\NULlanbib\NUL\NULm\NUL\NULn\NUL\NULnaturbruksgymn\NUL\NULo\NUL\NULorg\NUL\NULp\NUL\NULparti\NUL\NULpp\NUL\NULpress\NUL\NULr\NUL\NULs\NUL\NULt\NUL\NULtm\NUL\NULu\NUL\NULw\NUL\NULx\NUL\NULy\NUL\NULz\NUL\NUL\NULseat\NUL\NULseek\NUL\NULsener\NUL\NULservices\NUL\NULsew\NUL\NULsex\NUL\NULsexy\NUL\NULsg\NULblogspot\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NULper\NUL\NUL\NULsh\NULcom\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULplatform\NUL*\NUL\NUL\NUL\NULsharp\NUL\NULshia\NUL\NULshiksha\NUL\NULshoes\NUL\NULshouji\NUL\NULshow\NUL\NULshriram\NUL\NULsi\NUL\NULsina\NUL\NULsingles\NUL\NULsite\NUL\NULsj\NUL\NULsk\NULblogspot\NUL\NUL\NULskin\NUL\NULsky\NUL\NULskype\NUL\NULsl\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsm\NUL\NULsmile\NUL\NULsn\NULart\NUL\NULcom\NUL\NULedu\NUL\NULgouv\NUL\NULorg\NUL\NULperso\NUL\NULuniv\NUL\NUL\NULsncf\NUL\NULso\NULcom\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsoccer\NUL\NULsocial\NUL\NULsoftware\NUL\NULsohu\NUL\NULsolar\NUL\NULsolutions\NUL\NULsong\NUL\NULsony\NUL\NULsoy\NUL\NULspace\NUL\NULspiegel\NUL\NULspot\NUL\NULspreadbetting\NUL\NULsr\NUL\NULst\NULco\NUL\NULcom\NUL\NULconsulado\NUL\NULedu\NUL\NULembaixada\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULprincipe\NUL\NULsaotome\NUL\NULstore\NUL\NUL\NULstada\NUL\NULstar\NUL\NULstarhub\NUL\NULstatebank\NUL\NULstatoil\NUL\NULstc\NUL\NULstcgroup\NUL\NULstockholm\NUL\NULstorage\NUL\NULstudio\NUL\NULstudy\NUL\NULstyle\NUL\NULsu\NULadygeya\NUL\NULarkhangelsk\NUL\NULbalashov\NUL\NULbashkiria\NUL\NULbryansk\NUL\NULdagestan\NUL\NULgrozny\NUL\NULivanovo\NUL\NULkalmykia\NUL\NULkaluga\NUL\NULkarelia\NUL\NULkhakassia\NUL\NULkrasnodar\NUL\NULkurgan\NUL\NULlenug\NUL\NULmordovia\NUL\NULmsk\NUL\NULmurmansk\NUL\NULnalchik\NUL\NULnov\NUL\NULobninsk\NUL\NULpenza\NUL\NULpokrovsk\NUL\NULsochi\NUL\NULspb\NUL\NULtogliatti\NUL\NULtroitsk\NUL\NULtula\NUL\NULtuva\NUL\NULvladikavkaz\NUL\NULvladimir\NUL\NULvologda\NUL\NUL\NULsucks\NUL\NULsupersport\NUL\NULsupplies\NUL\NULsupply\NUL\NULsupport\NUL\NULsurf\NUL\NULsurgery\NUL\NULsuzuki\NUL\NULsv\NULcom\NUL\NULedu\NUL\NULgob\NUL\NULorg\NUL\NULred\NUL\NUL\NULswatch\NUL\NULswiss\NUL\NULsx\NULgov\NUL\NUL\NULsy\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULsydney\NUL\NULsymantec\NUL\NULsystems\NUL\NULsz\NULac\NUL\NULco\NUL\NULorg\NUL\NUL\NULtab\NUL\NULtaipei\NUL\NULtaobao\NUL\NULtatamotors\NUL\NULtatar\NUL\NULtattoo\NUL\NULtax\NUL\NULtaxi\NUL\NULtc\NUL\NULtci\NUL\NULtd\NULblogspot\NUL\NUL\NULteam\NUL\NULtech\NUL\NULtechnology\NUL\NULtel\NUL\NULtelecity\NUL\NULtelefonica\NUL\NULtemasek\NUL\NULtennis\NUL\NULtf\NUL\NULtg\NUL\NULth\NULac\NUL\NULco\NUL\NULgo\NUL\NULin\NUL\NULmi\NUL\NULnet\NUL\NULor\NUL\NUL\NULthd\NUL\NULtheater\NUL\NULtickets\NUL\NULtienda\NUL\NULtiffany\NUL\NULtips\NUL\NULtires\NUL\NULtirol\NUL\NULtj\NULac\NUL\NULbiz\NUL\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgo\NUL\NULgov\NUL\NULint\NUL\NULmil\NUL\NULname\NUL\NULnet\NUL\NULnic\NUL\NULorg\NUL\NULtest\NUL\NULweb\NUL\NUL\NULtk\NUL\NULtl\NULgov\NUL\NUL\NULtm\NULco\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULnom\NUL\NULorg\NUL\NUL\NULtmall\NUL\NULtn\NULagrinet\NUL\NULcom\NUL\NULdefense\NUL\NULedunet\NUL\NULens\NUL\NULfin\NUL\NULgov\NUL\NULind\NUL\NULinfo\NUL\NULintl\NUL\NULmincom\NUL\NULnat\NUL\NULnet\NUL\NULorg\NUL\NULperso\NUL\NULrnrt\NUL\NULrns\NUL\NULrnu\NUL\NULtourism\NUL\NULturen\NUL\NUL\NULto\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULtoday\NUL\NULtokyo\NUL\NULtools\NUL\NULtop\NUL\NULtoray\NUL\NULtoshiba\NUL\NULtours\NUL\NULtown\NUL\NULtoys\NUL\NULtp\NUL\NULtr\NULav\NUL\NULbbs\NUL\NULbel\NUL\NULbiz\NUL\NULcom\NULblogspot\NUL\NUL\NULdr\NUL\NULedu\NUL\NULgen\NUL\NULgov\NUL\NULinfo\NUL\NULk12\NUL\NULkep\NUL\NULmil\NUL\NULname\NUL\NULnc\NULgov\NUL\NUL\NULnet\NUL\NULorg\NUL\NULpol\NUL\NULtel\NUL\NULtv\NUL\NULweb\NUL\NUL\NULtrade\NUL\NULtrading\NUL\NULtraining\NUL\NULtravel\NUL\NULtravelers\NUL\NULtravelersinsurance\NUL\NULtrust\NUL\NULtrv\NUL\NULtt\NULaero\NUL\NULbiz\NUL\NULco\NUL\NULcom\NUL\NULcoop\NUL\NULedu\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULjobs\NUL\NULmobi\NUL\NULmuseum\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NULtravel\NUL\NUL\NULtui\NUL\NULtunes\NUL\NULtushu\NUL\NULtv\NULbetter-than\NUL\NULdyndns\NUL\NULon-the-web\NUL\NULworse-than\NUL\NUL\NULtvs\NUL\NULtw\NULblogspot\NUL\NULclub\NUL\NULcom\NUL\NULebiz\NUL\NULedu\NUL\NULgame\NUL\NULgov\NUL\NULidv\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULxn--czrw28b\NUL\NULxn--uc0atv\NUL\NULxn--zf0ao64a\NUL\NUL\NULtz\NULac\NUL\NULco\NUL\NULgo\NUL\NULhotel\NUL\NULinfo\NUL\NULme\NUL\NULmil\NUL\NULmobi\NUL\NULne\NUL\NULor\NUL\NULsc\NUL\NULtv\NUL\NUL\NULua\NULcherkassy\NUL\NULcherkasy\NUL\NULchernigov\NUL\NULchernihiv\NUL\NULchernivtsi\NUL\NULchernovtsy\NUL\NULck\NUL\NULcn\NUL\NULco\NUL\NULcom\NUL\NULcr\NUL\NULcrimea\NUL\NULcv\NUL\NULdn\NUL\NULdnepropetrovsk\NUL\NULdnipropetrovsk\NUL\NULdominic\NUL\NULdonetsk\NUL\NULdp\NUL\NULedu\NUL\NULgov\NUL\NULif\NUL\NULin\NUL\NULivano-frankivsk\NUL\NULkh\NUL\NULkharkiv\NUL\NULkharkov\NUL\NULkherson\NUL\NULkhmelnitskiy\NUL\NULkhmelnytskyi\NUL\NULkiev\NUL\NULkirovograd\NUL\NULkm\NUL\NULkr\NUL\NULkrym\NUL\NULks\NUL\NULkv\NUL\NULkyiv\NUL\NULlg\NUL\NULlt\NUL\NULlugansk\NUL\NULlutsk\NUL\NULlv\NUL\NULlviv\NUL\NULmk\NUL\NULmykolaiv\NUL\NULnet\NUL\NULnikolaev\NUL\NULod\NUL\NULodesa\NUL\NULodessa\NUL\NULorg\NUL\NULpl\NUL\NULpoltava\NUL\NULpp\NUL\NULrivne\NUL\NULrovno\NUL\NULrv\NUL\NULsb\NUL\NULsebastopol\NUL\NULsevastopol\NUL\NULsm\NUL\NULsumy\NUL\NULte\NUL\NULternopil\NUL\NULuz\NUL\NULuzhgorod\NUL\NULvinnica\NUL\NULvinnytsia\NUL\NULvn\NUL\NULvolyn\NUL\NULyalta\NUL\NULzaporizhzhe\NUL\NULzaporizhzhia\NUL\NULzhitomir\NUL\NULzhytomyr\NUL\NULzp\NUL\NULzt\NUL\NUL\NULubs\NUL\NULug\NULac\NUL\NULco\NUL\NULcom\NUL\NULgo\NUL\NULne\NUL\NULor\NUL\NULorg\NUL\NULsc\NUL\NUL\NULuk\NULac\NUL\NULco\NULblogspot\NUL\NUL\NULgov\NULservice\NUL\NUL\NULltd\NUL\NULme\NUL\NULnet\NUL\NULnhs\NUL\NULorg\NUL\NULplc\NUL\NULpolice\NUL\NULsch\NUL*\NUL\NUL\NUL\NULuniversity\NUL\NULuno\NUL\NULuol\NUL\NULus\NULak\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULal\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULar\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULas\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULaz\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULca\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULco\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULct\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULdc\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULde\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULdni\NUL\NULfed\NUL\NULfl\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULga\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULgu\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULhi\NULcc\NUL\NULlib\NUL\NUL\NULia\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULid\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULil\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULin\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULis-by\NUL\NULisa\NUL\NULkids\NUL\NULks\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULky\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULla\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULland-4-sale\NUL\NULma\NULcc\NUL\NULk12\NULchtr\NUL\NULparoch\NUL\NULpvt\NUL\NUL\NULlib\NUL\NUL\NULmd\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULme\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULmi\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULmn\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULmo\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULms\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULmt\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnc\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnd\NULcc\NUL\NULlib\NUL\NUL\NULne\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnh\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnj\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnm\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULnsn\NUL\NULnv\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULny\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULoh\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULok\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULor\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULpa\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULpr\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULri\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULsc\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULsd\NULcc\NUL\NULlib\NUL\NUL\NULstuff-4-sale\NUL\NULtn\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULtx\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULut\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULva\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULvi\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULvt\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULwa\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULwi\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NULwv\NULcc\NUL\NUL\NULwy\NULcc\NUL\NULk12\NUL\NULlib\NUL\NUL\NUL\NULuy\NULcom\NUL\NULedu\NUL\NULgub\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULuz\NULco\NUL\NULcom\NUL\NULnet\NUL\NULorg\NUL\NUL\NULva\NUL\NULvacations\NUL\NULvana\NUL\NULvc\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NUL\NULve\NULarts\NUL\NULco\NUL\NULcom\NUL\NULe12\NUL\NULedu\NUL\NULfirm\NUL\NULgob\NUL\NULgov\NUL\NULinfo\NUL\NULint\NUL\NULmil\NUL\NULnet\NUL\NULorg\NUL\NULrec\NUL\NULstore\NUL\NULtec\NUL\NULweb\NUL\NUL\NULvegas\NUL\NULventures\NUL\NULversicherung\NUL\NULvet\NUL\NULvg\NUL\NULvi\NULco\NUL\NULcom\NUL\NULk12\NUL\NULnet\NUL\NULorg\NUL\NUL\NULviajes\NUL\NULvideo\NUL\NULviking\NUL\NULvillas\NUL\NULvip\NUL\NULvirgin\NUL\NULvision\NUL\NULvista\NUL\NULvistaprint\NUL\NULviva\NUL\NULvlaanderen\NUL\NULvn\NULac\NUL\NULbiz\NUL\NULcom\NUL\NULedu\NUL\NULgov\NUL\NULhealth\NUL\NULinfo\NUL\NULint\NUL\NULname\NUL\NULnet\NUL\NULorg\NUL\NULpro\NUL\NUL\NULvodka\NUL\NULvote\NUL\NULvoting\NUL\NULvoto\NUL\NULvoyage\NUL\NULvu\NULcom\NUL\NULedu\NUL\NULnet\NUL\NULorg\NUL\NUL\NULvuelos\NUL\NULwales\NUL\NULwalter\NUL\NULwang\NUL\NULwanggou\NUL\NULwatch\NUL\NULwatches\NUL\NULweather\NUL\NULweatherchannel\NUL\NULwebcam\NUL\NULwebsite\NUL\NULwed\NUL\NULwedding\NUL\NULweibo\NUL\NULweir\NUL\NULwf\NUL\NULwhoswho\NUL\NULwien\NUL\NULwiki\NUL\NULwilliamhill\NUL\NULwin\NUL\NULwindows\NUL\NULwme\NUL\NULwork\NUL\NULworks\NUL\NULworld\NUL\NULws\NULcom\NUL\NULdyndns\NUL\NULedu\NUL\NULgov\NUL\NULmypets\NUL\NULnet\NUL\NULorg\NUL\NUL\NULwtc\NUL\NULwtf\NUL\NULxbox\NUL\NULxerox\NUL\NULxihuan\NUL\NULxin\NUL\NULxn--11b4c3d\NUL\NULxn--1ck2e1b\NUL\NULxn--1qqw23a\NUL\NULxn--30rr7y\NUL\NULxn--3bst00m\NUL\NULxn--3ds443g\NUL\NULxn--3e0b707e\NUL\NULxn--3pxu8k\NUL\NULxn--42c2d9a\NUL\NULxn--45brj9c\NUL\NULxn--45q11c\NUL\NULxn--4gbrim\NUL\NULxn--54b7fta0cc\NUL\NULxn--55qw42g\NUL\NULxn--55qx5d\NUL\NULxn--5tzm5g\NUL\NULxn--6frz82g\NUL\NULxn--6qq986b3xl\NUL\NULxn--80adxhks\NUL\NULxn--80ao21a\NUL\NULxn--80asehdb\NUL\NULxn--80aswg\NUL\NULxn--8y0a063a\NUL\NULxn--90a3ac\NULxn--80au\NUL\NULxn--90azh\NUL\NULxn--c1avg\NUL\NULxn--d1at\NUL\NULxn--o1ac\NUL\NULxn--o1ach\NUL\NUL\NULxn--9dbq2a\NUL\NULxn--9et52u\NUL\NULxn--9krt00a\NUL\NULxn--b4w605ferd\NUL\NULxn--bck1b9a5dre4c\NUL\NULxn--c1avg\NUL\NULxn--c2br7g\NUL\NULxn--cck2b3b\NUL\NULxn--cg4bki\NUL\NULxn--clchc0ea0b2g2a9gcd\NUL\NULxn--czr694b\NUL\NULxn--czrs0t\NUL\NULxn--czru2d\NUL\NULxn--d1acj3b\NUL\NULxn--eckvdtc9d\NUL\NULxn--efvy88h\NUL\NULxn--estv75g\NUL\NULxn--fhbei\NUL\NULxn--fiq228c5hs\NUL\NULxn--fiq64b\NUL\NULxn--fiqs8s\NUL\NULxn--fiqz9s\NUL\NULxn--fjq720a\NUL\NULxn--flw351e\NUL\NULxn--fpcrj9c3d\NUL\NULxn--fzc2c9e2c\NUL\NULxn--g2xx48c\NUL\NULxn--gckr3f0f\NUL\NULxn--gecrj9c\NUL\NULxn--h2brj9c\NUL\NULxn--hxt814e\NUL\NULxn--i1b6b1a6a2e\NUL\NULxn--imr513n\NUL\NULxn--io0a7i\NUL\NULxn--j1aef\NUL\NULxn--j1amh\NUL\NULxn--j6w193g\NUL\NULxn--jlq61u9w7b\NUL\NULxn--jvr189m\NUL\NULxn--kcrx77d1x4a\NUL\NULxn--kprw13d\NUL\NULxn--kpry57d\NUL\NULxn--kpu716f\NUL\NULxn--kput3i\NUL\NULxn--l1acc\NUL\NULxn--lgbbat1ad8j\NUL\NULxn--mgb2ddes\NUL\NULxn--mgb9awbf\NUL\NULxn--mgba3a3ejt\NUL\NULxn--mgba3a4f16a\NUL\NULxn--mgba3a4fra\NUL\NULxn--mgbaam7a8h\NUL\NULxn--mgbab2bd\NUL\NULxn--mgbayh7gpa\NUL\NULxn--mgbb9fbpob\NUL\NULxn--mgbbh1a71e\NUL\NULxn--mgbc0a9azcg\NUL\NULxn--mgberp4a5d4a87g\NUL\NULxn--mgberp4a5d4ar\NUL\NULxn--mgbqly7c0a67fbc\NUL\NULxn--mgbqly7cvafr\NUL\NULxn--mgbt3dhd\NUL\NULxn--mgbtf8fl\NUL\NULxn--mgbx4cd0ab\NUL\NULxn--mk1bu44c\NUL\NULxn--mxtq1m\NUL\NULxn--ngbc5azd\NUL\NULxn--ngbe9e0a\NUL\NULxn--nnx388a\NUL\NULxn--node\NUL\NULxn--nqv7f\NUL\NULxn--nqv7fs00ema\NUL\NULxn--nyqy26a\NUL\NULxn--o3cw4h\NUL\NULxn--ogbpf8fl\NUL\NULxn--p1acf\NUL\NULxn--p1ai\NUL\NULxn--pbt977c\NUL\NULxn--pgbs0dh\NUL\NULxn--pssy2u\NUL\NULxn--q9jyb4c\NUL\NULxn--qcka1pmc\NUL\NULxn--rhqv96g\NUL\NULxn--rovu88b\NUL\NULxn--s9brj9c\NUL\NULxn--ses554g\NUL\NULxn--t60b56a\NUL\NULxn--tckwe\NUL\NULxn--unup4y\NUL\NULxn--vermgensberater-ctb\NUL\NULxn--vermgensberatung-pwb\NUL\NULxn--vhquv\NUL\NULxn--vuq861b\NUL\NULxn--wgbh1c\NUL\NULxn--wgbl6a\NUL\NULxn--xhq521b\NUL\NULxn--xkc2al3hye2a\NUL\NULxn--xkc2dl3a5ee0h\NUL\NULxn--yfro4i67o\NUL\NULxn--ygbi2ammx\NUL\NULxn--zfr164b\NUL\NULxxx\NUL\NULxyz\NUL\NULyachts\NUL\NULyahoo\NUL\NULyamaxun\NUL\NULyandex\NUL\NULye\NUL*\NUL\NUL\NULyodobashi\NUL\NULyoga\NUL\NULyokohama\NUL\NULyoutube\NUL\NULyt\NUL\NULyun\NUL\NULza\NUL*\NUL\NUL\NULzara\NUL\NULzero\NUL\NULzip\NUL\NULzm\NUL*\NUL\NUL\NULzone\NUL\NULzuerich\NUL\NULzw\NUL*\NUL\NUL\NUL\NULck\NULwww\NUL\NUL\NULjp\NULkawasaki\NULcity\NUL\NUL\NULkitakyushu\NULcity\NUL\NUL\NULkobe\NULcity\NUL\NUL\NULnagoya\NULcity\NUL\NUL\NULsapporo\NULcity\NUL\NUL\NULsendai\NULcity\NUL\NUL\NULyokohama\NULcity\NUL\NUL\NUL\NULmz\NULteledata\NUL\NUL\NUL\NUL"
#endif
http-client-0.5.14/Data/KeyedPool.hs 0000644 0000000 0000000 00000030312 13316025440 015317 0 ustar 00 0000000 0000000 {-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Similar to Data.Pool from resource-pool, but resources are
-- identified by some key. To clarify semantics of this module:
--
-- * The pool holds onto and tracks idle resources. Active resources
-- (those checked out via 'takeKeyedPool') are not tracked at all by
-- 'KeyedPool' itself.
--
-- * The pool limits the number of idle resources per key and the
-- total number of idle resources.
--
-- * There is no limit placed on /active/ resources. As such: there
-- will be no delay when calling 'takeKeyedPool': it will either use
-- an idle resource already present, or create a new one
-- immediately.
--
-- * Once the garbage collector cleans up the 'kpAlive' value, the
-- pool will be shut down, by placing a 'PoolClosed' into the
-- 'kpVar' and destroying all existing idle connection.
--
-- * A reaper thread will destroy unused idle resources regularly. It
-- will stop running once 'kpVar' contains a 'PoolClosed' value.
--
-- * 'takeKeyedPool' is async exception safe, but relies on the
-- /caller/ to ensure prompt cleanup. See its comment for more
-- information.
module Data.KeyedPool
( KeyedPool
, createKeyedPool
, takeKeyedPool
, Managed
, managedResource
, managedReused
, managedRelease
, keepAlive
, Reuse (..)
, dummyManaged
) where
import Control.Concurrent (forkIOWithUnmask, threadDelay)
import Control.Concurrent.STM
import Control.Exception (mask_, catch, SomeException)
import Control.Monad (join, unless, void)
import Data.Map (Map)
import Data.Maybe (isJust)
import qualified Data.Map.Strict as Map
import Data.Time (UTCTime, getCurrentTime, addUTCTime)
import Data.IORef (IORef, newIORef, mkWeakIORef, readIORef)
import qualified Data.Foldable as F
import GHC.Conc (unsafeIOToSTM)
import System.IO.Unsafe (unsafePerformIO)
data KeyedPool key resource = KeyedPool
{ kpCreate :: !(key -> IO resource)
, kpDestroy :: !(resource -> IO ())
, kpMaxPerKey :: !Int
, kpMaxTotal :: !Int
, kpVar :: !(TVar (PoolMap key resource))
, kpAlive :: !(IORef ())
}
data PoolMap key resource
= PoolClosed
| PoolOpen
-- Total number of resources in the pool
{-# UNPACK #-} !Int
!(Map key (PoolList resource))
deriving F.Foldable
-- | A non-empty list which keeps track of its own length and when
-- each resource was created.
data PoolList a
= One a {-# UNPACK #-} !UTCTime
| Cons
a
-- size of the list from this point and on
{-# UNPACK #-} !Int
{-# UNPACK #-} !UTCTime
!(PoolList a)
deriving F.Foldable
plistToList :: PoolList a -> [(UTCTime, a)]
plistToList (One a t) = [(t, a)]
plistToList (Cons a _ t plist) = (t, a) : plistToList plist
plistFromList :: [(UTCTime, a)] -> Maybe (PoolList a)
plistFromList [] = Nothing
plistFromList [(t, a)] = Just (One a t)
plistFromList xs =
Just . snd . go $ xs
where
go [] = error "plistFromList.go []"
go [(t, a)] = (2, One a t)
go ((t, a):rest) =
let (i, rest') = go rest
i' = i + 1
in i' `seq` (i', Cons a i t rest')
-- | Create a new 'KeyedPool' which will automatically clean up after
-- itself when all referenced to the 'KeyedPool' are gone. It will
-- also fork a reaper thread to regularly kill off unused resource.
createKeyedPool
:: Ord key
=> (key -> IO resource) -- ^ create a new resource
-> (resource -> IO ())
-- ^ Destroy a resource. Note that exceptions thrown by this will be
-- silently discarded. If you want reporting, please install an
-- exception handler yourself.
-> Int -- ^ number of resources per key to allow in the pool
-> Int -- ^ number of resources to allow in the pool across all keys
-> (SomeException -> IO ()) -- ^ what to do if the reaper throws an exception
-> IO (KeyedPool key resource)
createKeyedPool create destroy maxPerKey maxTotal onReaperException = do
var <- newTVarIO $ PoolOpen 0 Map.empty
-- We use a different IORef for the weak ref instead of the var
-- above since the reaper thread will always be holding onto a
-- reference.
alive <- newIORef ()
void $ mkWeakIORef alive $ destroyKeyedPool' destroy var
-- Make sure to fork _after_ we've established the mkWeakIORef. If
-- we did it the other way around, it would be possible for an
-- async exception to happen before our destroyKeyedPool' handler
-- was installed, and then reap would have to rely on detecting an
-- STM deadlock before it could ever exit. This way, the reap
-- function will only start running when we're guaranteed that
-- cleanup will be triggered.
-- Ensure that we have a normal masking state in the new thread.
_ <- forkIOWithUnmask $ \restore -> keepRunning $ restore $ reap destroy var
return KeyedPool
{ kpCreate = create
, kpDestroy = destroy
, kpMaxPerKey = maxPerKey
, kpMaxTotal = maxTotal
, kpVar = var
, kpAlive = alive
}
where
keepRunning action =
loop
where
loop = action `catch` \e -> onReaperException e >> loop
-- | Make a 'KeyedPool' inactive and destroy all idle resources.
destroyKeyedPool' :: (resource -> IO ())
-> TVar (PoolMap key resource)
-> IO ()
destroyKeyedPool' destroy var = do
m <- atomically $ swapTVar var PoolClosed
F.mapM_ (ignoreExceptions . destroy) m
-- | Run a reaper thread, which will destroy old resources. It will
-- stop running once our pool switches to PoolClosed, which is handled
-- via the mkWeakIORef in the creation of the pool.
reap :: forall key resource.
Ord key
=> (resource -> IO ())
-> TVar (PoolMap key resource)
-> IO ()
reap destroy var =
loop
where
loop = do
threadDelay (5 * 1000 * 1000)
join $ atomically $ do
m'' <- readTVar var
case m'' of
PoolClosed -> return (return ())
PoolOpen idleCount m
| Map.null m -> retry
| otherwise -> do
(m', toDestroy) <- findStale idleCount m
writeTVar var m'
return $ do
mask_ (mapM_ (ignoreExceptions . destroy) toDestroy)
loop
findStale :: Int
-> Map key (PoolList resource)
-> STM (PoolMap key resource, [resource])
findStale idleCount m = do
-- We want to make sure to get the time _after_ any delays
-- occur due to the retry call above. Since getCurrentTime has
-- no side effects outside of the STM block, this is a safe
-- usage.
now <- unsafeIOToSTM getCurrentTime
let isNotStale time = 30 `addUTCTime` time >= now
let findStale' toKeep toDestroy [] =
(Map.fromList (toKeep []), toDestroy [])
findStale' toKeep toDestroy ((key, plist):rest) =
findStale' toKeep' toDestroy' rest
where
-- Note: By definition, the timestamps must be in
-- descending order, so we don't need to traverse the
-- whole list.
(notStale, stale) = span (isNotStale . fst) $ plistToList plist
toDestroy' = toDestroy . (map snd stale++)
toKeep' =
case plistFromList notStale of
Nothing -> toKeep
Just x -> toKeep . ((key, x):)
let (toKeep, toDestroy) = findStale' id id (Map.toList m)
let idleCount' = idleCount - length toDestroy
return (PoolOpen idleCount' toKeep, toDestroy)
-- | Check out a value from the 'KeyedPool' with the given key.
--
-- This function will internally call 'mask_' to ensure async safety,
-- and will return a value which uses weak references to ensure that
-- the value is cleaned up. However, if you want to ensure timely
-- resource cleanup, you should bracket this operation together with
-- 'managedRelease'.
takeKeyedPool :: Ord key => KeyedPool key resource -> key -> IO (Managed resource)
takeKeyedPool kp key = mask_ $ join $ atomically $ do
(m, mresource) <- fmap go $ readTVar (kpVar kp)
writeTVar (kpVar kp) $! m
return $ do
resource <- maybe (kpCreate kp key) return mresource
alive <- newIORef ()
isReleasedVar <- newTVarIO False
let release action = mask_ $ do
isReleased <- atomically $ swapTVar isReleasedVar True
unless isReleased $
case action of
Reuse -> putResource kp key resource
DontReuse -> ignoreExceptions $ kpDestroy kp resource
_ <- mkWeakIORef alive $ release DontReuse
return Managed
{ _managedResource = resource
, _managedReused = isJust mresource
, _managedRelease = release
, _managedAlive = alive
}
where
go PoolClosed = (PoolClosed, Nothing)
go pcOrig@(PoolOpen idleCount m) =
case Map.lookup key m of
Nothing -> (pcOrig, Nothing)
Just (One a _) ->
(PoolOpen (idleCount - 1) (Map.delete key m), Just a)
Just (Cons a _ _ rest) ->
(PoolOpen (idleCount - 1) (Map.insert key rest m), Just a)
-- | Try to return a resource to the pool. If too many resources
-- already exist, then just destroy it.
putResource :: Ord key => KeyedPool key resource -> key -> resource -> IO ()
putResource kp key resource = do
now <- getCurrentTime
join $ atomically $ do
(m, action) <- fmap (go now) (readTVar (kpVar kp))
writeTVar (kpVar kp) $! m
return action
where
go _ PoolClosed = (PoolClosed, kpDestroy kp resource)
go now pc@(PoolOpen idleCount m)
| idleCount >= kpMaxTotal kp = (pc, kpDestroy kp resource)
| otherwise = case Map.lookup key m of
Nothing ->
let cnt' = idleCount + 1
m' = PoolOpen cnt' (Map.insert key (One resource now) m)
in (m', return ())
Just l ->
let (l', mx) = addToList now (kpMaxPerKey kp) resource l
cnt' = idleCount + maybe 1 (const 0) mx
m' = PoolOpen cnt' (Map.insert key l' m)
in (m', maybe (return ()) (kpDestroy kp) mx)
-- | Add a new element to the list, up to the given maximum number. If we're
-- already at the maximum, return the new value as leftover.
addToList :: UTCTime -> Int -> a -> PoolList a -> (PoolList a, Maybe a)
addToList _ i x l | i <= 1 = (l, Just x)
addToList now _ x l@One{} = (Cons x 2 now l, Nothing)
addToList now maxCount x l@(Cons _ currCount _ _)
| maxCount > currCount = (Cons x (currCount + 1) now l, Nothing)
| otherwise = (l, Just x)
-- | A managed resource, which can be returned to the 'KeyedPool' when
-- work with it is complete. Using garbage collection, it will default
-- to destroying the resource if the caller does not explicitly use
-- 'managedRelease'.
data Managed resource = Managed
{ _managedResource :: !resource
, _managedReused :: !Bool
, _managedRelease :: !(Reuse -> IO ())
, _managedAlive :: !(IORef ())
}
-- | Get the raw resource from the 'Managed' value.
managedResource :: Managed resource -> resource
managedResource = _managedResource
-- | Was this value taken from the pool?
managedReused :: Managed resource -> Bool
managedReused = _managedReused
-- | Release the resource, after which it is invalid to use the
-- 'managedResource' value. 'Reuse' returns the resource to the
-- pool; 'DontReuse' destroys it.
managedRelease :: Managed resource -> Reuse -> IO ()
managedRelease = _managedRelease
data Reuse = Reuse | DontReuse
-- | For testing purposes only: create a dummy Managed wrapper
dummyManaged :: resource -> Managed resource
dummyManaged resource = Managed
{ _managedResource = resource
, _managedReused = False
, _managedRelease = const (return ())
, _managedAlive = unsafePerformIO (newIORef ())
}
ignoreExceptions :: IO () -> IO ()
ignoreExceptions f = f `catch` \(_ :: SomeException) -> return ()
-- | Prevent the managed resource from getting released before you want to use.
keepAlive :: Managed resource -> IO ()
keepAlive = readIORef . _managedAlive
http-client-0.5.14/test-nonet/Spec.hs 0000644 0000000 0000000 00000000054 12632352123 015546 0 ustar 00 0000000 0000000 {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
http-client-0.5.14/test-nonet/Network/HTTP/ClientSpec.hs 0000644 0000000 0000000 00000023662 13247023725 021135 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.HTTP.ClientSpec where
import Control.Concurrent (threadDelay, yield)
import Control.Concurrent.Async (withAsync)
import qualified Control.Concurrent.Async as Async
import Control.Exception (bracket, throwIO, ErrorCall(..))
import qualified Control.Exception as E
import Control.Monad (forever, replicateM_, when, unless)
import Network.HTTP.Client hiding (port)
import qualified Network.HTTP.Client as NC
import qualified Network.HTTP.Client.Internal as Internal
import Network.HTTP.Types (status413)
import qualified Network.Socket as NS
import Test.Hspec
import qualified Data.Streaming.Network as N
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as SL
import Data.ByteString.Lazy.Char8 () -- orphan instance
import Data.IORef
import System.Mem (performGC)
-- See: https://github.com/snoyberg/http-client/issues/111#issuecomment-366526660
notWindows :: Monad m => m () -> m ()
#ifdef WINDOWS
notWindows _ = return ()
#else
notWindows x = x
#endif
main :: IO ()
main = hspec spec
silentIOError :: IO () -> IO ()
silentIOError a = a `E.catch` \e -> do
let _ = e :: IOError
return ()
redirectServer :: (Int -> IO a) -> IO a
redirectServer inner = bracket
(N.bindRandomPortTCP "*4")
(NS.close . snd)
$ \(port, lsocket) -> withAsync
(N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)
(const $ inner port)
where
app ad = Async.race_
(silentIOError $ forever (N.appRead ad))
(silentIOError $ forever $ do
N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\ncontent-length: 5\r\n\r\n"
threadDelay 10000
N.appWrite ad "hello\r\n"
threadDelay 10000)
redirectCloseServer :: (Int -> IO a) -> IO a
redirectCloseServer inner = bracket
(N.bindRandomPortTCP "*4")
(NS.close . snd)
$ \(port, lsocket) -> withAsync
(N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)
(const $ inner port)
where
app ad = do
Async.race_
(silentIOError $ forever (N.appRead ad))
(silentIOError $ N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\nConnection: close\r\n\r\nhello")
case N.appRawSocket ad of
Nothing -> error "appRawSocket failed"
Just s -> NS.shutdown s NS.ShutdownSend
bad100Server :: Bool -- ^ include extra headers?
-> (Int -> IO a) -> IO a
bad100Server extraHeaders inner = bracket
(N.bindRandomPortTCP "*4")
(NS.close . snd)
$ \(port, lsocket) -> withAsync
(N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)
(const $ inner port)
where
app ad = Async.race_
(silentIOError $ forever $ N.appRead ad)
(silentIOError $ forever $ do
N.appWrite ad $ S.concat
[ "HTTP/1.1 100 Continue\r\n"
, if extraHeaders then "foo:bar\r\nbaz: bin\r\n" else ""
, "\r\nHTTP/1.1 200 OK\r\ncontent-length: 5\r\n\r\nhello\r\n"
]
threadDelay 10000)
earlyClose413 :: (Int -> IO a) -> IO a
earlyClose413 inner = bracket
(N.bindRandomPortTCP "*4")
(NS.close . snd)
$ \(port, lsocket) -> withAsync
(N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)
(const $ inner port)
where
app ad = silentIOError $ do
let readHeaders front = do
newBS <- N.appRead ad
let bs = S.append front newBS
if "\r\n\r\n" `S.isInfixOf` bs
then return ()
else readHeaders bs
readHeaders S.empty
N.appWrite ad "HTTP/1.1 413 Too Large\r\ncontent-length: 7\r\n\r\ngoodbye"
-- Make sure we detect bad situations like
-- https://github.com/yesodweb/wai/issues/346 better than we did previously, so
-- that misreporting like https://github.com/snoyberg/http-client/issues/108
-- doesn't occur.
lengthAndChunked :: (Int -> IO a) -> IO a
lengthAndChunked = serveWith "HTTP/1.1 200 OK\r\ncontent-length: 24\r\ntransfer-encoding: chunked\r\n\r\n4\r\nWiki\r\n5\r\npedia\r\ne\r\n in\r\n\r\nchunks.\r\n0\r\n\r\n"
lengthZeroAndChunked :: (Int -> IO a) -> IO a
lengthZeroAndChunked = serveWith "HTTP/1.1 200 OK\r\ncontent-length: 0\r\ntransfer-encoding: chunked\r\n\r\n4\r\nWiki\r\n5\r\npedia\r\ne\r\n in\r\n\r\nchunks.\r\n0\r\n\r\n"
lengthZeroAndChunkZero :: (Int -> IO a) -> IO a
lengthZeroAndChunkZero = serveWith "HTTP/1.1 200 OK\r\ncontent-length: 0\r\ntransfer-encoding: chunked\r\n\r\n0\r\n\r\n"
serveWith :: S.ByteString -> (Int -> IO a) -> IO a
serveWith resp inner = do
(port, lsocket) <- (N.bindRandomPortTCP "*4")
res <- Async.race
(N.runTCPServer (N.serverSettingsTCPSocket lsocket) app)
(inner port)
case res of
Left () -> error $ "serveWith: got Left"
Right x -> return x
where
app ad = silentIOError $ do
let readHeaders front = do
newBS <- N.appRead ad
let bs = S.append front newBS
if "\r\n\r\n" `S.isInfixOf` bs
then return ()
else readHeaders bs
readHeaders S.empty
N.appWrite ad resp
getChunkedResponse :: Int -> Manager -> IO (Response SL.ByteString)
getChunkedResponse port' man = flip httpLbs man "http://localhost"
{ NC.port = port'
, requestBody = RequestBodyStreamChunked ($ return (S.replicate 100000 65))
}
spec :: Spec
spec = describe "Client" $ do
describe "fails on empty hostnames #40" $ do
let test url = it url $ do
req <- parseUrlThrow url
man <- newManager defaultManagerSettings
_ <- httpLbs req man `shouldThrow` \e ->
case e of
HttpExceptionRequest _ (InvalidDestinationHost "") -> True
_ -> False
return ()
mapM_ test ["http://", "https://", "http://:8000", "https://:8001"]
it "redirecting #41" $ redirectServer $ \port -> do
req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
let req = req' { redirectCount = 1 }
man <- newManager defaultManagerSettings
replicateM_ 10 $ do
httpLbs req man `shouldThrow` \e ->
case e of
HttpExceptionRequest _ (TooManyRedirects _) -> True
_ -> False
it "redirectCount=0" $ redirectServer $ \port -> do
req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
let req = req' { redirectCount = 0 }
man <- newManager defaultManagerSettings
replicateM_ 10 $ do
httpLbs req man `shouldThrow` \e ->
case e of
HttpExceptionRequest _ StatusCodeException{} -> True
_ -> False
it "connecting to missing server gives nice error message" $ do
(port, socket) <- N.bindRandomPortTCP "*4"
NS.close socket
req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
man <- newManager defaultManagerSettings
httpLbs req man `shouldThrow` \e ->
case e of
HttpExceptionRequest req' (ConnectionFailure _)
-> host req == host req'
&& NC.port req == NC.port req'
_ -> False
describe "extra headers after 100 #49" $ do
let test x = it (show x) $ bad100Server x $ \port -> do
req <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
man <- newManager defaultManagerSettings
replicateM_ 10 $ do
x' <- httpLbs req man
responseBody x' `shouldBe` "hello"
test False
test True
notWindows $ it "early close on a 413" $ earlyClose413 $ \port' -> do
man <- newManager defaultManagerSettings
res <- getChunkedResponse port' man
responseBody res `shouldBe` "goodbye"
responseStatus res `shouldBe` status413
notWindows $ it "length zero and chunking zero #108" $ lengthZeroAndChunkZero $ \port' -> do
man <- newManager defaultManagerSettings
res <- getChunkedResponse port' man
responseBody res `shouldBe` ""
notWindows $ it "length zero and chunking" $ lengthZeroAndChunked $ \port' -> do
man <- newManager defaultManagerSettings
res <- getChunkedResponse port' man
responseBody res `shouldBe` "Wikipedia in\r\n\r\nchunks."
notWindows $ it "length and chunking" $ lengthAndChunked $ \port' -> do
man <- newManager defaultManagerSettings
res <- getChunkedResponse port' man
responseBody res `shouldBe` "Wikipedia in\r\n\r\nchunks."
notWindows $ it "withResponseHistory and redirect" $ redirectCloseServer $ \port -> do
-- see https://github.com/snoyberg/http-client/issues/169
req' <- parseUrlThrow $ "http://127.0.0.1:" ++ show port
let req = req' {redirectCount = 1}
man <- newManager defaultManagerSettings
withResponseHistory req man (const $ return ())
`shouldThrow` \e ->
case e of
HttpExceptionRequest _ (TooManyRedirects _) -> True
_ -> False
it "should not write to closed connection" $ do
-- see https://github.com/snoyberg/http-client/issues/225
closedRef <- newIORef False
okRef <- newIORef True
let checkStatus = do
closed <- readIORef closedRef
when closed $ do
writeIORef okRef False
conn <- makeConnection
(return S.empty)
(const checkStatus)
(checkStatus >> writeIORef closedRef True)
Internal.connectionClose conn
-- let GC release the connection and run finalizers
performGC
yield
performGC
ok <- readIORef okRef
unless ok $
throwIO (ErrorCall "already closed")
http-client-0.5.14/test-nonet/Network/HTTP/Client/ResponseSpec.hs 0000644 0000000 0000000 00000005706 13227377006 022734 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP.Client.ResponseSpec where
import Test.Hspec
import Network.HTTP.Client
import Network.HTTP.Client.Internal
import Network.HTTP.Types
import Codec.Compression.GZip (compress)
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Char8 ()
import qualified Data.ByteString as S
main :: IO ()
main = hspec spec
spec :: Spec
spec = describe "ResponseSpec" $ do
let getResponse' conn = getResponse Nothing req (dummyManaged conn) Nothing
req = parseRequest_ "http://localhost"
it "basic" $ do
(conn, _, _) <- dummyConnection
[ "HTTP/1.1 200 OK\r\n"
, "Key1: Value1\r\n"
, "Content-length: 11\r\n\r\n"
, "Hello"
, " W"
, "orld\r\nHTTP/1.1"
]
Response {..} <- getResponse' conn
responseStatus `shouldBe` status200
responseVersion `shouldBe` HttpVersion 1 1
responseHeaders `shouldBe`
[ ("Key1", "Value1")
, ("Content-length", "11")
]
pieces <- brConsume responseBody
pieces `shouldBe` ["Hello", " W", "orld"]
it "no length" $ do
(conn, _, _) <- dummyConnection
[ "HTTP/1.1 200 OK\r\n"
, "Key1: Value1\r\n\r\n"
, "Hello"
, " W"
, "orld\r\nHTTP/1.1"
]
Response {..} <- getResponse' conn
responseStatus `shouldBe` status200
responseVersion `shouldBe` HttpVersion 1 1
responseHeaders `shouldBe`
[ ("Key1", "Value1")
]
pieces <- brConsume responseBody
pieces `shouldBe` ["Hello", " W", "orld\r\nHTTP/1.1"]
it "chunked" $ do
(conn, _, _) <- dummyConnection
[ "HTTP/1.1 200 OK\r\n"
, "Key1: Value1\r\n"
, "Transfer-encoding: chunked\r\n\r\n"
, "5\r\nHello\r"
, "\n2\r\n W"
, "\r\n4 ignored\r\norld\r\n0\r\nHTTP/1.1"
]
Response {..} <- getResponse' conn
responseStatus `shouldBe` status200
responseVersion `shouldBe` HttpVersion 1 1
responseHeaders `shouldBe`
[ ("Key1", "Value1")
, ("Transfer-encoding", "chunked")
]
pieces <- brConsume responseBody
pieces `shouldBe` ["Hello", " W", "orld"]
it "gzip" $ do
(conn, _, _) <- dummyConnection
$ "HTTP/1.1 200 OK\r\n"
: "Key1: Value1\r\n"
: "Content-Encoding: gzip\r\n\r\n"
: L.toChunks (compress "Compressed Hello World")
Response {..} <- getResponse' conn
responseStatus `shouldBe` status200
responseVersion `shouldBe` HttpVersion 1 1
responseHeaders `shouldBe`
[ ("Key1", "Value1")
, ("Content-Encoding", "gzip")
]
pieces <- brConsume responseBody
S.concat pieces `shouldBe` "Compressed Hello World"
http-client-0.5.14/test-nonet/Network/HTTP/Client/BodySpec.hs 0000644 0000000 0000000 00000006427 13025776351 022036 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.BodySpec where
import Test.Hspec
import Network.HTTP.Client
import Network.HTTP.Client.Internal
import qualified Data.ByteString as S
import Codec.Compression.GZip (compress)
import qualified Data.ByteString.Lazy as L
main :: IO ()
main = hspec spec
brComplete :: BodyReader -> IO Bool
brComplete brRead' = do
xs <- brRead'
return (xs == "")
spec :: Spec
spec = describe "BodySpec" $ do
it "chunked, single" $ do
(conn, _, input) <- dummyConnection
[ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"
]
reader <- makeChunkedReader False conn
body <- brConsume reader
S.concat body `shouldBe` "hello world"
input' <- input
S.concat input' `shouldBe` "not consumed"
brComplete reader `shouldReturn` True
it "chunked, pieces" $ do
(conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack
"5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"
reader <- makeChunkedReader False conn
body <- brConsume reader
S.concat body `shouldBe` "hello world"
input' <- input
S.concat input' `shouldBe` "not consumed"
brComplete reader `shouldReturn` True
it "chunked, raw" $ do
(conn, _, input) <- dummyConnection
[ "5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"
]
reader <- makeChunkedReader True conn
body <- brConsume reader
S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\n"
input' <- input
S.concat input' `shouldBe` "not consumed"
brComplete reader `shouldReturn` True
it "chunked, pieces, raw" $ do
(conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack
"5\r\nhello\r\n6\r\n world\r\n0\r\nnot consumed"
reader <- makeChunkedReader True conn
body <- brConsume reader
S.concat body `shouldBe` "5\r\nhello\r\n6\r\n world\r\n0\r\n"
input' <- input
S.concat input' `shouldBe` "not consumed"
brComplete reader `shouldReturn` True
it "length, single" $ do
(conn, _, input) <- dummyConnection
[ "hello world done"
]
reader <- makeLengthReader 11 conn
body <- brConsume reader
S.concat body `shouldBe` "hello world"
input' <- input
S.concat input' `shouldBe` " done"
brComplete reader `shouldReturn` True
it "length, pieces" $ do
(conn, _, input) <- dummyConnection $ map S.singleton $ S.unpack
"hello world done"
reader <- makeLengthReader 11 conn
body <- brConsume reader
S.concat body `shouldBe` "hello world"
input' <- input
S.concat input' `shouldBe` " done"
brComplete reader `shouldReturn` True
it "gzip" $ do
let orig = L.fromChunks $ replicate 5000 "Hello world!"
origZ = compress orig
(conn, _, input) <- dummyConnection $ L.toChunks origZ ++ ["ignored"]
reader' <- makeLengthReader (fromIntegral $ L.length origZ) conn
reader <- makeGzipReader reader'
body <- brConsume reader
L.fromChunks body `shouldBe` orig
input' <- input
S.concat input' `shouldBe` "ignored"
brComplete reader `shouldReturn` True
http-client-0.5.14/test-nonet/Network/HTTP/Client/HeadersSpec.hs 0000644 0000000 0000000 00000004322 12632352123 022472 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.HeadersSpec where
import Network.HTTP.Client.Internal
import Network.HTTP.Types
import Test.Hspec
main :: IO ()
main = hspec spec
spec :: Spec
spec = describe "HeadersSpec" $ do
it "simple response" $ do
let input =
[ "HTTP/"
, "1.1 200"
, " OK\r\nfoo"
, ": bar\r\n"
, "baz:bin\r\n\r"
, "\nignored"
]
(connection, _, _) <- dummyConnection input
statusHeaders <- parseStatusHeaders connection Nothing Nothing
statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1)
[ ("foo", "bar")
, ("baz", "bin")
]
it "Expect: 100-continue (success)" $ do
let input =
[ "HTTP/1.1 100 Continue\r\n\r\n"
, "HTTP/1.1 200 OK\r\n"
, "foo: bar\r\n\r\n"
]
(conn, out, _) <- dummyConnection input
let sendBody = connectionWrite conn "data"
statusHeaders <- parseStatusHeaders conn Nothing (Just sendBody)
statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") ]
out >>= (`shouldBe` ["data"])
it "Expect: 100-continue (failure)" $ do
let input =
[ "HTTP/1.1 417 Expectation Failed\r\n\r\n"
]
(conn, out, _) <- dummyConnection input
let sendBody = connectionWrite conn "data"
statusHeaders <- parseStatusHeaders conn Nothing (Just sendBody)
statusHeaders `shouldBe` StatusHeaders status417 (HttpVersion 1 1) []
out >>= (`shouldBe` [])
it "100 Continue without expectation is OK" $ do
let input =
[ "HTTP/1.1 100 Continue\r\n\r\n"
, "HTTP/1.1 200 OK\r\n"
, "foo: bar\r\n\r\n"
, "result"
]
(conn, out, inp) <- dummyConnection input
statusHeaders <- parseStatusHeaders conn Nothing Nothing
statusHeaders `shouldBe` StatusHeaders status200 (HttpVersion 1 1) [ ("foo", "bar") ]
out >>= (`shouldBe` [])
inp >>= (`shouldBe` ["result"])
http-client-0.5.14/test-nonet/Network/HTTP/Client/RequestSpec.hs 0000644 0000000 0000000 00000016444 13374444652 022574 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.RequestSpec where
import Blaze.ByteString.Builder (fromByteString)
import Control.Applicative as A ((<$>))
import Control.Monad (join, forM_, (<=<))
import Data.IORef
import Data.Maybe (isJust, fromMaybe, fromJust)
import Network.HTTP.Client.Internal
import Network.URI (URI(..), URIAuth(..), parseURI)
import Test.Hspec
import Data.Monoid ((<>))
import Network.HTTP.Client (defaultRequest)
import Data.List (isInfixOf)
spec :: Spec
spec = do
describe "case insensitive scheme" $ do
forM_ ["http://example.com", "httP://example.com", "HttP://example.com", "HttPs://example.com"] $ \url -> do
it url $ case parseUrlThrow url of
Nothing -> error "failed"
Just _ -> return () :: IO ()
it ("URI " ++ url) $ do
case parseURI url of
Nothing -> error ("invalid test URI: " ++ url)
Just uri ->
case requestFromURI uri of
Nothing -> error "failed"
Just _ -> return () :: IO ()
forM_ ["ftp://example.com"] $ \url -> do
it url $ case parseUrlThrow url of
Nothing -> return () :: IO ()
Just req -> error $ show req
it ("URI " ++ url) $ do
case parseURI url of
Nothing -> error ("invalid test URI: " ++ url)
Just uri ->
case requestFromURI uri of
Nothing -> return () :: IO ()
Just req -> error (show req)
describe "authentication in url" $ do
it "passes validation" $ do
case parseUrlThrow "http://agent:topsecret@example.com" of
Nothing -> error "failed"
Just _ -> return () :: IO ()
it "add username/password to headers section" $ do
let request = parseUrlThrow "http://user:pass@example.com"
field = join $ lookup "Authorization" . requestHeaders A.<$> request
requestHostnameWithoutAuth = "example.com"
(uriRegName $ fromJust $ uriAuthority $ getUri $ fromJust request) `shouldBe` requestHostnameWithoutAuth
field `shouldSatisfy` isJust
field `shouldBe` Just "Basic dXNlcjpwYXNz"
describe "getUri" $ do
context "when protocol is http and port is 80" $ do
it "omits port" $ do
let url = "http://example.com/"
request <- parseRequest url
show (getUri request) `shouldBe` url
context "when protocol is https and port is 443" $ do
it "omits port" $ do
let url = "https://example.com/"
request <- parseRequest url
show (getUri request) `shouldBe` url
context "when protocol is https and port is 80" $ do
it "does not omit port" $ do
let url = "https://example.com:80/"
request <- parseRequest url
show (getUri request) `shouldBe` url
describe "Show Request" $
it "redacts authorization header content" $ do
let request = defaultRequest { requestHeaders = [("Authorization", "secret")] }
isInfixOf "secret" (show request) `shouldBe` False
describe "applyBasicProxyAuth" $ do
let request = applyBasicProxyAuth "user" "pass" <$> parseUrlThrow "http://example.org"
field = join $ lookup "Proxy-Authorization" . requestHeaders <$> request
it "Should add a proxy-authorization header" $ do
field `shouldSatisfy` isJust
it "Should add a proxy-authorization header with the specified username and password." $ do
field `shouldBe` Just "Basic dXNlcjpwYXNz"
describe "extract credentials from a URI" $ do
let username = return . fst <=< extractBasicAuthInfo <=< parseURI
password = return . snd <=< extractBasicAuthInfo <=< parseURI
it "fetches non-empty username before the first ':'" $ do
username "http://agent:secret@example.com" `shouldBe` Just "agent"
it "after ':' is considered password" $ do
password "http://agent007:shakenNotStirred@example.com" `shouldBe` Just "shakenNotStirred"
it "decodes username special characters per RFC3986" $ do
username "http://%2F%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D:therealpassword@example.com" `shouldBe` Just "/?#[]!$&'()*+,;="
it "decodes password special characters per RFC3986" $ do
password "http://therealusername:%3F%23%5B%5D%21%24%26%27%28%29%2A%2B%2C%3B%3D%2F@example.com" `shouldBe` Just "?#[]!$&'()*+,;=/"
it "no auth is empty" $ do
username "http://example.com" `shouldBe` Nothing
password "http://example.com" `shouldBe` Nothing
describe "requestBuilder" $ do
it "sends the full request, combining headers and body in the non-streaming case" $ do
let Just req = parseUrlThrow "http://localhost"
let req' = req { method = "PUT", path = "foo" }
(conn, out, _) <- dummyConnection []
forM_ (bodies `zip` out1) $ \(b, o) -> do
cont <- requestBuilder (req' { requestBody = b } ) conn
(const ("" :: String) <$> cont) `shouldBe` Nothing
out >>= (`shouldBe` o)
it "sends only headers and returns an action for the body on 'Expect: 100-continue'" $ do
let Just req = parseUrlThrow "http://localhost"
let req' = req { requestHeaders = [("Expect", "100-continue")]
, method = "PUT"
, path = "foo"
}
(conn, out, _) <- dummyConnection []
forM_ (bodies `zip` out2) $ \(b, (h, o)) -> do
cont <- requestBuilder (req' { requestBody = b } ) conn
out >>= (`shouldBe` [h, ""])
fromMaybe (return ()) cont
out >>= (`shouldBe` o)
where
bodies = [ RequestBodyBS "data"
, RequestBodyLBS "data"
, RequestBodyBuilder 4 (fromByteString "data")
, RequestBodyStream 4 (popper ["data"] >>=)
, RequestBodyStreamChunked (popper ["data"] >>=)
]
out1 = [ [nonChunked <> "\r\ndata"]
, [nonChunked <> "\r\ndata"]
, [nonChunked <> "\r\ndata"]
, [nonChunked <> "\r\n", "", "data"]
, [chunked <> "\r\n", "", "4\r\ndata\r\n","0\r\n\r\n"]
]
out2 = [ (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"])
, (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"])
, (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"])
, (nonChunked <> "Expect: 100-continue\r\n\r\n", ["data"])
, (chunked <> "Expect: 100-continue\r\n\r\n", ["4\r\ndata\r\n","0\r\n\r\n"])
]
nonChunked = "PUT /foo HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\nContent-Length: 4\r\n"
chunked = "PUT /foo HTTP/1.1\r\nHost: localhost\r\nAccept-Encoding: gzip\r\nTransfer-Encoding: chunked\r\n"
popper dat = do
r <- newIORef dat
return . atomicModifyIORef r $ \xs ->
case xs of
(x:xs') -> (xs', x)
[] -> ([], "")
http-client-0.5.14/test-nonet/Network/HTTP/Client/RequestBodySpec.hs 0000644 0000000 0000000 00000003257 13025776351 023405 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.RequestBodySpec where
import Control.Monad
import Test.Hspec
import Control.Exception
import System.IO
import Data.IORef
import qualified Data.ByteString as BS
import Network.HTTP.Client (streamFile, parseUrlThrow, requestBody)
import Network.HTTP.Client.Internal (dummyConnection, connectionWrite, requestBuilder)
import System.Directory (getTemporaryDirectory)
spec :: Spec
spec = describe "streamFile" $ it "works" $ withTmpFile $ \(path, h) -> do
replicateM_ 5000 $ BS.hPut h "Hello, world!\r\n"
hClose h
withBinaryFile path ReadMode $ \h' -> do
conn <- verifyFileConnection h'
req0 <- parseUrlThrow "http://example.com"
body <- streamFile path
let req = req0 { requestBody = body }
_ <- requestBuilder req conn
hIsEOF h' `shouldReturn` True
where
withTmpFile = bracket getTmpFile closeTmpFile
getTmpFile = do
tmp <- getTemporaryDirectory
openBinaryTempFile tmp "request-body-stream-file"
closeTmpFile (_, h) = hClose h
firstReadBS = "GET / HTTP/1.1\r\nHost: example.com\r\nAccept-Encoding: gzip\r\nContent-Length: 75000\r\n\r\n"
verifyFileConnection h = do
(conn, _, _) <- dummyConnection []
isFirstReadRef <- newIORef True
return conn
{ connectionWrite = \bs -> do
isFirstRead <- readIORef isFirstReadRef
if isFirstRead
then do
bs `shouldBe` firstReadBS
writeIORef isFirstReadRef False
else do
bs' <- BS.hGet h (BS.length bs)
bs `shouldBe` bs'
}
http-client-0.5.14/test-nonet/Network/HTTP/Client/CookieSpec.hs 0000644 0000000 0000000 00000001706 13025776351 022345 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Client.CookieSpec where
import Data.Time.Clock
import Network.HTTP.Client.Internal
import Test.Hspec
main :: IO ()
main = hspec spec
spec :: Spec
spec = describe "CookieSpec" $ do
it "cookie equality - case insensitive Eq" $ do
now <- getCurrentTime
let cookie1 = Cookie "test" "value" now "doMain.Org" "/" now now False False False False
cookie2 = Cookie "test" "value" now "DOMAIn.ORg" "/" now now False False False False
cookie1 `shouldBe` cookie2
it "domainMatches - case insensitive" $ do
domainMatches "www.org" "www.org" `shouldBe` True
domainMatches "wWw.OrG" "Www.oRG" `shouldBe` True
domainMatches "wxw.OrG" "Www.oRG" `shouldBe` False
it "domainMatches - case insensitive, partial" $ do
domainMatches "www.org" "xxx.www.org" `shouldBe` False
domainMatches "xxx.www.org" "WWW.ORG" `shouldBe` True
http-client-0.5.14/test/Spec.hs 0000644 0000000 0000000 00000000054 12632352123 014425 0 ustar 00 0000000 0000000 {-# OPTIONS_GHC -F -pgmF hspec-discover #-}
http-client-0.5.14/test/Network/HTTP/ClientSpec.hs 0000644 0000000 0000000 00000007616 13127654176 020024 0 ustar 00 0000000 0000000 {-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.ClientSpec where
import qualified Data.ByteString.Char8 as BS
import Network.HTTP.Client
import Network.HTTP.Client.Internal
import Network.HTTP.Types (status200, found302, status405)
import Network.HTTP.Types.Status
import Test.Hspec
import Control.Applicative ((<$>))
import Data.ByteString.Lazy.Char8 () -- orphan instance
main :: IO ()
main = hspec spec
spec :: Spec
spec = describe "Client" $ do
it "works" $ do
req <- parseUrlThrow "http://httpbin.org/"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status200
describe "method in URL" $ do
it "success" $ do
req <- parseUrlThrow "POST http://httpbin.org/post"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status200
it "failure" $ do
req <- parseRequest "PUT http://httpbin.org/post"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status405
describe "redirects" $ do
it "follows redirects" $ do
req <- parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` status200
it "allows to disable redirect following" $ do
req <- (\ r -> r{ redirectCount = 0 }) <$>
parseRequest "http://httpbin.org/redirect-to?url=http://httpbin.org"
man <- newManager defaultManagerSettings
res <- httpLbs req man
responseStatus res `shouldBe` found302
context "managerModifyResponse" $ do
it "allows to modify the response status code" $ do
let modify :: Response BodyReader -> IO (Response BodyReader)
modify res = do
return res {
responseStatus = (responseStatus res) {
statusCode = 201
}
}
settings = defaultManagerSettings { managerModifyResponse = modify }
man <- newManager settings
res <- httpLbs "http://httpbin.org" man
(statusCode.responseStatus) res `shouldBe` 201
it "modifies the response body" $ do
let modify :: Response BodyReader -> IO (Response BodyReader)
modify res = do
reader <- constBodyReader [BS.pack "modified response body"]
return res {
responseBody = reader
}
settings = defaultManagerSettings { managerModifyResponse = modify }
man <- newManager settings
res <- httpLbs "http://httpbin.org" man
responseBody res `shouldBe` "modified response body"
context "managerModifyRequest" $ do
it "port" $ do
let modify req = return req { port = 80 }
settings = defaultManagerSettings { managerModifyRequest = modify }
man <- newManager settings
res <- httpLbs "http://httpbin.org:1234" man
responseStatus res `shouldBe` status200
it "checkResponse" $ do
let modify req = return req { checkResponse = \_ _ -> error "some exception" }
settings = defaultManagerSettings { managerModifyRequest = modify }
man <- newManager settings
httpLbs "http://httpbin.org" man `shouldThrow` anyException
it "redirectCount" $ do
let modify req = return req { redirectCount = 0 }
settings = defaultManagerSettings { managerModifyRequest = modify }
man <- newManager settings
response <- httpLbs "http://httpbin.org/redirect-to?url=foo" man
responseStatus response `shouldBe` found302
http-client-0.5.14/LICENSE 0000644 0000000 0000000 00000002072 12632352123 013227 0 ustar 00 0000000 0000000 The MIT License (MIT)
Copyright (c) 2013 Michael Snoyman
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.
http-client-0.5.14/Setup.hs 0000644 0000000 0000000 00000000056 12632352123 013656 0 ustar 00 0000000 0000000 import Distribution.Simple
main = defaultMain
http-client-0.5.14/http-client.cabal 0000644 0000000 0000000 00000012311 13374444652 015453 0 ustar 00 0000000 0000000 name: http-client
version: 0.5.14
synopsis: An HTTP client engine
description: Hackage documentation generation is not reliable. For up to date documentation, please see: .
homepage: https://github.com/snoyberg/http-client
license: MIT
license-file: LICENSE
author: Michael Snoyman
maintainer: michael@snoyman.com
category: Network
build-type: Simple
extra-source-files: README.md ChangeLog.md
cabal-version: >=1.10
flag network-uri
description: Get Network.URI from the network-uri package
default: True
library
hs-source-dirs: ., publicsuffixlist
exposed-modules: Network.HTTP.Client
Network.HTTP.Client.MultipartFormData
Network.HTTP.Client.Internal
other-modules: Network.HTTP.Client.Body
Network.HTTP.Client.Connection
Network.HTTP.Client.Cookies
Network.HTTP.Client.Core
Network.HTTP.Client.Headers
Network.HTTP.Client.Manager
Network.HTTP.Client.Request
Network.HTTP.Client.Response
Network.HTTP.Client.Types
Network.HTTP.Client.Util
Network.HTTP.Proxy
Network.PublicSuffixList.Lookup
Network.PublicSuffixList.Types
Network.PublicSuffixList.Serialize
Network.PublicSuffixList.DataStructure
Data.KeyedPool
build-depends: base >= 4.6 && < 5
, bytestring >= 0.10
, text >= 0.11
, http-types >= 0.8
, blaze-builder >= 0.3
, time >= 1.2
, network >= 2.4
, streaming-commons >= 0.1.0.2 && < 0.3
, containers >= 0.5
, transformers
, deepseq >= 1.3 && <1.5
, case-insensitive >= 1.0
, memory >= 0.7
, cookie
, exceptions >= 0.4
, array
, random
, filepath
, mime-types
, ghc-prim
, stm >= 2.3
if flag(network-uri)
build-depends: network >= 2.6, network-uri >= 2.6
else
build-depends: network < 2.6
if !impl(ghc>=8.0)
build-depends: semigroups >= 0.16.1
-- See build failure at https://travis-ci.org/snoyberg/http-client/jobs/359573631
if impl(ghc < 7.10)
-- Disable building with GHC before 8.0.2.
-- Due to a cabal bug, do not use buildable: False,
-- but instead give it an impossible constraint.
-- See: https://github.com/haskell-infra/hackage-trustees/issues/165
build-depends: unsupported-ghc-version > 1 && < 1
if os(mingw32)
build-depends: Win32, safe
default-language: Haskell2010
test-suite spec
main-is: Spec.hs
type: exitcode-stdio-1.0
hs-source-dirs: test
default-language: Haskell2010
other-modules: Network.HTTP.ClientSpec
build-depends: base
, http-client
, hspec
, monad-control
, bytestring
, text
, http-types
, blaze-builder
, time
, network
, containers
, transformers
, deepseq
, case-insensitive
, zlib
, async
, streaming-commons >= 0.1.1
test-suite spec-nonet
main-is: Spec.hs
type: exitcode-stdio-1.0
hs-source-dirs: test-nonet
default-language: Haskell2010
ghc-options: -threaded
if os(windows)
cpp-options: -DWINDOWS
other-modules: Network.HTTP.ClientSpec
Network.HTTP.Client.ResponseSpec
Network.HTTP.Client.BodySpec
Network.HTTP.Client.HeadersSpec
Network.HTTP.Client.RequestSpec
Network.HTTP.Client.RequestBodySpec
Network.HTTP.Client.CookieSpec
build-depends: base
, http-client
, hspec
, monad-control
, bytestring
, text
, http-types
, blaze-builder
, time
, network
, network-uri
, containers
, transformers
, deepseq
, case-insensitive
, zlib
, async
, streaming-commons >= 0.1.1
, directory
http-client-0.5.14/README.md 0000644 0000000 0000000 00000002323 13025776351 013512 0 ustar 00 0000000 0000000 http-client
===========
Full tutorial docs are available at:
https://haskell-lang.org/library/http-client
An HTTP client engine, intended as a base layer for more user-friendly packages.
This codebase has been refactored from [http-conduit](http://www.stackage.org/package/http-conduit).
Note that, if you want to make HTTPS secure connections, you should use
[http-client-tls](https://www.stackage.org/package/http-client-tls) in addition
to this library.
Below is a series of cookbook recipes. A number of recipes exist elsewhere,
including `Network.HTTP.Client` and `Network.HTTP.Conduit`. The goal is to
expand this list over time.
## Proxy environment variable
Use the following approach to get proxy settings from the `http_proxy` and
`https_proxy` environment variables.
```haskell
{-# LANGUAGE OverloadedStrings #-}
import Network.HTTP.Client
main :: IO ()
main = do
let settings = managerSetProxy
(proxyEnvironment Nothing)
defaultManagerSettings
man <- newManager settings
let req = "http://httpbin.org"
-- Note that the following settings will be completely ignored.
{ proxy = Just $ Proxy "localhost" 1234
}
httpLbs req man >>= print
```
http-client-0.5.14/ChangeLog.md 0000644 0000000 0000000 00000021370 13374464330 014405 0 ustar 00 0000000 0000000 # Changelog for http-client
## 0.5.14
* Omit port for `getUri` when protocol is `http` and port is `80`, or when
protocol is `https` and port is `443`
* Sending requests with invalid headers now throws InvalidRequestHeader exception
## 0.5.13.1
* Add a workaround for a cabal bug [haskell-infra/hackage-trustees#165](https://github.com/haskell-infra/hackage-trustees/issues/165)
## 0.5.13
* Adds `setRequestCheckStatus` and `throwErrorStatusCodes` functions.
See [#304](https://github.com/snoyberg/http-client/issues/304)
* Add `withConnection` function.
See [#352](https://github.com/snoyberg/http-client/pull/352).
## 0.5.12.1
* Make the chunked transfer-encoding detection case insensitive
[#303](https://github.com/snoyberg/http-client/pull/303)
* Remove some unneeded language extensions
* Mark older versions of GHC as unsupported
## 0.5.12
* Added `requestFromURI` and `requestFromURI_` functions.
* Fixed non-TLS connections going though proxy [#337](https://github.com/snoyberg/http-client/issues/337)
## 0.5.11
* Replaced `base64-bytestring` dependency with `memory`.
## 0.5.10
* New function to partial escape query strings
## 0.5.9
* Add `Semigroup` instances for GHC 8.4 [#320](https://github.com/snoyberg/http-client/pull/320)
## 0.5.8
* Switch to the new STM-based manager
[#254](https://github.com/snoyberg/http-client/pull/254)
* Redact sensitive headers [#318](https://github.com/snoyberg/http-client/pull/318)
## 0.5.7.1
* Code cleanup/delete dead code
* Compat with Win32 2.6 [#309](https://github.com/snoyberg/http-client/issues/309)
## 0.5.7.0
* Support for Windows system proxy settings
[#274](https://github.com/snoyberg/http-client/pull/274)
## 0.5.6.1
* Revert socks5 and socks5h support from
[#262](https://github.com/snoyberg/http-client/pull/262); the support was
untested and did not work as intended.
## 0.5.6
* Added socks5 and socks5h support [#262](https://github.com/snoyberg/http-client/pull/262)
## 0.5.5
* http-client should allow to log requests and responses [#248](https://github.com/snoyberg/http-client/issues/248)
## 0.5.4
* Derive ‘Eq’ for ‘ResponseTimeout’ [#239](https://github.com/snoyberg/http-client/pull/239)
## 0.5.3.4
* Doc improvements
## 0.5.3.3
* Add missing colon in Host header [#235](https://github.com/snoyberg/http-client/pull/235)
## 0.5.3.2
* Minor doc updates
## 0.5.3.1
* The closeConnection method for tls connections should not be called multiple
times [#225](https://github.com/snoyberg/http-client/issues/225)
## 0.5.3
* Expose `makeConnection` and `socketConnection` as a stable API [#223](https://github.com/snoyberg/http-client/issues/223)
## 0.5.2
* Enable rawConnectionModifySocketSize to expose openSocketConnectionSize [#218](https://github.com/snoyberg/http-client/pull/218)
## 0.5.1
* Enable managerModifyRequest to modify redirectCount [#208](https://github.com/snoyberg/http-client/pull/208)
## 0.5.0.1
* Doc fix
## 0.5.0
* Remove `instance Default Request`
* Modify `instance IsString Request` to use `parseRequest` instead of `parseUrlThrow`
* Clean up the `HttpException` constructors
* Rename `checkStatus` to `checkResponse` and modify type
* Fix the ugly magic constant workaround for responseTimeout
* Remove `getConnectionWrapper`
* Add the `HttpExceptionRequest` wrapper so that all exceptions related to a
request are thrown with that request's information
## 0.4.31
* Added length validation for RequestBodyStream [#205](https://github.com/snoyberg/http-client/pull/205)
## 0.4.30
* Initial implementation of [#193](https://github.com/snoyberg/http-client/issues/193)
* Deprecate `parseUrl`
* Add `parseUrlThrow`, `parseRequest`, and `parseRequest_`
## 0.4.29
* Changed the order of connecting a socket and tweaking a socket, such that the socket tweaking callback now happen before connecting.
* add setRequestIgnoreStatus [#201](https://github.com/snoyberg/http-client/pull/201)
* Added missing Host: HTTP header for https CONNECT [#192](https://github.com/snoyberg/http-client/pull/192)
* Fix: Redirects will be followed in httpRaw' when reusing a dead connection [#195](https://github.com/snoyberg/http-client/issues/195)
## 0.4.28
* Add support for including request method in URL
* `requestManagerOverride`
* `RequestBodyIO`
## 0.4.27.1
* Incorrect idle connection count in HTTP manager [#185](https://github.com/snoyberg/http-client/issues/185)
## 0.4.27
* Enable managerModifyRequest to modify checkStatus [#179](https://github.com/snoyberg/http-client/pull/179)
## 0.4.26.2
* Fix compilation for GHC 7.4
## 0.4.26.1
* Fix compilation for GHC < 7.10
## 0.4.26
* Make sure we never read from or write to closed socket [#170](https://github.com/snoyberg/http-client/pull/170)
## 0.4.25
* Don't error out when response body flushing fails [#169](https://github.com/snoyberg/http-client/issues/169)
## 0.4.24
* Use a new `TlsExceptionHostPort` exception to indicate the host and port of the server we were trying to connect to when a TLS exception occurred. See [commercialhaskell/stack#1010](https://github.com/commercialhaskell/stack/issues/1010)
## 0.4.23
* Case insensitive cookie domains [#158](https://github.com/snoyberg/http-client/issues/158)
## 0.4.22
* ProxyConnectException now returns Right HttpException. [#155](https://github.com/snoyberg/http-client/pull/155)
## 0.4.21
* Support `no_proxy` environment variable. [#140](https://github.com/snoyberg/http-client/issues/140) [#145](https://github.com/snoyberg/http-client/pull/145)
## 0.4.20
* Expose `brReadSome`
## 0.4.19
* Move HasHttpManager from http-conduit to http-client [#147](https://github.com/snoyberg/http-client/pull/147)
* Chunked request bodies use less TCP packets [#149](https://github.com/snoyberg/http-client/issues/149)
## 0.4.18
* Deprecate closeManager [#136](https://github.com/snoyberg/http-client/issues/136) [#137](https://github.com/snoyberg/http-client/issues/137)
## 0.4.17
* Case insensitive proxy environment variables [#135](https://github.com/snoyberg/http-client/issues/135)
## 0.4.16
* Proxy auth for HTTPS [#132](https://github.com/snoyberg/http-client/issues/132)
## 0.4.15
* Support proxy authentication in environment variables [#129](https://github.com/snoyberg/http-client/issues/129)
## 0.4.14
* Ignore empty `http_proxy` [#128](https://github.com/snoyberg/http-client/pull/128)
## 0.4.13
* Support for auth via url [#124](https://github.com/snoyberg/http-client/pull/124)
## 0.4.12
* Added `IsString RequestBody` instance [#126](https://github.com/snoyberg/http-client/pull/126)
## 0.4.11.3
* Fix getUri to insert "?" to uriQuery when necessary. [#123](https://github.com/snoyberg/http-client/pull/123)
## 0.4.11.2
* Removed publicsuffixlist dependency, see [Github discussion](https://github.com/litherum/publicsuffixlist/pull/7)
## 0.4.11.1
* Disable custom timeout code [#116](https://github.com/snoyberg/http-client/issues/116)
## 0.4.11
* Ignore the 'Content-Length' header if the body contains chunked data [#115](https://github.com/snoyberg/http-client/pull/115)
## 0.4.10
* Expect: 100-continue [#114](https://github.com/snoyberg/http-client/pull/114)
## 0.4.9
* Add RequestBody smart constructors `streamFile` and `streamFileObserved`, the latter with accompanying type `StreamFileStatus`.
## 0.4.8.1
* Automatically call withSocketsDo everywhere [#107](https://github.com/snoyberg/http-client/issues/107)
## 0.4.8
* Add the `ResponseLengthAndChunkingBothUsed` exception constructor [#108](https://github.com/snoyberg/http-client/issues/108)
## 0.4.7.2
* Improved `timeout` implementation for high contention cases [#98](https://github.com/snoyberg/http-client/issues/98)
## 0.4.7.1
* Fix for shared connections in proxy servers [#103](https://github.com/snoyberg/http-client/issues/103)
## 0.4.7
* [Support http\_proxy and https\_proxy environment variables](https://github.com/snoyberg/http-client/issues/94)
## 0.4.6.1
Separate tests not requiring internet access. [#93](https://github.com/snoyberg/http-client/pull/93)
## 0.4.6
Add `onRequestBodyException` to `Request` to allow for recovering from
exceptions when sending the request. Most useful for servers which terminate
the connection after sending a response body without flushing the request body.
## 0.4.5
Add `openSocketConnectionSize` and increase default chunk size to 8192.
## 0.4.4
Add `managerModifyRequest` field to `ManagerSettings`.
## 0.4.3
Add `requestVersion` field to `Request`.
## 0.4.2
The reaper thread for a manager will go to sleep completely when there are no connection to manage. See: https://github.com/snoyberg/http-client/issues/70
## 0.4.1
* Provide the `responseOpenHistory`/`withResponseHistory` API. See: https://github.com/snoyberg/http-client/pull/79
## 0.4.0
* Hide the `Part` constructor, and allow for additional headers. See: https://github.com/snoyberg/http-client/issues/76