wip: start manually decoding only wanted fish health fields

Also do some refactoring, and start on moving barentswatch api behind
auth.

The manual fish health data decoding needs some work, and needs a
mapping of what is interesting.

The selection is also kinda wonky right now. The selection and
deselection might not be what we want.

docs/fiskeridir-locality-borders-example-payload.json

@@ -0,0 +1,79 @@
+{
+    "id": 6551,
+    "siteVersionId": 2274,
+    "siteNr": 12298,
+    "name": "RØYSA",
+    "type": {
+        "value": "UNSPECIFIED"
+    },
+    "points": [
+        {
+            "id": 13885,
+            "index": 0,
+            "latitude": 62.549783,
+            "longitude": 6.1385
+        },
+        {
+            "id": 13886,
+            "index": 1,
+            "latitude": 62.55055,
+            "longitude": 6.141133
+        },
+        {
+            "id": 13887,
+            "index": 2,
+            "latitude": 62.547467,
+            "longitude": 6.145183
+        },
+        {
+            "id": 13888,
+            "index": 3,
+            "latitude": 62.546717,
+            "longitude": 6.142533
+        },
+        {
+            "id": 13889,
+            "index": 4,
+            "latitude": 62.549783,
+            "longitude": 6.1385
+        },
+        {
+            "id": 13890,
+            "index": 5,
+            "latitude": 62.54805,
+            "longitude": 6.1391
+        },
+        {
+            "id": 13891,
+            "index": 6,
+            "latitude": 62.5481,
+            "longitude": 6.139267
+        },
+        {
+            "id": 13892,
+            "index": 7,
+            "latitude": 62.5479,
+            "longitude": 6.139533
+        },
+        {
+            "id": 13893,
+            "index": 8,
+            "latitude": 62.54785,
+            "longitude": 6.139333
+        },
+        {
+            "id": 13894,
+            "index": 9,
+            "latitude": 62.54805,
+            "longitude": 6.1391
+        },
+        {
+            "id": 13895,
+            "index": 10,
+            "latitude": 62.549783,
+            "longitude": 6.1385
+        }
+    ],
+    "areaM2": 64435.13037109375
+}
+

src/Client/Atlas.fs

@@ -12,6 +12,7 @@ open Remoting
 
 open Archmeister.Types
 open Atlantis.Types
+open Atlantis.Shared
 open Maps
 
 importSideEffects "./public/style.scss"

src/Client/BarentsWatch.fs

