metar-http 0.0.5 → 0.0.6
raw patch · 3 files changed
+158/−29 lines, 3 filesdep +bytestringdep ~metarPVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring
Dependency ranges changed: metar
API changes (from Hackage documentation)
Files
- changelog.md +20/−0
- metar-http.cabal +3/−2
- src/Data/Aviation/Metar/Http.hs +135/−27
changelog.md view
@@ -1,3 +1,23 @@+0.0.6++* Add BOM Graphical Area Forecast (GAF) endpoints+ * `/gaf/<area>/current` and `/gaf/<area>/next` return the PNG image for+ one of `WA-N`, `WA-S`, `NT`, `QLD-N`, `QLD-S`, `SA`, `NSW-W`, `NSW-E`,+ `VIC`, `TAS`+ * Area codes are parsed from `gaf.shtml`; product ids and the+ current/next rotation come from `gaf-pub.js` (UTC-hour driven)+* Add BOM Grid Point Wind & Temperature (GPWT) endpoint+ * `/gpwt/<level>/<area>/<time>` returns the PNG for the requested+ (level, area, time-slot) triple; `level` is `low`, `mid`, or `high`+ * Product list is parsed from the BOM grid-point-forecasts HTML page+ * Depends on `Data.Aviation.GPWT` from `metar-0.0.6`+* GAF fetching moved into the `metar` library (`Data.Aviation.GAF` in+ `metar-0.0.6`); this project now only handles HTTP routing+* Require `metar >= 0.0.6`; drop direct deps on `tagsoup`, `wreq`,+ `time`, `http-client` (now transitive through `metar`)+* Remove stale `-XNoImplicitPrelude` from `.ghci` so `cabal repl` loads+ the library cleanly+ 0.0.5 * Update to metar-0.0.5 library
metar-http.cabal view
@@ -1,5 +1,5 @@ name: metar-http-version: 0.0.5+version: 0.0.6 license: BSD3 license-file: LICENCE author: Tony Morris <ʇǝu˙sıɹɹoɯʇ@sıɹɹoɯʇ>@@ -24,9 +24,10 @@ build-depends: base >= 4.8 && < 5+ , bytestring >= 0.10 && < 0.13 , http-types >= 0.9 && < 1 , lens >= 4 && < 6- , metar >= 0.0.5 && < 1.0+ , metar >= 0.0.6 && < 1 , network-uri >= 2.6 && < 3 , text >= 1.2 && < 3 , semigroups >= 0.9 && < 1
src/Data/Aviation/Metar/Http.hs view
@@ -1,22 +1,38 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -Wall #-} --- | HTTP server exposing METAR observations. Australian aerodromes (ICAO codes--- beginning with @Y@) are fetched from BOM; other codes fall back to NOAA.+-- | HTTP server exposing METAR observations, BOM Graphical Area Forecast+-- (GAF) images, and BOM Grid Point Wind and Temperature (GPWT) images.+--+-- @/metar/\<icao\>@ returns a METAR observation as text: Australian aerodromes+-- (ICAO codes beginning with @Y@) are fetched from BOM; other codes fall back+-- to NOAA.+--+-- @/gaf/\<area\>/current@ and @/gaf/\<area\>/next@ return the corresponding+-- BOM GAF PNG image. Areas are @WA-N@, @WA-S@, @NT@, @QLD-N@, @QLD-S@, @SA@,+-- @NSW-W@, @NSW-E@, @VIC@, @TAS@.+--+-- @/gpwt/\<level\>/\<area\>/\<time\>@ returns the corresponding BOM GPWT PNG.+-- @level@ is @low@, @mid@ or @high@; @area@ is one of the codes advertised on+-- the grid-point-forecasts page (e.g. @AUS@, @NSW@, @QLD-N@, @VIC-TAS@,+-- @TIMS@); @time@ is a 3-hourly UTC slot like @00Z@, @03Z@ ... @21Z@. module Data.Aviation.Metar.Http ( metarHTTP, metarHTTPapp, ) where import Control.Lens (folded, (^.), (^?), _Wrapped)+import Data.Aviation.GAF (GAFError (GAFHttpError, GAFUnknownArea), GAFImage (GAFImage), GAFPeriod (GAFCurrent, GAFNext), getGAF, renderGAFError)+import Data.Aviation.GPWT (GPWTError (GPWTHttpError, GPWTNoSuchProduct, GPWTUnknownLevel), GPWTImage (GPWTImage), getGPWT, parseLevel, renderGPWTError) import Data.Aviation.Metar (getMETAR) import Data.Aviation.Metar.METARResult (_METARResultValue)+import qualified Data.ByteString.Char8 as BS import Data.ByteString.Lazy.UTF8 (fromString) import Data.List (intercalate)-import Data.Text (toLower, unpack)+import Data.Text (Text, toLower, unpack) import Network.HTTP.Types.Header (hContentType)-import Network.HTTP.Types.Status (status200, status404)-import Network.Wai (Application, pathInfo, responseLBS)+import Network.HTTP.Types.Status (status200, status404, status502)+import Network.Wai (Application, Response, pathInfo, responseLBS) import Network.Wai.Handler.Warp (defaultSettings, runSettings, setPort, setTimeout) import System.Environment (getArgs) @@ -192,7 +208,7 @@ Just l -> MaxLines l r' --- | WAI 'Application' serving METAR observations.+-- | WAI 'Application' serving METAR observations and BOM GAF images. metarHTTPapp :: Application metarHTTPapp req withResp =@@ -209,6 +225,12 @@ </> "metar for station <icao> all on one line truncated at <maxchars>" <//> "/metar/<icao>/*/<maxchars>/<appendstr>" </> "metar for station <icao> all on one line truncated at <maxchars> and if truncation occurs, append <appendstr>"+ <//> "/gaf/<area>/current"+ </> "current BOM Graphical Area Forecast (PNG) for <area> (WA-N, WA-S, NT, QLD-N, QLD-S, SA, NSW-W, NSW-E, VIC, TAS)"+ <//> "/gaf/<area>/next"+ </> "next BOM Graphical Area Forecast (PNG) for <area>"+ <//> "/gpwt/<level>/<area>/<time>"+ </> "BOM Grid Point Wind & Temperature forecast (PNG); <level> is low, mid or high; <area> e.g. AUS, NSW, QLD-N, VIC-TAS, TIMS; <time> is a 3-hourly UTC slot like 00Z, 03Z ... 21Z" <//> "" _404 = responseLBS@@ -216,35 +238,37 @@ [] msg in case pathInfo req of- (rpt : xxxx : r) ->- let xxxx' =- unpack xxxx- modifyOutput ::- [String] ->- String- modifyOutput =- format (uriPathFormat (unpack <$> r))- mt =- case toLower rpt of- "metar" ->- Just ("METAR", getMETAR xxxx')- "taf" ->- Nothing- _ ->- Nothing- in case mt of+ ["gaf", area, periodTxt]+ | Just period <- gafPeriod (toLower periodTxt) ->+ do+ r <- getGAF (unpack area) period+ withResp (gafResponse r)+ ["gpwt", levelTxt, area, timeTxt] ->+ let levelStr = unpack (toLower levelTxt)+ in case parseLevel levelStr of Nothing ->- withResp _404- Just (mtt, mtf) ->+ withResp $+ responseLBS+ status404+ [(hContentType, "text/plain")]+ (fromString (renderGPWTError (GPWTUnknownLevel levelStr)))+ Just lv -> do- t <- mtf ^. _Wrapped+ r <- getGPWT lv (unpack area) (unpack timeTxt)+ withResp (gpwtResponse r)+ (rpt : xxxx : r)+ | toLower rpt == "metar" ->+ let xxxx' = unpack xxxx+ modifyOutput = format (uriPathFormat (unpack <$> r))+ in do+ t <- getMETAR xxxx' ^. _Wrapped withResp $ case t ^? _METARResultValue of Nothing -> responseLBS status404 []- ("no " <> mtt <> " found for " <> fromString xxxx')+ ("no METAR found for " <> fromString xxxx') Just x -> responseLBS status200@@ -258,6 +282,90 @@ msg _ -> withResp _404++-- | Parse the trailing path segment of a @/gaf/<area>/...@ request into a+-- 'GAFPeriod'.+--+-- >>> gafPeriod "current"+-- Just GAFCurrent+--+-- >>> gafPeriod "next"+-- Just GAFNext+--+-- >>> gafPeriod "other"+-- Nothing+gafPeriod ::+ Text ->+ Maybe GAFPeriod+gafPeriod t =+ case t of+ "current" -> Just GAFCurrent+ "next" -> Just GAFNext+ _ -> Nothing++-- | Turn a GAF fetch outcome into a WAI response. Successful fetches serve+-- the raw image bytes with the BOM-declared content type; errors map to+-- @404@ (unknown area) or @502@ (upstream failure) with a plain-text body.+gafResponse ::+ Either GAFError GAFImage ->+ Response+gafResponse r =+ case r of+ Right (GAFImage ct bs) ->+ responseLBS+ status200+ [(hContentType, BS.pack ct)]+ bs+ Left err@(GAFUnknownArea _ _) ->+ responseLBS+ status404+ [(hContentType, "text/plain")]+ (fromString (renderGAFError err))+ Left err@(GAFHttpError _ _) ->+ responseLBS+ status502+ [(hContentType, "text/plain")]+ (fromString (renderGAFError err))+ Left err ->+ responseLBS+ status502+ [(hContentType, "text/plain")]+ (fromString (renderGAFError err))++-- | Turn a GPWT fetch outcome into a WAI response. Successful fetches serve+-- the raw image bytes with the BOM-declared content type; errors map to+-- @404@ (unknown level, or no product for the requested area/time) or @502@+-- (upstream failure) with a plain-text body.+gpwtResponse ::+ Either GPWTError GPWTImage ->+ Response+gpwtResponse r =+ case r of+ Right (GPWTImage ct bs) ->+ responseLBS+ status200+ [(hContentType, BS.pack ct)]+ bs+ Left err@(GPWTUnknownLevel _) ->+ responseLBS+ status404+ [(hContentType, "text/plain")]+ (fromString (renderGPWTError err))+ Left err@(GPWTNoSuchProduct{}) ->+ responseLBS+ status404+ [(hContentType, "text/plain")]+ (fromString (renderGPWTError err))+ Left err@(GPWTHttpError _ _) ->+ responseLBS+ status502+ [(hContentType, "text/plain")]+ (fromString (renderGPWTError err))+ Left err ->+ responseLBS+ status502+ [(hContentType, "text/plain")]+ (fromString (renderGPWTError err)) -- | Run 'metarHTTPapp' with Warp, optionally taking a port from the first -- command-line argument.