{-# 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 -- | A support type for deperating out the protocol over which to retrieve data. data SourceType = File | HTTPS deriving (Show, Read, Eq, Bounded, Enum, Ord) -- | A leap second list location tagged with a protocol for retrieving it. data LeapSource = LeapSource { sourceType :: SourceType , source :: String } deriving (Show, Read, Eq, Ord) -- | Convert a string source to a LeapSource 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 -- | LeapSources is a list of strings, specifying URIs the program can -- potentially access up-to-date leap-second.lists from. -- Each source begins with a protocol: -- For local sources "file://" followed by a path to the local file. -- For remote source sources "https://" prefixed URIs. type LeapSources = [LeapSource] -- | A few places we should be able to download up-to-date leap-seconds.list data. 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" ] -- | Given a LeapSource, perform the actual aquasition and parsing 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) -- | Parse a leap second list file, failing if it is expired. parseFileMaybe :: Day -> String -> Maybe LeapSecondList parseFileMaybe curDay str = -- We get the day to know if the file is valid, but its not entire clear how to compare \ -- our UTC day to the day specified in the file. case parseLeapSecondList str of Left _ -> Nothing Right lsl | curDay >= expirationDate lsl -> Nothing | otherwise -> Just lsl -- | Aquire leap-seconds files and parse them, -- Trying the provided list of sources in order from local, to secure remote (HTTPS), -- until an up-to-date source is aquired or all options are exausted. -- -- Currently only local and HTTPS has been implimented. 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!"