@@ -0,0 +1,198 @@
+module BarentsWatch
+
+open System
+
+open Browser
+open Fable.Core
+open Thoth.Json
+open Thoth.Fetch
+
+open Atlantis.Shared
+
+
+type Escape = {
+    Date : DateTime
+    Comment: string
+    Species: string
+    Count: int
+    CountType: string
+    CountCategory: string
+    Size: int
+    LocalityNo: int
+    LocalityName: string
+    Year: int
+    Week: int
+    ObjectId: int
+    ParentId: int
+    LocalityCapacity: int
+    WaterEnvironmentCode: string
+    WaterEnvironment: string
+    Status: string
+    StatusLocality: string
+    CreatedDate: DateTime
+    LastEditedDate: DateTime
+    GlobalId: string
+    CleanerFish: bool
+    RecaptureStarted: bool
+    RecaptureDescription: string
+    RecapturesCompleted: int
+    CountEstimated: string
+    MunicipalityNumber: int
+    CountyCode: int
+    County: string
+    Description: string
+    SizeEstimated: int
+}
+
+type IlaPd = {
+    Id : int
+    LocalityNo : int
+    Disease : string
+    Ruling : string
+    FromDate : DateTime
+    ToDate : DateTime option
+}
+with
+    static member decoder =
+        Decode.oneOf [
+            Decode.Auto.generateDecoder(
+                caseStrategy = CaseStrategy.CamelCase
+            )
+            Decode.nil [||]
+        ]
+
+type LiceCountPreviousWeek = {
+    Year: int
+    Week: int
+    HasReportedLice: bool
+    AvgAdultFemaleLice: float option
+    AvgMobileLice: float option
+    AvgStationaryLice: float option
+}
+with
+    static member decoder =
+        Decode.object (fun get -> {
+            Year = get.Required.Field "year" Decode.int
+            Week = get.Required.Field "week" Decode.int
+            HasReportedLice = get.Required.Field "hasReportedLice" Decode.bool
+            AvgAdultFemaleLice = get.Optional.Field "avgAdultFemaleLice" (Decode.oneOf [ Decode.float; Decode.nil 0.0 ])
+            AvgMobileLice = get.Optional.Field "avgMobileLice" (Decode.oneOf [ Decode.float; Decode.nil 0.0 ])
+            AvgStationaryLice = get.Optional.Field "avgStationaryLice" (Decode.oneOf [ Decode.float; Decode.nil 0.0 ])
+        })
+
+// See docs/barentswatch-fishhealth-example-payload.json
+type BarentsWatchFishHealth = {
+    LocalityName : string
+    LocalityIsInAquaCultureRegister : bool
+    LocalityWeek : obj
+    AquaCultureRegister : obj
+    ProductionArea : obj
+    LiceCountPreviousWeek : obj
+    ExportRestrictionAreas : obj array
+    // PdZoneId : string
+    Escapes : Escape array
+    // PdSurveillanceZones : obj array
+    // PdProtectionZones : obj array
+    // IlaSurveillanceZones : obj array
+    // IlaProtectionZones : obj array
+    // IlaFreeAreas : obj array
+    IlaPd : IlaPd array
+    // IlaPdCase : obj array
+}
+with
+    // TODO: Finish the manual decoder
+    // static member decoder =
+    //     Decode.object (fun get ->
+    //         {
+    //             LocalityName = get.Required.Field "localityName" (Decode.oneOf [ Decode.string; Decode.nil "" ])
+    //             LocalityIsInAquaCultureRegister = get.Required.Field "localityIsInAquaCultureRegister" Decode.bool
+    //             // LocalityWeek = get.Optional.Field "localityWeek" ()
+    //             // AquaCultureRegister = get.Optional.Field "aquaCultureRegister" Decode.object
+    //             // ProductionArea : obj
+    //             LiceCountPreviousWeek = get.Required.Field "liceCountPreviousWeek" LiceCountPreviousWeek.decoder
+    //             // ExportRestrictionAreas : obj array
+    //             // PdZoneId : string
+    //             Escapes = get.Required.Field "escapes" (Decode.Auto.generateDecoder<Escape array>())
+    //             // PdSurveillanceZones : obj array
+    //             // PdProtectionZones : obj array
+    //             // IlaSurveillanceZones : obj array
+    //             // IlaProtectionZones : obj array
+    //             // IlaFreeAreas : obj array
+    //             IlaPd = get.Required.Field "ilaPd" (IlaPd.decoder)
+    //             // IlaPdCase : obj array
+    //         }
+    //     )
+    static member autoDecoder =
+        Decode.Auto.generateDecoder<BarentsWatchFishHealth>(
+            caseStrategy = CaseStrategy.CamelCase
+        )
+
+let fetchFishHealth year week localityId callback =
+    Fetch.tryGet(
+        url = $"https://www.barentswatch.no/bwapi/v1/geodata/fishhealth/locality/%i{localityId}/%i{year}/%i{week}",
+        headers = [
+            // TODO: Try to fetch token again if its empty. You might have been on the site for more than 1 hour.
+            Fetch.Types.HttpRequestHeaders.Authorization $"""Bearer {sessionStorage["barentswatch_token"]}"""
+        ],
+        // TODO: Switch to manual decoder
+        decoder = BarentsWatchFishHealth.autoDecoder
+    )
+    |> Promise.iter (
+        Result.mapError (fun err ->
+            match err with
+            | PreparingRequestFailed exn ->
+                console.error("BarentsWatch get preparing request failed:", exn.Message)
+            | DecodingFailed s ->
+                console.error("BarentsWatch get decoding error:", s)
+            | FetchFailed response ->
+                response.json ()
+                |> Promise.iter (fun errorJson ->
+                    console.error("BarentsWatch get fetch failed:", errorJson))
+            | NetworkError exn ->
+                console.error("BarentsWatch get network error:", exn.Message)
+
+            // TODO: Create errMsg based on error
+            "Could not fetch fish health data from BarentsWatch"
+        )
+        >> callback
+    )
+
+let fetchToken () : BarentsWatch.Token option JS.Promise =
+    Fetch.tryGet(
+        url = "/barentswatch-token",
+        decoder = BarentsWatch.tokenDecoder
+    )
+    |> Promise.map (fun res ->
+        match res with
+        | Error err ->
+            console.error("Could not fetch BarentsWatch token", err)
+            None
+        | Ok token ->
+            Some token
+    )
+
+let refreshLoop () : unit JS.Promise =
+    let rec loop () =
+        promise {
+            let! tokenOpt = fetchToken()
+
+            tokenOpt
+            |> Option.iter (fun token ->
+                console.info("Got new BarentsWatch token")
+                sessionStorage["barentswatch_token"] <- token.AccessToken
+            )
+
+            let sleepTimeMs =
+                tokenOpt
+                |> Option.map (fun token ->
+                    let ts = TimeSpan.FromSeconds token.ExpiresIn
+                    ts.Milliseconds)
+                |> Option.defaultValue (
+                    let ts = TimeSpan.FromHours 1
+                    ts.Milliseconds
+                )
+            do! Promise.sleep sleepTimeMs
+            return! loop ()
+        }
+
+    loop ()

src/Client/Client.fsproj

