diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/Config.hs | 14 | ||||
| -rw-r--r-- | lib/GTFS.hs | 14 | ||||
| -rw-r--r-- | lib/Server.hs | 4 | ||||
| -rw-r--r-- | lib/Server/Util.hs | 20 |
4 files changed, 36 insertions, 16 deletions
diff --git a/lib/Config.hs b/lib/Config.hs index 4aa62fc..ef90fc1 100644 --- a/lib/Config.hs +++ b/lib/Config.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} module Config (UffdConfig(..), ServerConfig(..), LoggingConfig(..)) where @@ -9,6 +10,7 @@ import Data.Functor ((<&>)) import Data.Text (Text) import GHC.Generics (Generic) import Network.Wai.Handler.Warp (Settings) +import System.OsPath (OsPath, osp) import URI.ByteString data UffdConfig = UffdConfig @@ -21,9 +23,9 @@ data UffdConfig = UffdConfig data ServerConfig = ServerConfig { serverConfigWarp :: Settings , serverConfigDbString :: ByteString - , serverConfigGtfs :: FilePath - , serverConfigAssets :: FilePath - , serverConfigZoneinfoPath :: FilePath + , serverConfigGtfs :: OsPath + , serverConfigAssets :: OsPath + , serverConfigZoneinfoPath :: OsPath , serverConfigDebugMode :: Bool , serverConfigLogin :: UffdConfig , serverConfigLogging :: LoggingConfig @@ -41,9 +43,9 @@ instance DefaultConfig ServerConfig where configDef = ServerConfig { serverConfigWarp = configDef , serverConfigDbString = "" - , serverConfigGtfs = "./gtfs.zip" - , serverConfigAssets = "./assets" - , serverConfigZoneinfoPath = "/etc/zoneinfo/" + , serverConfigGtfs = [osp|./gtfs.zip|] + , serverConfigAssets = [osp|./assets|] + , serverConfigZoneinfoPath = [osp|/etc/zoneinfo/|] , serverConfigDebugMode = False , serverConfigLogin = configDef , serverConfigLogging = configDef diff --git a/lib/GTFS.hs b/lib/GTFS.hs index cb9be2a..4f3a311 100644 --- a/lib/GTFS.hs +++ b/lib/GTFS.hs @@ -65,6 +65,8 @@ import Data.Time.LocalTime.TimeZone.Olson (getTimeZoneSeriesFromOlson import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries, timeZoneFromSeries) import GHC.Float (int2Double) +import System.OsPath (OsPath, decodeUtf, + encodeUtf, (</>)) -- | for some reason this doesn't exist already in cassava @@ -499,9 +501,9 @@ data GTFS = GTFS } -loadRawGtfs :: FilePath -> IO RawGTFS +loadRawGtfs :: OsPath -> IO RawGTFS loadRawGtfs path = do - bytes <- LB.readFile path + bytes <- decodeUtf path >>= LB.readFile let zip = Zip.toArchive bytes RawGTFS <$> decodeTable' "stops.txt" zip @@ -531,7 +533,7 @@ loadRawGtfs path = do -- -- Note that this additionally needs a path to the machine's timezone info -- (usually /etc/zoneinfo or /usr/shared/zoneinfo) -loadGtfs :: FilePath -> FilePath -> IO GTFS +loadGtfs :: OsPath -> OsPath -> IO GTFS loadGtfs path zoneinforoot = do shallow@RawGTFS{..} <- loadRawGtfs path -- TODO: sort these according to sequence numbers @@ -541,7 +543,11 @@ loadGtfs path zoneinforoot = do (fromMaybe mempty rawShapePoints) -- all agencies must have the same timezone, so just take the first's let tzname = agencyTimezone $ V.head rawAgencies - tzseries <- getTimeZoneSeriesFromOlsonFile (zoneinforoot<>T.unpack tzname) + + tzsuffix <- encodeUtf (T.unpack tzname) + tzseries <- decodeUtf (zoneinforoot </> tzsuffix) + >>= getTimeZoneSeriesFromOlsonFile + let agencies' = fmap (\a -> a { agencyTimezone = tzseries }) rawAgencies routes' <- V.mapM (pushRoute agencies') rawRoutes <&> mapFromVector routeId diff --git a/lib/Server.hs b/lib/Server.hs index 15027b3..3fc2c5a 100644 --- a/lib/Server.hs +++ b/lib/Server.hs @@ -36,7 +36,6 @@ import Prometheus (Info (Info), exportMetricsAsText, gauge, register) import Prometheus.Metric.GHC (ghcMetrics) import Servant (Application, err401, serve, - serveDirectoryFileServer, throwError) import Servant.API ((:<|>) (..)) import Servant.Server (hoistServer) @@ -47,7 +46,8 @@ import Server.GTFS_RT (gtfsRealtimeServer) import Server.Ingest (handleTrackerRegister, handleTrainPing, handleWS) import Server.Subscribe (handleSubscribe) -import Server.Util (Service, runLogging, runService) +import Server.Util (Service, runLogging, runService, + serveDirectoryFileServer) import System.IO.Unsafe (unsafePerformIO) import Yesod (toWaiAppPlain) diff --git a/lib/Server/Util.hs b/lib/Server/Util.hs index 290b9c5..b519a86 100644 --- a/lib/Server/Util.hs +++ b/lib/Server/Util.hs @@ -1,7 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE RecordWildCards #-} -- | mostly the monad the service runs in -module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds, runLogging, getTzseries) where +module Server.Util (Service, ServiceM, runService, sendErrorMsg, secondsNow, utcToSeconds, runLogging, getTzseries, serveDirectoryFileServer) where import Config (LoggingConfig (..), ServerConfig (..)) @@ -27,14 +27,18 @@ import Data.Time (Day, UTCTime (..), import Data.Time.LocalTime.TimeZone.Olson (getTimeZoneSeriesFromOlsonFile) import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries) import Fmt ((+|), (|+)) +import GHC.IO (unsafePerformIO) import GHC.IO.Exception (IOException (IOError)) import GTFS (Seconds (..)) import Prometheus (MonadMonitor (doIO)) +import qualified Servant import Servant (Handler, ServerError, ServerT, err404, errBody, errHeaders, throwError) -import System.FilePath ((</>)) import System.IO (stderr) +import System.OsPath (OsPath, decodeFS, + decodeUtf, encodeUtf, + (</>)) import System.Process.Extra (callProcess) type ServiceM = LoggingT (ReaderT LoggingConfig Handler) @@ -87,5 +91,13 @@ utcToSeconds time day = Seconds $ round $ nominalDiffTimeToSeconds $ diffUTCTime time (UTCTime day 0) getTzseries :: ServerConfig -> Text -> IO TimeZoneSeries -getTzseries settings tzname = getTimeZoneSeriesFromOlsonFile - (serverConfigZoneinfoPath settings </> T.unpack tzname) +getTzseries settings tzname = do + suffix <- encodeUtf (T.unpack tzname) + -- TODO: submit a patch to timezone-olson making it accept OsPath + legacyPath <- decodeFS (serverConfigZoneinfoPath settings </> suffix) + getTimeZoneSeriesFromOlsonFile legacyPath + +-- TODO: patch servant / wai to use OsPath? +serveDirectoryFileServer :: OsPath -> ServerT Servant.Raw m +serveDirectoryFileServer = + Servant.serveDirectoryFileServer . unsafePerformIO . decodeUtf |