@@ -1,63 +1,43 @@
1+{-# OPTIONS_HADDOCK hide #-}
12-----------------------------------------------------------------------------
23-- |
34-- Module : Data.Time.LocalTime.TimeZone.Olson.Render
4−-- Copyright : Yitzchak Gale 2010
5+-- Copyright : Yitzchak Gale 2018
56--
67-- Maintainer : Yitzchak Gale <gale@sefer.org>
78-- Portability : portable
89--
9−-- Render Olson timezone data in the standard binary format as
10−-- used in Olson timezone files, and as specified by the
11−-- tzfile(5) man page on Unix-like systems. For more information
12−-- about this format, see http://www.twinsun.com/tz/tz-link.htm.
13−
14−{-
15−Copyright (c) 2010 Yitzchak Gale. All rights reserved.
16−
17−Redistribution and use in source and binary forms, with or without
18−modification, are permitted provided that the following conditions are
19−met:
20−
21− * Redistributions of source code must retain the above copyright
22− notice, this list of conditions and the following disclaimer.
23−
24− * Redistributions in binary form must reproduce the above
25− copyright notice, this list of conditions and the following
26− disclaimer in the documentation and/or other materials provided
27− with the distribution.
28−
29− * Neither the name of Yitzchak Gale nor the names of other
30− contributors may be used to endorse or promote products derived
31− from this software without specific prior written permission.
32−
33−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
34−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
35−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
36−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
37−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
38−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
39−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
40−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
41−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
42−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
43−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
44−----------------------------------------------------------------------------}
10+-- Render Olson timezone data in the standard binary format as used in
11+-- Olson timezone files, and as specified by the tzfile(5) man page on
12+-- Unix-like systems. For more information about this format, see
13+-- <http://www.twinsun.com/tz/tz-link.htm>.
14+
15+{- Copyright (c) 2018ZZ Yitzchak Gale. All rights reserved.
16+For licensing information, see the BSD3-style license in the file
17+LICENSE that was originally distributed by the author together with
18+this file. -}
4519
4620module Data.Time.LocalTime.TimeZone.Olson.Render
4721(
48− -- * Rendering Olson timezone data
22+ -- * Rendering Olson timezone files
4923 -- | If any of the transition times or leap second times specified
5024 -- require more than a 32-bit integer to represent as a Unix
5125 -- timestamp, or if a POSIX-style TZ string is specified, timezone
5226 -- data is rendered using Version 2 format. Otherwise, the timezone data
5327 -- is rendered using Version 1 format.
28+ renderTimeZoneSeriesToOlsonFile,
29+ timeZoneSeriesToOlson,
5430 renderOlsonToFile,
31+ verifyOlsonLimits,
5532 putOlson,
56− splitOlson
33+ extractOlsonV1
5734)
5835where
5936
6037import Data.Time.LocalTime.TimeZone.Olson.Types
38+import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries(TimeZoneSeries))
39+import Data.Time (TimeZone(TimeZone, timeZoneSummerOnly, timeZoneName))
40+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
6141import Data.Binary.Put (Put, runPut, putByteString, putWord8, flush,
6242 putWord32be, putWord64be)
6343import qualified Data.ByteString as B
@@ -65,78 +45,117 @@ import qualified Data.ByteString.Lazy as L
6545import Data.List (partition, sortBy, sort, group)
6646import Data.Ord (comparing)
6747import Data.Word (Word8)
68−import Data.Maybe (listToMaybe, maybeToList, isNothing, fromMaybe)
48+import Data.Maybe (listToMaybe, maybeToList, isNothing, fromMaybe, catMaybes)
6949import Data.Monoid (mempty)
70−import Control.Monad (guard, replicateM_)
50+import Control.Monad (guard, replicateM_, unless)
7151
52+-- | Render a @TimeZoneSeries@ as a binary Olson timezone file.
53+--
54+-- If the values in the Olson timezone data exceed the standard size
55+-- limits (see 'defaultLimits'), this function throws an
56+-- exception. For other behavior, use 'timeZoneSeriesToOlson',
57+-- 'verifyOlsonLimits', 'putOlson' and 'Data.Binary.Put.runPut'
58+-- directly.
59+renderTimeZoneSeriesToOlsonFile :: FilePath -> TimeZoneSeries -> IO ()
60+renderTimeZoneSeriesToOlsonFile fp = renderOlsonToFile fp .
61+ fromMaybe (error "Cannot render TimeZoneSeries: default is summer time") .
62+ timeZoneSeriesToOlson
63+
64+-- | Convert a @TimeZoneSeries@ to @OlsonData@ for rendering.
65+timeZoneSeriesToOlson :: TimeZoneSeries -> Maybe OlsonData
66+timeZoneSeriesToOlson (TimeZoneSeries dflt pairs)
67+ | timeZoneSummerOnly dflt && not (all timeZoneSummerOnly $ map snd pairs)
68+ = Nothing
69+ | otherwise = Just $
70+ OlsonData
71+ [Transition secs ttinfo |
72+ (t, tz) <- reverse pairs,
73+ let secs = round $ utcTimeToPOSIXSeconds t,
74+ ttinfo <- maybeToList $ lookup (mkTT tz) ttAssocs]
75+ ttinfos
76+ []
77+ Nothing
78+ where
79+ mkTT (TimeZone offset isdst abbr) =
80+ TtInfo (offset*60) isdst Wall abbr
81+ dfltTT = mkTT dflt
82+ ttAssocs = (dfltTT, 0) :
83+ zip (uniq . sort . filter (/= dfltTT) $ map (mkTT . snd) pairs) [1..]
84+ ttinfos = map fst ttAssocs
85+
86+-- | Check whether @OlsonData@ is within size limits.
87+verifyOlsonLimits :: SizeLimits -> OlsonData -> Bool
88+verifyOlsonLimits limits (OlsonData transs ttinfos leaps _) =
89+ withinLimit maxTimes transs &&
90+ withinLimit maxTypes ttinfos &&
91+ withinLimit maxLeaps leaps &&
92+ withinLimit maxAbbrChars abbrChars
93+ where
94+ withinLimit limit items = maybe True (null . flip drop items) $
95+ limit limits
96+ abbrChars = concat abbrStrs ++ map (const '\NUL') abbrStrs
97+ abbrStrs = map tt_abbr ttinfos
7298
7399-- | Render Olson timezone data as a binary Olson timezone file
100+--
101+-- If the values in the Olson timezone data exceed the standard size
102+-- limits (see 'defaultLimits'), this function throws an
103+-- exception. For other behavior, use 'verifyOlsonLimits', 'putOlson'
104+-- and 'Data.Binary.Put.runPut' directly.
74105renderOlsonToFile :: FilePath -> OlsonData -> IO ()
75−renderOlsonToFile fp = L.writeFile fp . runPut . putOlson
106+renderOlsonToFile fp olson = do
107+ unless (verifyOlsonLimits defaultLimits olson) $
108+ error "Olson timezone data exceeds size limits"
109+ L.writeFile fp . runPut . putOlson $ olson
76110
77111-- | Render Olson timezone data in binary Olson timezone file format
78112-- as a lazy @ByteString@
79−putOlson :: OlsonData -> Put
80−putOlson olson = do
81− putASCII "TZif"
82− putWord8 version
83− putByteString . B.pack $ replicate 15 0 -- padding nulls
84− putOlsonParts version olson1 olson2 posix
85− flush
113+putOlson olson@(OlsonData _ _ _ posix)
114+ | fitsInVersion1 = putOlsonPart 0 put32bitIntegral olson
115+ | otherwise = do putOlsonPart 50 put32bitIntegral olson1
116+ putOlsonPart 50 put64bitIntegral olson
117+ putPosixTZ posix
86118 where
87− (olson1, olson2, posix) = splitOlson olson
88− version
89− | olson2 /= mempty = 50
90− | otherwise = maybe 0 (const 50) $ posix >>= guard . not . null
91−
92−-- | Split Olson timezone data into three parts: timezone data that can
93−-- be rendered using Version 1 format, timezone data that can only be
94−-- rendered using Version 2 format, and the POSIX-style TZ string
95−-- if specified
96−splitOlson :: OlsonData -> (OlsonData, OlsonData, Maybe String)
97−splitOlson (OlsonData transs ttinfos leaps posix) =
98− (OlsonData transs1 ttinfos1 leaps1 Nothing,
99− OlsonData transs2 ttinfos2 leaps2 Nothing,
100− posix)
119+ olson1 = extractOlsonV1 olson
120+ fitsInVersion1 = fmap null posix /= Just False &&
121+ olson1 == olson {olsonPosixTZ = Nothing}
122+
123+-- | Extract Olson timezone data that can be rendered using Version 1 format
124+extractOlsonV1 :: OlsonData -> OlsonData
125+extractOlsonV1 (OlsonData transs ttinfos leaps _)
126+ | allV1 = OlsonData transs ttinfos leaps Nothing
127+ | otherwise = OlsonData transs1 ttinfos1 leaps1 Nothing
101128 where
102129 cutoff = 0x80000000 -- 2^31
103− ( leaps1 , leaps2 ) = partition ((>= cutoff) . leapTime) leaps
104− (transs1', transs2') = partition ((>= cutoff) . transTime) transs
105− assoc1 = mkAssoc [0] transs1'
106− assoc2 = mkAssoc [] transs2'
107− transs1 = mkTranss transs1' assoc1
108− transs2 = mkTranss transs2' assoc2
109− ttinfos1 = mkTtinfos assoc1
110− ttinfos2 = mkTtinfos assoc2
111− mkAssoc prepend transs' = zip
130+ fitsIn32bits x = x < cutoff && x >= negate cutoff
131+ leaps1 = filter (fitsIn32bits . leapTime) leaps
132+ transs1' = filter (fitsIn32bits . transTime) transs
133+ allV1 = length leaps1 == length leaps && length transs1' == length transs
134+ assoc1 = zip
112135 (sortBy (comparing $ fmap tt_ttype . listToMaybe . flip drop ttinfos) .
113− uniq . sort . (prepend ++) $ map transIndex transs')
136+ uniq . sort . (0 :) $ map transIndex transs1')
114137 [0..]
115− mkTranss transs' assoc = [t {transIndex = i} |
116− t <- transs', i <- maybeToList $ lookup (transIndex t) assoc]
117− mkTtinfos assoc = map snd . dropWhile (isNothing . fst) .
118− sortBy (comparing fst) $ zip (map (flip lookup assoc) [0..]) ttinfos
119−
120−putOlsonParts :: Word8 -> OlsonData -> OlsonData -> Maybe String -> Put
121−putOlsonParts 0 olson1 _ _ = putOlsonPart put32bitIntegral olson1
122−putOlsonParts _ olson1 olson2 posix = do
123− putOlsonPart put32bitIntegral olson1
124− putOlsonPart put64bitIntegral olson2
125− putPosixTZ posix
126−
127−putOlsonPart :: (Integer -> Put) -> OlsonData -> Put
128−putOlsonPart putTime (OlsonData transs ttinfos leaps _) = do
138+ transs1 = [t {transIndex = i} |
139+ t <- transs1', i <- maybeToList $ lookup (transIndex t) assoc1]
140+ ttinfos1 = map snd . dropWhile (isNothing . fst) .
141+ sortBy (comparing fst) $ zip (map (flip lookup assoc1) [0..]) ttinfos
142+
143+putOlsonPart :: Word8 -> (Integer -> Put) -> OlsonData -> Put
144+putOlsonPart version putTime (OlsonData transs ttinfos leaps _) = do
145+ putASCII "magic number" "TZif"
146+ putWord8 version
147+ putByteString . B.pack $ replicate 15 0 -- padding nulls
129148 replicateM_ 2 $ putCount ttinfosWithTtype
130− -- tzh_ttisgmtcnt
131− -- tzh_ttisstdcnt
132− putCount leaps -- tzh_leapcnt
133− putCount transs -- tzh_timecnt
134− putCount ttinfos -- tzh_typecnt
135− putCount abbrChars -- tzh_charcnt
149+ -- tzh_ttisgmtcnt
150+ -- tzh_ttisstdcnt
151+ putCount leaps -- tzh_leapcnt
152+ putCount transs -- tzh_timecnt
153+ putCount ttinfos -- tzh_typecnt
154+ put32bitIntegral abbrChars -- tzh_charcnt
136155 mapM_ (putTime . transTime ) transs
137156 mapM_ (put8bitIntegral . transIndex) transs
138157 mapM_ putTtInfo ttinfosIndexed
139− putASCII abbrChars
158+ mapM_ putAbbr abbrStrings
140159 mapM_ (putLeapInfo putTime) leaps
141160 mapM_ (putBool . (== Std) . tt_ttype) ttinfosWithTtype -- isstd
142161 mapM_ (putBool . (== UTC) . tt_ttype) ttinfosWithTtype -- isgmt
@@ -144,16 +163,18 @@ putOlsonPart putTime (OlsonData transs ttinfos leaps _) = do
144163 putCount = put32bitIntegral . length
145164 ttinfosWithTtype = takeWhile ((<= UTC) . tt_ttype) ttinfosIndexed
146165 abbrStrings = uniq . sort $ map tt_abbr ttinfos
147− abbrChars = concatMap (++ "\NUL") abbrStrings
166+ abbrChars = sum (map length abbrStrings) + length abbrStrings
167+ putAbbr abbr = putASCII "time zone abbreviation" abbr >> putWord8 0
168+ abbrAssocs = zip abbrStrings . scanl (+) 0 $
169+ map ((+ 1) . length) abbrStrings
148170 ttinfosIndexed = [TtInfo gmtoff isdst ttype i |
149171 TtInfo gmtoff isdst ttype abbr <- ttinfos,
150− i <- maybeToList . lookup abbr . zip abbrStrings .
151− scanl (+) 0 $ map ((+ 1) . length) abbrStrings]
172+ i <- maybeToList $ lookup abbr abbrAssocs]
152173
153174putPosixTZ :: Maybe String -> Put
154175putPosixTZ posix = do
155176 putWord8 10
156− putASCII $ fromMaybe "" posix
177+ putASCII "POSIX TZ string"$ fromMaybe "" posix
157178 putWord8 10
158179
159180putTtInfo :: TtInfo Int -> Put
@@ -186,5 +207,11 @@ putBool True = putWord8 1
186207uniq :: Eq a => [a] -> [a]
187208uniq = map head . group
188209
189−putASCII :: String -> Put
190−putASCII = putByteString . B.pack . map (fromIntegral . fromEnum)
210+putASCII :: String -> String -> Put
211+putASCII what =
212+ putByteString . B.pack . map (fromIntegral . verify . fromEnum)
213+ where
214+ verify c
215+ | c >= 32 && c <= 126 = c
216+ | otherwise = error $ "Cannot render TimeZoneSeries: " ++
217+ what ++ " contains non-ASCII characters"