@@ -28,12 +28,14 @@
     <Compile Include="Model.fs"/>
     <Compile Include="MessageHub.fs"/>
     <Compile Include="Colors.fs"/>
-    <Compile Include="Layers.fs"/>
+    <Compile Include="Layers.fs" />
     <Compile Include="Plotting.fs"/>
     <Compile Include="ContourPlots.fs"/>
     <Compile Include="PropertyPlots.fs"/>
     <Compile Include="Fable.VisJS.fs"/>
     <Compile Include="Timeline.fs"/>
+    <Compile Include="Fiskeridir.fs" />
+    <Compile Include="BarentsWatch.fs" />
     <Compile Include="Drifters.fs"/>
     <Compile Include="Probing.fs"/>
     <Compile Include="Stats.fs"/>

src/Client/Fiskeridir.fs

@@ -0,0 +1,85 @@
+module Fiskeridir
+
+open Browser
+open Fable.OpenLayers
+open Thoth.Fetch
+open Thoth.Json
+
+open Atlantis.Types
+open Utils
+
+
+/// See docs/fiskeridir-locality-borders-example-payload.json
+type FiskeridirLocalityBorder = {
+    Id : int
+    SiteVersionId : int
+    SiteNr : int
+    Name : string
+    Type : obj
+    Points : Point array
+    AreaM2 : float
+}
+and Point = {
+    Id : int
+    Index : int
+    Latitude : float
+    Longitude : float
+}
+
+let fetchLocalityBorders (map: Map.Map) (localityId: int) =
+    Fetch.tryGet<unit, FiskeridirLocalityBorder array>(
+        url = $"https://api.fiskeridir.no/pub-aqua/api/v1/sites/{localityId}/borders",
+        headers = [
+            Fetch.Types.HttpRequestHeaders.Accept "application/json"
+            Fetch.Types.HttpRequestHeaders.AcceptCharset "UTF-8"
+        ],
+        decoder =
+            Decode.Auto.generateDecoder<FiskeridirLocalityBorder array>(
+                caseStrategy = CaseStrategy.CamelCase
+            )
+    )
+    |> Promise.map (fun res ->
+        match res with
+        | Error err -> console.error("Could not fetch locality borders from api.fiskeridir.no:", err)
+        | Ok borders ->
+            let points =
+                borders
+                |> Array.collect (fun border ->
+                    border.Points)
+
+            if points.Length < 1 then
+                console.info("This site does not have borders")
+                ()
+            else
+                let feature =
+                    let coords : Coordinate array =
+                        let coords =
+                            points
+                            |> Array.map (fun point ->
+                                posToCoord (point.Longitude, point.Latitude)
+                                |> coordToEpsg3857)
+                        let first = Array.head coords
+                        let last = coords[coords.Length - 1]
+
+                        if first |> Coord.equals last then
+                            coords
+                        else
+                            let first = coords |> Array.head |> Array.singleton
+                            let linearRing = first |> Array.append coords
+                            linearRing
+
+                    let polygon =
+                        Geometry.polygon [
+                            geometry.coordinates [| coords |]
+                            geometry.layout GeometryLayout.XY
+                        ]
+                    Feature.feature [
+                        feature.geometryOrProperties polygon
+                    ]
+
+                feature.setId localityId
+                feature.set("type", "polygon")
+
+                Layers.addFeatures map MapLayer.Aquaculture [| feature |]
+
+            ())

src/Client/Layers.fs

@@ -104,7 +104,7 @@ let addFeatures map layerId (features: Feature array) =
         let layer = baseLayer :?> VectorLayer
         let source = layer.getSource() :?> VectorSource
 
-        console.debug("Adding features to layer", layerId, ":", features)
+        console.debug("Adding features to layer", layerId.Id, ":", features)
         source.addFeatures features
     )
 
@@ -139,6 +139,28 @@ let toggleVisibleFeatures map layerId =
         do layer.setVisible (not visible)
     )
 
