LeapData.hs

{-# 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!"