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