+let updateVectorFeature map layerId (findFeatureFunc: VectorSource -> unit) =
+    map
+    |> updateBaseLayer layerId (fun baseLayer ->
+        let layer = baseLayer :?> VectorLayer
+        let source = layer.getSource() :?> VectorSource
+
+        findFeatureFunc source
+    )
+
+let hideVectorFeature map layerId (findFeatureFunc: VectorSource -> Feature option) =
+    map
+    |> updateBaseLayer layerId (fun baseLayer ->
+        let layer = baseLayer :?> VectorLayer
+        let source = layer.getSource() :?> VectorSource
+
+        findFeatureFunc source
+        |> Option.iter (fun feature ->
+            console.debug("hideVectorFeature found feature:", feature)
+            feature.setStyle(Style.style [])
+        )
+    )
+
 let private categorizeFeatures (fs: Feature []) (p: Particles) =
     fs
     |> Array.iteri (fun n f ->
@@ -760,5 +782,4 @@ let activeLayerSelector (dispatch: Msg -> unit) (model: Model) =
                 {layers}
             </sp-radio-group>
         </sp-accordion>
-        """
+        """
-

src/Client/MapTool.fs

@@ -22,7 +22,6 @@ open Model
 open Notifier
 open Remoting
 open Sorcerer.Types
-open Thoth.Fetch
 open Thoth.Json
 open Utils
 
@@ -282,19 +281,33 @@ let addAquacultureHoverInteraction map dispatch : unit =
                 let elem = popup.getElement()
                 let desc : Types.HTMLDivElement = elem.querySelector("div") :?> Types.HTMLDivElement
 
+                // TODO: Show the same hover on polygon hover? Then we must save some information
                 if ev.selected.Length = 0 then
                     popup.setPosition(None)
                 else
                     let feature = ev.selected[0]
-                    let geom = feature.getGeometry()
+                    if feature.get("type") = "polygon" then
-                    let coord = geom.getExtent() |> Extent.extent.getCenter
+                        ()
-                    let species =
+                    else
-                        feature.get("arter") :?> string
+                        let geom = feature.getGeometry()
-                        |> fun s -> if s.Length > 80 then $"{s.Substring(0, 80)}..." else s
+                        let coord = geom.getExtent() |> Extent.extent.getCenter
-                    elem?heading <- feature.get("lokalitet")
+                        let species =
-                    elem?subheading <- species
+                            html $"""
-                    desc.innerText <- feature.get("innehaver") :?> string
+                            <span
-                    popup.setPosition(Some coord)
+                                style="
+                                    display: inline-block;
+                                    overflow: hidden;
+                                    text-overflow: ellipsis;
+                                    white-space: nowrap;
+                                    max-width: 80ch;
+                                "
+                            >
+                                {feature.get("arter") :?> string}
+                            </span>"""
+                        elem?heading <- feature.get("lokalitet")
+                        elem?subheading <- species
+                        desc.innerText <- feature.get("innehaver") :?> string
+                        popup.setPosition(Some coord)
         )
 
         map.addInteraction select
