http-date-0.0.6.1/0000755000000000000000000000000012524017414011734 5ustar0000000000000000http-date-0.0.6.1/http-date.cabal0000644000000000000000000000311212524017414014607 0ustar0000000000000000Name: http-date Version: 0.0.6.1 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: HTTP Date parser/formatter Description: Fast parser and formatter for HTTP Date Category: Network, Web Cabal-Version: >= 1.8 Build-Type: Simple Library GHC-Options: -Wall Exposed-Modules: Network.HTTP.Date Other-Modules: Network.HTTP.Date.Converter Network.HTTP.Date.Formatter Network.HTTP.Date.Types Network.HTTP.Date.Parser Build-Depends: base >= 4 && < 5 , array , attoparsec , bytestring Test-Suite spec Type: exitcode-stdio-1.0 HS-Source-Dirs: test Main-Is: Spec.hs Other-Modules: DateSpec Model Build-Depends: base >= 4 && < 5 , bytestring , hspec , http-date , old-locale , time Test-Suite doctests Type: exitcode-stdio-1.0 HS-Source-Dirs: test Ghc-Options: -threaded Main-Is: doctests.hs Build-Depends: base , doctest >= 0.8 Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/http-date http-date-0.0.6.1/LICENSE0000644000000000000000000000276512524017414012753 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. 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. * Neither the name of the copyright holders nor the names of its contributors may 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. http-date-0.0.6.1/Setup.hs0000644000000000000000000000005612524017414013371 0ustar0000000000000000import Distribution.Simple main = defaultMain http-date-0.0.6.1/Network/0000755000000000000000000000000012524017414013365 5ustar0000000000000000http-date-0.0.6.1/Network/HTTP/0000755000000000000000000000000012524017414014144 5ustar0000000000000000http-date-0.0.6.1/Network/HTTP/Date.hs0000644000000000000000000000052612524017414015360 0ustar0000000000000000{-| Fast parser and formatter for HTTP Date. -} module Network.HTTP.Date ( module Network.HTTP.Date.Types -- * Utility functions , parseHTTPDate , formatHTTPDate , epochTimeToHTTPDate ) where import Network.HTTP.Date.Converter import Network.HTTP.Date.Formatter import Network.HTTP.Date.Parser import Network.HTTP.Date.Types http-date-0.0.6.1/Network/HTTP/Date/0000755000000000000000000000000012524017414015021 5ustar0000000000000000http-date-0.0.6.1/Network/HTTP/Date/Converter.hs0000644000000000000000000000526012524017414017327 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} module Network.HTTP.Date.Converter (epochTimeToHTTPDate) where import Control.Applicative import Data.ByteString.Internal import Data.Word import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable import Network.HTTP.Date.Types import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types {-| Translating 'EpochTime' to 'HTTPDate'. -} epochTimeToHTTPDate :: EpochTime -> HTTPDate epochTimeToHTTPDate x = defaultHTTPDate { hdYear = y , hdMonth = m , hdDay = d , hdHour = h , hdMinute = n , hdSecond = s , hdWkday = w } where w64 :: Word64 w64 = fromIntegral $ fromEnum x (days',secs') = w64 `quotRem` 86400 days = fromIntegral days' secs = fromIntegral secs' -- 1970/1/1 is Thu (4) w = (days + 3) `rem` 7 + 1 (y,m,d) = toYYMMDD days (h,n,s) = toHHMMSS secs toYYMMDD :: Int -> (Int,Int,Int) toYYMMDD x = (yy, mm, dd) where (y,d) = x `quotRem` 365 cy = 1970 + y cy' = cy - 1 leap = cy' `quot` 4 - cy' `quot` 100 + cy' `quot` 400 - 477 (yy,days) = adjust cy d leap (mm,dd) = findMonth days adjust !ty td aj | td >= aj = (ty, td - aj) | isLeap (ty - 1) = if td + 366 >= aj then (ty - 1, td + 366 - aj) else adjust (ty - 1) (td + 366) aj | otherwise = if td + 365 >= aj then (ty - 1, td + 365 - aj) else adjust (ty - 1) (td + 365) aj isLeap year = year `rem` 4 == 0 && (year `rem` 400 == 0 || year `rem` 100 /= 0) (months, daysArr) = if isLeap yy then (leapMonth, leapDayInMonth) else (normalMonth, normalDayInMonth) findMonth n = inlinePerformIO $ (,) <$> (peekElemOff months n) <*> (peekElemOff daysArr n) ---------------------------------------------------------------- normalMonthDays :: [Int] normalMonthDays = [31,28,31,30,31,30,31,31,30,31,30,31] leapMonthDays :: [Int] leapMonthDays = [31,29,31,30,31,30,31,31,30,31,30,31] mkPtrInt :: [Int] -> Ptr Int mkPtrInt = unsafePerformIO . newArray . concat . zipWith (flip replicate) [1..] mkPtrInt2 :: [Int] -> Ptr Int mkPtrInt2 = unsafePerformIO . newArray . concatMap (enumFromTo 1) normalMonth :: Ptr Int normalMonth = mkPtrInt normalMonthDays normalDayInMonth :: Ptr Int normalDayInMonth = mkPtrInt2 normalMonthDays leapMonth :: Ptr Int leapMonth = mkPtrInt leapMonthDays leapDayInMonth :: Ptr Int leapDayInMonth = mkPtrInt2 leapMonthDays ---------------------------------------------------------------- toHHMMSS :: Int -> (Int,Int,Int) toHHMMSS x = (hh,mm,ss) where (hhmm,ss) = x `quotRem` 60 (hh,mm) = hhmm `quotRem` 60 http-date-0.0.6.1/Network/HTTP/Date/Formatter.hs0000644000000000000000000000521412524017414017322 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Date.Formatter (formatHTTPDate) where import Data.ByteString.Char8 () import Data.ByteString.Internal import Data.Word import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable import Network.HTTP.Date.Types ---------------------------------------------------------------- -- | Generating HTTP Date in RFC1123 style. -- -- >>> formatHTTPDate defaultHTTPDate {hdYear = 1994, hdMonth = 11, hdDay = 15, hdHour = 8, hdMinute = 12, hdSecond = 31, hdWkday = 2} -- "Tue, 15 Nov 1994 08:12:31 GMT" formatHTTPDate :: HTTPDate -> ByteString formatHTTPDate hd = unsafeCreate 29 $ \ptr -> do cpy3 ptr weekDays (3 * w) poke (ptr `plusPtr` 3) comma poke (ptr `plusPtr` 4) spc int2 (ptr `plusPtr` 5) d poke (ptr `plusPtr` 7) spc cpy3 (ptr `plusPtr` 8) months (3 * m) poke (ptr `plusPtr` 11) spc int4 (ptr `plusPtr` 12) y poke (ptr `plusPtr` 16) spc int2 (ptr `plusPtr` 17) h poke (ptr `plusPtr` 19) colon int2 (ptr `plusPtr` 20) n poke (ptr `plusPtr` 22) colon int2 (ptr `plusPtr` 23) s poke (ptr `plusPtr` 25) spc poke (ptr `plusPtr` 26) (71 :: Word8) poke (ptr `plusPtr` 27) (77 :: Word8) poke (ptr `plusPtr` 28) (84 :: Word8) where y = hdYear hd m = hdMonth hd d = hdDay hd h = hdHour hd n = hdMinute hd s = hdSecond hd w = hdWkday hd cpy3 :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO () cpy3 ptr p o = withForeignPtr p $ \fp -> memcpy ptr (fp `plusPtr` o) 3 ---------------------------------------------------------------- int2 :: Ptr Word8 -> Int -> IO () int2 ptr n | n < 10 = do poke ptr zero poke (ptr `plusPtr` 1) (i2w8 n) | otherwise = do poke ptr (i2w8 (n `quot` 10)) poke (ptr `plusPtr` 1) (i2w8 (n `rem` 10)) int4 :: Ptr Word8 -> Int -> IO () int4 ptr n0 = do let (n1,x1) = n0 `quotRem` 10 (n2,x2) = n1 `quotRem` 10 (x4,x3) = n2 `quotRem` 10 poke ptr (i2w8 x4) poke (ptr `plusPtr` 1) (i2w8 x3) poke (ptr `plusPtr` 2) (i2w8 x2) poke (ptr `plusPtr` 3) (i2w8 x1) i2w8 :: Int -> Word8 i2w8 n = fromIntegral n + zero ---------------------------------------------------------------- months :: ForeignPtr Word8 months = let (PS p _ _) = "___JanFebMarAprMayJunJulAugSepOctNovDec" in p weekDays :: ForeignPtr Word8 weekDays = let (PS p _ _) = "___MonTueWedThuFriSatSun" in p ---------------------------------------------------------------- spc :: Word8 spc = 32 comma :: Word8 comma = 44 colon :: Word8 colon = 58 zero :: Word8 zero = 48 http-date-0.0.6.1/Network/HTTP/Date/Parser.hs0000644000000000000000000000466312524017414016622 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Network.HTTP.Date.Parser (parseHTTPDate) where import Control.Applicative import Control.Monad import Data.Attoparsec.ByteString import Data.Attoparsec.ByteString.Char8 import Data.ByteString import Data.Char import Network.HTTP.Date.Types ---------------------------------------------------------------- -- | -- Parsing HTTP Date. Currently only RFC1123 style is supported. -- -- >>> parseHTTPDate "Tue, 15 Nov 1994 08:12:31 GMT" -- Just (HTTPDate {hdYear = 1994, hdMonth = 11, hdDay = 15, hdHour = 8, hdMinute = 12, hdSecond = 31, hdWkday = 2}) parseHTTPDate :: ByteString -> Maybe HTTPDate parseHTTPDate bs = case parseOnly rfc1123Date bs of Right ut -> Just ut _ -> Nothing rfc1123Date :: Parser HTTPDate rfc1123Date = do w <- wkday void $ string ", " (y,m,d) <- date1 sp (h,n,s) <- time sp -- RFC 2616 defines GMT only but there are actually ill-formed ones such -- as "+0000" and "UTC" in the wild. void $ string "GMT" <|> string "+0000" <|> string "UTC" return $ defaultHTTPDate { hdYear = y , hdMonth = m , hdDay = d , hdHour = h , hdMinute = n , hdSecond = s , hdWkday = w } wkday :: Parser Int wkday = 1 <$ string "Mon" <|> 2 <$ string "Tue" <|> 3 <$ string "Wed" <|> 4 <$ string "Thu" <|> 5 <$ string "Fri" <|> 6 <$ string "Sat" <|> 7 <$ string "Sun" date1 :: Parser (Int,Int,Int) date1 = do d <- day sp m <- month sp y <- year return (y,m,d) where day = digit2 year = digit4 sp :: Parser () sp = () <$ char ' ' time :: Parser (Int,Int,Int) time = do h <- digit2 void $ char ':' m <- digit2 void $ char ':' s <- digit2 return (h,m,s) month :: Parser Int month = 1 <$ string "Jan" <|> 2 <$ string "Feb" <|> 3 <$ string "Mar" <|> 4 <$ string "Apr" <|> 5 <$ string "May" <|> 6 <$ string "Jun" <|> 7 <$ string "Jul" <|> 8 <$ string "Aug" <|> 9 <$ string "Sep" <|> 10 <$ string "Oct" <|> 11 <$ string "Nov" <|> 12 <$ string "Dec" digit2 :: Parser Int digit2 = do x1 <- toInt <$> digit x2 <- toInt <$> digit return $ x1 * 10 + x2 digit4 :: Parser Int digit4 = do x1 <- toInt <$> digit x2 <- toInt <$> digit x3 <- toInt <$> digit x4 <- toInt <$> digit return $ x1 * 1000 + x2 * 100 + x3 * 10 + x4 toInt :: Char -> Int toInt c = ord c - ord '0' http-date-0.0.6.1/Network/HTTP/Date/Types.hs0000644000000000000000000000115012524017414016456 0ustar0000000000000000module Network.HTTP.Date.Types ( HTTPDate , hdYear , hdMonth , hdDay , hdHour , hdMinute , hdSecond , hdWkday , defaultHTTPDate ) where {-| Data structure for HTTP Date. This value should be specified with 'defaultHTTPDate' and its field labels. -} data HTTPDate = HTTPDate { hdYear :: !Int , hdMonth :: !Int , hdDay :: !Int , hdHour :: !Int , hdMinute :: !Int , hdSecond :: !Int , hdWkday :: !Int } deriving (Eq, Show, Ord) {-| A default value for 'HTTPDate'. -} -- 1970/1/1 is Thu (4) defaultHTTPDate :: HTTPDate defaultHTTPDate = HTTPDate 1970 1 1 0 0 0 4 http-date-0.0.6.1/test/0000755000000000000000000000000012524017414012713 5ustar0000000000000000http-date-0.0.6.1/test/DateSpec.hs0000644000000000000000000000150712524017414014742 0ustar0000000000000000module DateSpec where import Control.Monad import Model import Network.HTTP.Date import Test.Hspec ---------------------------------------------------------------- spec :: Spec spec = do describe "formatHTTPDat" $ do it "behaves like the model" $ forM_ [0,100000..10000000000] $ \epochtime -> do let m = model epochtime o = ours epochtime model = utcToDate . epochTimeToUtcTime ours = formatHTTPDate . epochTimeToHTTPDate o `shouldBe` m describe "parseHTTPDate" $ do it "behaves like the model" $ forM_ [0,100000..10000000000] $ \epochtime -> do let m = epochTimeToHTTPDate epochtime Just o = parseHTTPDate $ formatHTTPDate m o `shouldBe` m http-date-0.0.6.1/test/doctests.hs0000644000000000000000000000016512524017414015101 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["-XOverloadedStrings", "Network/HTTP/Date.hs"] http-date-0.0.6.1/test/Model.hs0000644000000000000000000000072612524017414014314 0ustar0000000000000000{-# LANGUAGE CPP #-} module Model where import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS8 import Data.Time import Data.Time.Clock.POSIX import System.Posix.Types #if !MIN_VERSION_time(1,5,0) import System.Locale #endif epochTimeToUtcTime :: EpochTime -> UTCTime epochTimeToUtcTime = posixSecondsToUTCTime . realToFrac utcToDate :: UTCTime -> ByteString utcToDate = BS8.pack . formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S GMT" http-date-0.0.6.1/test/Spec.hs0000644000000000000000000000005412524017414014140 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}