http-date-0.0.8/0000755000000000000000000000000013326244111011574 5ustar0000000000000000http-date-0.0.8/Setup.hs0000644000000000000000000000005613326244111013231 0ustar0000000000000000import Distribution.Simple main = defaultMain http-date-0.0.8/LICENSE0000644000000000000000000000276513326244111012613 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.8/http-date.cabal0000644000000000000000000000314513326244111014455 0ustar0000000000000000Name: http-date Version: 0.0.8 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 , time 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.8/test/0000755000000000000000000000000013326244111012553 5ustar0000000000000000http-date-0.0.8/test/DateSpec.hs0000644000000000000000000000260613326244111014603 0ustar0000000000000000module DateSpec where import Control.Monad import Model import Network.HTTP.Date import Test.Hspec ---------------------------------------------------------------- spec :: Spec spec = do describe "formatHTTPDate" $ 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 "httpDateToUTC" $ do it "behaves like the model" $ forM_ [0,100000..10000000000] $ \epochtime -> do let m = epochTimeToUtcTime epochtime o = httpDateToUTC $ epochTimeToHTTPDate epochtime 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 describe "utcToHTTPDate" $ do it "behaves like the model" $ forM_ [0,100000..10000000000] $ \epochtime -> do let m = epochTimeToHTTPDate epochtime o = utcToHTTPDate $ epochTimeToUtcTime epochtime o `shouldBe` m http-date-0.0.8/test/Model.hs0000644000000000000000000000072613326244111014154 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.8/test/doctests.hs0000644000000000000000000000016513326244111014741 0ustar0000000000000000module Main where import Test.DocTest main :: IO () main = doctest ["-XOverloadedStrings", "Network/HTTP/Date.hs"] http-date-0.0.8/test/Spec.hs0000644000000000000000000000005413326244111014000 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} http-date-0.0.8/Network/0000755000000000000000000000000013326244111013225 5ustar0000000000000000http-date-0.0.8/Network/HTTP/0000755000000000000000000000000013326244111014004 5ustar0000000000000000http-date-0.0.8/Network/HTTP/Date.hs0000644000000000000000000000054513326244111015221 0ustar0000000000000000{-| Fast parser and formatter for HTTP Date. -} module Network.HTTP.Date ( module Network.HTTP.Date.Converter , module Network.HTTP.Date.Types -- * Utility functions , parseHTTPDate , formatHTTPDate ) 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.8/Network/HTTP/Date/0000755000000000000000000000000013326244111014661 5ustar0000000000000000http-date-0.0.8/Network/HTTP/Date/Parser.hs0000644000000000000000000000466313326244111016462 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.8/Network/HTTP/Date/Formatter.hs0000644000000000000000000000521413326244111017162 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.8/Network/HTTP/Date/Types.hs0000644000000000000000000000115013326244111016316 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.8/Network/HTTP/Date/Converter.hs0000644000000000000000000000741513326244111017173 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} module Network.HTTP.Date.Converter ( epochTimeToHTTPDate , httpDateToUTC , utcToHTTPDate ) where import Control.Applicative import Data.ByteString.Internal import Data.Time import Data.Time.Calendar.WeekDate 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 -- | Translating 'HTTPDate' to 'UTCTime'. -- -- Since 0.0.7. httpDateToUTC :: HTTPDate -> UTCTime httpDateToUTC x = UTCTime (fromGregorian y m d) (secondsToDiffTime s) where y = fromIntegral $ hdYear x m = hdMonth x d = hdDay x s = fromIntegral $ (hdHour x `rem` 24) * 3600 + (hdMinute x `rem` 60) * 60 + (hdSecond x `rem` 60) -- | Translating 'UTCTime' to 'HTTPDate'. -- -- Since 0.0.7. utcToHTTPDate :: UTCTime -> HTTPDate utcToHTTPDate x = defaultHTTPDate { hdYear = fromIntegral y , hdMonth = m , hdDay = d , hdHour = h , hdMinute = n , hdSecond = truncate s , hdWkday = fromEnum (w :: Int) } where (y, m, d) = toGregorian day (h, n, s) = ((todHour tod), (todMin tod), (todSec tod)) (_, _, w) = toWeekDate day day = localDay time tod = localTimeOfDay time time = utcToLocalTime utc x 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