{-# LANGUAGE ScopedTypeVariables #-}
module Data.Time.Clock.TAI.LeapData (
SourceType(..), LeapSource(..), LeapSources
, parseLeapSource, mayRetrieveList, parseFileMaybe
, leapSources
, sourceLeapData
) where
import qualified Control.Exception as E
import Control.Lens
import Data.List (stripPrefix, sort)
import Data.Maybe
import Data.Text.Lazy.Lens
import Data.Time
import Data.Time.Clock.TAI.Parser
import qualified Network.Wreq as Wreq
data SourceType = File | HTTPS
deriving (Show, Read, Eq, Bounded, Enum, Ord)
data LeapSource
= LeapSource
{ sourceType :: SourceType
, source :: String
}
deriving (Show, Read, Eq, Ord)
parseLeapSource :: String -> Maybe LeapSource
parseLeapSource s' | Just s <- stripPrefix "file://" s' = Just $ LeapSource File s
parseLeapSource s | Just _ <- stripPrefix "https://" s = Just $ LeapSource HTTPS s
parseLeapSource _ = Nothing
type LeapSources = [LeapSource]
leapSources :: LeapSources
leapSources = sort . mapMaybe parseLeapSource $
[ "file:///usr/share/zoneinfo/leap-seconds.list"
, "https://hpiers.obspm.fr/iers/bul/bulc/ntp/leap-seconds.list"
, "https://www.ietf.org/timezones/data/leap-seconds.list"
, "https://www.meinberg.de/download/ntp/leap-seconds.list"
]
mayRetrieveList :: LeapSource -> IO (Maybe LeapSecondList)
mayRetrieveList (LeapSource ty s) = E.handle (\(_::E.SomeException) -> return Nothing) $ do
curDay <- utctDay <$> getCurrentTime
case ty of
File -> parseFileMaybe curDay <$> readFile s
HTTPS -> do
r <- Wreq.get s
return . parseFileMaybe curDay $ (r ^. Wreq.responseBody.utf8.unpacked)
parseFileMaybe :: Day -> String -> Maybe LeapSecondList
parseFileMaybe curDay str =
case parseLeapSecondList str of
Left _ -> Nothing
Right lsl | curDay >= expirationDate lsl -> Nothing
| otherwise -> Just lsl
sourceLeapData :: LeapSources -> IO LeapSecondList
sourceLeapData = do
firstOption . map mayRetrieveList . sort
where
firstOption :: Monad m => [m (Maybe a)] -> m a
firstOption (io:t) = maybe (firstOption t) return =<< io
firstOption [] = error "No option for leap-seconds.list serviced our needs!"