1 module Databrary.HTTP 2 ( encodePathSegments' 3 , encodePath' 4 , splitHTTP 5 , quoteHTTP 6 , unquoteHTTP 7 , formatHTTPTimestamp 8 , parseHTTPTimestamp 9 ) where 10 11 import Control.Monad (msum) 12 import qualified Data.ByteString as BS 13 import qualified Data.ByteString.Builder as BSB 14 import qualified Data.ByteString.Char8 as BSC 15 import Data.Char (isSpace, isControl) 16 import Data.Monoid ((<>)) 17 import qualified Data.Text as T 18 import Data.Time.Format (formatTime, parseTimeM, defaultTimeLocale) 19 import Network.HTTP.Types (Query, encodePathSegments, renderQueryBuilder) 20 21 import Databrary.Model.Time 22 23 -- | Same as 'encodePathSegments' but for absolute paths (empty results in a single slash) 24 encodePathSegments' :: [T.Text] -> BSB.Builder 25 encodePathSegments' [] = BSB.char8 '/' 26 encodePathSegments' p = encodePathSegments p 27 28 -- | Same as 'encodePath' but using 'encodePathSegments'' 29 encodePath' :: [T.Text] -> Query -> BSB.Builder 30 encodePath' p [] = encodePathSegments' p 31 encodePath' p q = encodePathSegments' p <> renderQueryBuilder True q 32 33 splitHTTP :: BS.ByteString -> [BS.ByteString] 34 splitHTTP = filter (not . BS.null) . map trim . BSC.split ',' where 35 trim = fst . BSC.spanEnd isSpace . BSC.dropWhile isSpace 36 37 quoteHTTP :: BS.ByteString -> BS.ByteString 38 quoteHTTP = BSC.pack . ('"':) . quote . BSC.unpack where 39 quote "" = "\"" 40 quote ('\\':r) = '\\':'\\':quote r 41 quote ('"':r) = '\\':'"':quote r 42 quote (c:r) 43 | isControl c = '\\':c:quote r 44 | otherwise = c:quote r 45 46 unquoteHTTP :: BS.ByteString -> BS.ByteString 47 unquoteHTTP s 48 | BS.length s >= 2 && BSC.head s == '"' && BSC.last s == '"' = 49 BSC.pack $ unquote $ BSC.unpack $ BS.tail $ BS.init s 50 | otherwise = s where 51 unquote ('\\':c:r) = c:unquote r 52 unquote (c:r) = c:unquote r 53 unquote [] = [] 54 55 dateFmts :: [String] 56 -- rfc1123Date, rfc850Date, asctimeDate 57 dateFmts = ["%a, %d %b %Y %T GMT", "%A, %d-%b-%y %T GMT", "%a %b %e %T %Y"] 58 59 defaultDateFmt :: String 60 defaultDateFmt = head dateFmts 61 62 formatHTTPTimestamp :: Timestamp -> BS.ByteString 63 formatHTTPTimestamp = BSC.pack . formatTime defaultTimeLocale defaultDateFmt 64 65 parseHTTPTimestamp :: BS.ByteString -> Maybe Timestamp 66 parseHTTPTimestamp b = msum $ map (\f -> parseTimeM True defaultTimeLocale f s) dateFmts where s = BSC.unpack b