@@ -305,10 +318,12 @@ let addAquacultureClickInteraction map dispatch : unit =
 
     aquacultureLayerOpt
     |> Option.iter (fun (idx, aquacultureLayer)->
+        // TODO: This should maybe be a map click event with forEveryFeatureAt thingy instead of an actual select interaction
         let select =
             Interaction.select [
                 select.layers [ aquacultureLayer :?> VectorLayer ]
                 select.condition Fable.OpenLayers.Event.condition.click
+                select.style (Style.style [])
             ]
 
         select.on (
@@ -317,11 +332,31 @@ let addAquacultureClickInteraction map dispatch : unit =
                 console.debug("Clicked on aquaculture", ev.selected)
                 if ev.selected.Length = 1 then
                     let feature = ev.selected[0]
-                    let localityNumber = feature.get("loknr") |> unbox int |> Some
+                    if feature.get("type") = "polygon" then
+                        feature.getId ()
+                        |> Some
+                        |> SetAquaculture
+                        |> dispatch
+                    else
+                        let localityNumber = feature.get("loknr") |> unbox<int>
+                        // NOTE(simkir): This is used in the layer style to hide all features that are selected. But it
+                        // might not be needed as the select interaction style is already set to hide the feature
+                        feature.set("selected", "true")
+                        if 10000 < localityNumber && localityNumber < 99999 then
+                            Fiskeridir.fetchLocalityBorders map localityNumber |> Promise.start
 
-                    localityNumber
+                // When you deselect a feature (should in theory only be 1), set selected to false and delete the
-                    |> SetAquaculture
+                // location polygon
-                    |> dispatch
+                ev.deselected
+                |> Array.iter (fun feature ->
+                    let localityNumberOpt = feature.get("loknr") |> unbox<int option>
+                    console.debug("Deselecting", feature.get("loknr"))
+
+                    feature.set("selected", "false")
+
+                    updateVectorFeature map MapLayer.Aquaculture (fun source ->
+                        localityNumberOpt
+                        |> Option.iter (source.getFeatureById >> source.removeFeature)))
         )
 
         map.addInteraction select
@@ -898,23 +933,36 @@ let update cmd (model: Model) =
         manageFiskeri m k
         m, Cmd.none
     | SetAquaculture locationIdOpt ->
-        { model with selectedAquaculture = locationIdOpt }, Cmd.none
+        // NOTE: Fetch the borders
+        let fetchBorderCmd =
+            match locationIdOpt with
+            | Some id when 10000 < id && id < 99999 ->
+                Cmd.OfPromise.perform (Fiskeridir.fetchLocalityBorders model.map) id Noop
+            | _ ->
+                Cmd.none
+
+        { model with selectedAquaculture = locationIdOpt },
+        Cmd.batch [|
+            fetchBorderCmd
+        |]
     | InitArchive m ->
         refreshLayers model m
-        let fly () =
+        let fly (infoLayer) =
             // console.debug("Flying")
             let center = toEpsg3857 m.archive.focalPoint
             flyTo m.map center m.archive.defaultZoom
+
+            infoLayer
         let refreshLayerWithDelay t =
             Promise.sleep t
             |> Promise.map (fun () -> refreshLayers model m)
         m,
         Cmd.batch [
-           // Cmd.OfPromise.perform getWireframe m.archive.id SetDefaultWireframe
+            // Cmd.OfPromise.perform getWireframe m.archive.id SetDefaultWireframe
-           Cmd.ofMsg (SetWireframe m.grid)
+            Cmd.ofMsg (SetWireframe m.grid)
-           Cmd.OfPromise.perform Drifters.fetchArchiveDrifters m SetDrifters
+            Cmd.OfPromise.perform Drifters.fetchArchiveDrifters m SetDrifters
-           Cmd.OfFunc.perform fly () Noop
+            Cmd.OfFunc.perform fly InfoLayer.Lokaliteter AddInfoLayer
-           Cmd.OfPromise.perform refreshLayerWithDelay 50 Noop
+            Cmd.OfPromise.perform refreshLayerWithDelay 50 Noop
         ]
     | SetProp (pt, p) ->
         console.debug("[MapTool] SetProp on layer", pt.Id, "to type", p.PropType.ToLabel())
@@ -1180,60 +1228,6 @@ let aquaculturePopup =
         </sp-card>
     """
 
-// See docs/barentswatch-fishhealth-example-payload.json
-type BarentsWatchFishHealth = {
-    LocalityName : string
-    LocalityIsInAquaCultureRegister : bool
-    LocalityWeek : obj
-    AquaCultureRegister : obj
-    ProductionArea : obj
-    LiceCountPreviousWeek : obj
-    ExportRestrictionAreas : obj array
-    PdZoneId : string
-    Escapes : obj array
-    PdSurveillanceZones : obj array
-    PdProtectionZones : obj array
-    IlaSurveillanceZones : obj array
-    IlaProtectionZones : obj array
-    IlaFreeAreas : obj array
-    IlaPd : obj array option
-    IlaPdCase : obj array
-}
-with
-    static member decoder =
-        Decode.Auto.generateDecoder<BarentsWatchFishHealth>(
-            caseStrategy = CaseStrategy.CamelCase
-        )
-
-let fetchBarentsWatchFishHealth year week localityId callback =
-    Thoth.Fetch.Fetch.tryGet(
-        url = $"https://www.barentswatch.no/bwapi/v1/geodata/fishhealth/locality/%i{localityId}/%i{year}/%i{week}",
-        headers = [
-            // TODO: Get token from Atlantis
-            Fetch.Types.HttpRequestHeaders.Authorization $"""Bearer {sessionStorage["barentswatch_token"]}"""
-        ],
-        decoder = BarentsWatchFishHealth.decoder
-    )
-    |> Promise.iter (
-        Result.mapError (fun err ->
-            match err with
-            | PreparingRequestFailed exn ->
-                console.error("BarentsWatch get preparing request failed:", exn.Message)
-            | DecodingFailed s ->
-                console.error("BarentsWatch get decoding error:", s)
-            | FetchFailed response ->
-                response.json ()
-                |> Promise.iter (fun errorJson ->
-                    console.error("BarentsWatch get fetch failed:", errorJson))
-            | NetworkError exn ->
-                console.error("BarentsWatch get network error:", exn.Message)
-
-            // TODO: Create errMsg based on error
-            "Could not fetch fish health data from BarentsWatch"
-        )
-        >> callback
-    )
-
 [<HookComponent>]
 let aquacultureModal (currentTime: DateTime) (aquacultureId: int option) onClose =
     let fishHealthJson, setFishHealth = Hook.useState<string> ""
@@ -1245,7 +1239,7 @@ let aquacultureModal (currentTime: DateTime) (aquacultureId: int option) onClose
             newIdOpt
             |> Option.iter (fun newId ->
                 console.debug("Looking up location number", newId, "in week", week)
-                fetchBarentsWatchFishHealth currentTime.Year week newId (fun fishHealthRes ->
+                BarentsWatch.fetchFishHealth currentTime.Year week newId (fun fishHealthRes ->
                     match fishHealthRes with
                     | Error errMsg ->
                         console.error("BarentsWatch error:", errMsg)
@@ -1464,7 +1458,6 @@ let initModel () =
         Cmd.OfAsync.perform getIdentity () SetIdentity
         Cmd.OfAsync.perform archive () SetArchive
         Cmd.OfAsync.perform atmoApi.Wind.GetBarbSigns () SetArrows
-        Cmd.ofMsg (AddInfoLayer InfoLayer.Lokaliteter)
     ]
 
 let plotPage dispatch model =

src/Client/Maps.fs

@@ -151,19 +151,23 @@ let urlFunc = // must return a lambda!
         //          </PropertyIsEqualTo>
         //      </And>
         //  </Filter>
+        // <fes:Filter>
+        //     <fes:And>
+        //         <fes:PropertyIsNotEqualTo>
+        //             <fes:ValueReference>FiskeridirWFS:Akvakultur_-_Lokaliteter/FiskeridirWFS:status</fes:ValueReference>
+        //             <fes:Literal>RETIRED</fes:Literal>
+        //         </fes:PropertyIsNotEqualTo>
+        //         <fes:BBOX>
+        //             <fes:ValueReference>FiskeridirWFS:Akvakultur_-_Lokaliteter/FiskeridirWFS:shape</fes:ValueReference>
+        //             <gml:Box srsName='EPSG:3857'>
+        //                 <gml:coordinates>{extent}</gml:coordinates>
+        //             </gml:Box>
+        //         </fes:BBOX>
+        //     </fes:And>
+        // </fes:Filter>
         // NOTE: THE XML IS CASE SENSITIVE!
         let filter =
-            $"""
+            $"""<fes:Filter><fes:And><fes:PropertyIsNotEqualTo><fes:ValueReference>FiskeridirWFS:Akvakultur_-_Lokaliteter/FiskeridirWFS:status</fes:ValueReference><fes:Literal>RETIRED</fes:Literal></fes:PropertyIsNotEqualTo><fes:BBOX><fes:ValueReference>FiskeridirWFS:Akvakultur_-_Lokaliteter/FiskeridirWFS:shape</fes:ValueReference><gml:Box srsName='EPSG:3857'><gml:coordinates>{extent}</gml:coordinates></gml:Box></fes:BBOX></fes:And></fes:Filter>"""
-            <fes:Filter>
-                <fes:And>
-                    <fes:PropertyIsNotEqualTo>
-                        <fes:ValueReference>FiskeridirWFS:Akvakultur_-_Lokaliteter/FiskeridirWFS:status</fes:ValueReference>
-                        <fes:Literal>RETIRED</fes:Literal>
-                    </fes:PropertyIsNotEqualTo>
-                    <fes:BBOX><fes:ValueReference>FiskeridirWFS:Akvakultur_-_Lokaliteter/FiskeridirWFS:shape</fes:ValueReference><gml:Box srsName='EPSG:3857'><gml:coordinates>{extent}</gml:coordinates></gml:Box></fes:BBOX>
-                </fes:And>
-            </fes:Filter>
-            """
 
         Lokaliteter.wfsUrl()
         + "?SERVICE=WFS"
@@ -209,12 +213,30 @@ let fiskeri (topic: InfoLayer) : Ol.Layer.Layer =
                     ]
                 )
             ]
+        let polygonStyle =
+            Style.style [
+                style.stroke (
+                    Style.stroke [
+                        stroke.color "white"
+                        stroke.width 1
+                    ]
+                )
+                style.fill (
+                    Style.fill [
+                        fill.color "rgba(0.5, 0.5, 0.5, 0.1)"
+                    ]
+                )
+            ]
 
         // TODO: Try webglPoints again
         Layer.vectorLayer [
             layer.className (string MapLayer.Aquaculture)
             layer.source vectorSource
-            layer.style defaultStyle
+            layer.style (fun feature ->
+                if feature.get("type") = "polygon" then
+                    polygonStyle
+                else
+                    defaultStyle)
             layer.zIndex 12
         ]
     else

src/Server/Api.fs

@@ -13,11 +13,10 @@ open Fable.Remoting.Server
 open Giraffe
 open Microsoft.AspNetCore.Authentication
 open Microsoft.AspNetCore.Http
-open Saturn
 open Serilog
 open Server
-open StackExchange.Redis
 open Thoth.Json.Net
+open StackExchange.Redis
 
 open Archmeister.Actors
 open Atlantis.Shared
@@ -29,33 +28,6 @@ open Petimeter.Interfaces.Actors
 open Settings
 
 
-let fetchBarentsWatchToken clientId secret =
-    async {
-        let! tokenStr =
-            Http.AsyncRequestString(
-                // NOTE: Guessing this wont change much :)
-                url = "https://id.barentswatch.no/connect/token",
-                httpMethod = "POST",
-                headers = [
-                    "Content-Type", "application/x-www-form-urlencoded"
-                ],
-                body =
-                    HttpRequestBody.TextRequest (
-                        "scope=api"
-                        + "&grant_type=client_credentials"
-                        + $"&client_id=%s{clientId}"
-                        + $"&client_secret=%s{secret}"
-                    )
-            )
-        let jsonRes =
-            Decode.Auto.fromString<BarentsWatchToken>(
-                json = tokenStr,
-                caseStrategy = CaseStrategy.SnakeCase
-            )
-
-        return jsonRes
-    }
-
 let anonymous = "unknown"
 
 let getUserName (ctx: HttpContext) =
@@ -97,10 +69,6 @@ module Handlers =
         GetFileService = fun () -> appsettings.sorcerer |> async.Return
     }
 
-    let barentsWatchDecoder (str: string) : Result<BarentsWatchToken, string> =
-        Decode.Auto.fromString<BarentsWatchToken>(json = str, caseStrategy = CaseStrategy.SnakeCase)
-    let barentsWatchEncoder (token: BarentsWatchToken) : string =
-        Encode.Auto.toString(value = token, caseStrategy = CaseStrategy.SnakeCase)
     let refreshDecoder =
         Decode.fromString (Decode.Auto.generateDecoder<Refresh> ())
 
@@ -160,54 +128,8 @@ module Handlers =
                             Log.Information $"token refresh failed: {e}"
                             return None
                     }
-            BarentsWatchToken =
+            // TODO: Remove from here as its not behind authentication
-                fun () ->
+            BarentsWatchToken = BarentsWatch.getToken
-                    let key = "barentswatch_token"
-                    let redis = ConnectionMultiplexer.Connect(appsettings.sso.redis)
-                    let db = redis.GetDatabase()
-                    async {
-                        let value =
-                            try
-                                db.StringGet(key)
-                            with e ->
-                                Log.Error("Exception while fetching value from redis: {Message}", e.Message)
-                                RedisValue()
-                        if value.HasValue then
-                            let tokenStr = string value
-                            Log.Debug("Value is {Value}", tokenStr)
-                            let token =
-                                tokenStr
-                                |> barentsWatchDecoder
-                                |> Result.toOption
-                            Log.Debug("Token is {@Token}", token)
-                            return token
-                        else
-                            let! tokenRes =
-                                barentsWatchClientID
-                                |> Option.bind (fun id ->
-                                    barentsWatchSecret
-                                    |> Option.map (fun secret ->
-                                        fetchBarentsWatchToken id secret))
-                                |> Option.defaultValue (
-                                    Error "Barentswatch secret or client id missing"
-                                    |> async.Return
-                                )
-
-                            match tokenRes with
-                            | Error err ->
-                                Log.Error(err)
-                                return None
-                            | Ok token ->
-                                let tokenStr = barentsWatchEncoder token
-                                let expire = TimeSpan.FromSeconds token.ExpiresIn
-                                if db.StringSet(key = key, value = tokenStr, expiry = expire) then
-                                    Log.Debug("Updated barentsWatch token")
-                                else
-                                    Log.Error("Error pushing barentsWatch token to Redis")
-
-                                return Some token
-                    }
-
         }
 
     let private jobStatsToString status =
@@ -418,4 +340,4 @@ module Endpoints =
         Remoting.createApi ()
         |> Remoting.fromContext Handlers.inboxApi
         |> Remoting.withRouteBuilder Api.routeBuilder
-        |> Remoting.buildHttpHandler
+        |> Remoting.buildHttpHandler

src/Server/BarentsWatch.fs

@@ -0,0 +1,81 @@
+module BarentsWatch
+
+open System
+
+open FSharp.Data
+open Serilog
+open StackExchange.Redis
+
+open Atlantis.Shared
+open Settings
+
+
+/// Gets a new token from BarentsWatch
+let fetchNewToken clientId secret =
+    async {
+        let! tokenStr =
+            Http.AsyncRequestString(
+                // NOTE: Guessing this wont change much :)
+                url = "https://id.barentswatch.no/connect/token",
+                httpMethod = "POST",
+                headers = [
+                    "Content-Type", "application/x-www-form-urlencoded"
+                ],
+                body =
+                    HttpRequestBody.TextRequest (
+                        "scope=api"
+                        + "&grant_type=client_credentials"
+                        + $"&client_id=%s{clientId}"
+                        + $"&client_secret=%s{secret}"
+                    )
+            )
+
+        return BarentsWatch.tokenDecode tokenStr
+    }
+
+/// Tries to see if an existing token exists in Redis, and if not, fetch a new one from BarentsWatch
+let getToken () =
+    let key = "barentswatch_token"
+    let redis = ConnectionMultiplexer.Connect(appsettings.sso.redis)
+    let db = redis.GetDatabase()
+    async {
+        let value =
+            try
+                db.StringGet(key)
+            with e ->
+                Log.Error("Exception while fetching value from redis: {Message}", e.Message)
+                RedisValue()
+        if value.HasValue then
+            let tokenStr = string value
+            Log.Debug("Value is {Value}", tokenStr)
+            let token =
+                BarentsWatch.tokenDecode tokenStr
+                |> Result.toOption
+            Log.Debug("Token is {@Token}", token)
+            return token
+        else
+            let! tokenRes =
+                barentsWatchClientID
+                |> Option.bind (fun id ->
+                    barentsWatchSecret
+                    |> Option.map (fun secret ->
+                        fetchNewToken id secret))
+                |> Option.defaultValue (
+                    Error "Barentswatch secret or client id missing"
+                    |> async.Return
+                )
+
+            match tokenRes with
+            | Error err ->
+                Log.Error(err)
+                return None
+            | Ok token ->
+                let tokenStr = BarentsWatch.tokenEncode token
+                let expire = TimeSpan.FromSeconds token.ExpiresIn
+                if db.StringSet(key = key, value = tokenStr, expiry = expire) then
+                    Log.Debug("Updated barentsWatch token")
+                else
+                    Log.Error("Error pushing barentsWatch token to Redis")
+
+                return Some token
+    }

src/Server/Server.fs

@@ -3,8 +3,10 @@ module Main
 open System
 open System.Text.Json
 open System.Text.Json.Serialization
+
 open Argu
 open Dapr.Actors
+open FSharp.Data
 open Fable.SignalR
 open Giraffe
 open Microsoft.AspNetCore.Authentication
@@ -17,11 +19,11 @@ open Microsoft.Extensions.DependencyInjection
 open Microsoft.Extensions.Logging
 open Prometheus
 open Saturn
+open Saturn.Dapr
 open Serilog
 open Serilog.Events
 
 open Server
-open Saturn.Dapr
 open Atlantis.Shared
 open Auth
 open Settings
@@ -112,6 +114,17 @@ let getAccessToken (next: HttpFunc) (ctx: HttpContext) =
         return! json t next ctx
     }
 
+let getBarentsWatchToken (next: HttpFunc) (ctx: HttpContext) =
+    task {
+        let! tokenOpt = BarentsWatch.getToken () |> Async.StartAsTask
+        match tokenOpt with
+        | None ->
+            ctx.SetStatusCode 500
+            return! text "Could not get BarentsWatch token" next ctx
+        | Some token ->
+            return! json token next ctx
+    }
+
 let getClaims (next: HttpFunc) (ctx: HttpContext) =
     task {
         let c =
@@ -148,6 +161,9 @@ let webApp =
         >=> choose [
             route "/claims" >=> getClaims
             route "/token" >=> getAccessToken
+            // TODO: Start using this in front-end, and remove from authEndpoints
+            // TODO: Implement as Remoting?
+            route "/barentswatch-token" >=> getBarentsWatchToken
             Api.Endpoints.servicesEndpoints
             Api.Endpoints.driftersEndpoints
             Api.Endpoints.inboxEndpoints

src/Server/Server.fsproj

@@ -12,6 +12,7 @@
     <Compile Include="Saturn.Dapr.fs"/>
     <Compile Include="MessageHub.fs"/>
     <Compile Include="Auth.fs"/>
+    <Compile Include="BarentsWatch.fs" />
     <Compile Include="Api.fs"/>
     <Compile Include="PubSub.fs"/>
     <Compile Include="Server.fs"/>

src/Shared/Shared.fs

@@ -5,6 +5,11 @@ open Drifters.ApiTypes
 open Hipster.Interfaces.Job
 open Hipster.Interfaces.Actors
 open Petimeter.Interfaces.Inbox
+#if FABLE_COMPILER
+open Thoth.Json
+#else
+open Thoth.Json.Net
+#endif
 
 type UserCredentials = { username: string; password: string }
 
@@ -18,13 +23,23 @@ type OidToken =
         scope: string
     }
 
-type BarentsWatchToken = {
+module BarentsWatch =
-    AccessToken: string
+    type Token = {
-    /// In seconds. Should be 3600s as per BarentsWatch docs
+        AccessToken: string
-    ExpiresIn: int
+        /// In seconds. Should be 3600s as per BarentsWatch docs
-    TokenType: string
+        ExpiresIn: int
-    Scope: string
+        TokenType: string
-}
+        Scope: string
+    }
+
+    let tokenDecode (str: string) : Result<Token, string> =
+        Decode.Auto.fromString<Token>(json = str, caseStrategy = CaseStrategy.SnakeCase)
+
+    let tokenDecoder =
+        Decode.Auto.generateDecoder<Token>(caseStrategy = CaseStrategy.SnakeCase)
+
+    let tokenEncode (token: Token) : string =
+        Encode.Auto.toString(value = token, caseStrategy = CaseStrategy.SnakeCase)
 
 [<RequireQualifiedAccess>]
 module Api =
@@ -47,7 +62,7 @@ module Api =
             IsAuthenticated: unit -> Async<(string * string) option>
             HasRoleOf: string -> Async<bool>
             RefreshAccessToken: string -> Async<(string * string) option>
-            BarentsWatchToken: unit -> Async<BarentsWatchToken option>
+            BarentsWatchToken: unit -> Async<BarentsWatch.Token option>
         }
 
     type Services =
@@ -136,5 +151,4 @@ module Hub =
         | Note of Notification.Note
         | InboxUnread of int
         | Success
-        | Failure of string
+        | Failure of string
-