[National Highways] Initialise single-sign on

perllib/FixMyStreet/App/Controller/Auth/Social.pm

@@ -292,9 +292,8 @@ sub oidc_callback: Path('/auth/OIDC') : Args(0) {
     # The only other valid state param is 'login' at this point.
     $c->detach('/page_error_400_bad_request', []) unless $c->get_param('state') eq 'login';
 
-    my $id_token;
-    eval {
-        $id_token = $oidc->get_access_token(
+    my $token = eval {
+        $oidc->get_access_token(
             code => $c->get_param('code'),
             redirect_uri => $c->uri_for('/auth/OIDC')
         );
@@ -303,12 +302,22 @@ sub oidc_callback: Path('/auth/OIDC') : Args(0) {
         (my $message = $@) =~ s/at [^ ]*Auth.pm.*//;
         $c->detach('/page_error_500_internal_error', [ $message ]);
     }
+    my $id_token = $token->{id_token};
+    my $access_token = $token->{access_token};
 
     if (!$id_token) {
         $c->log->info("Social::oidc_callback no id_token: " . $oidc->{last_response}->{_content});
         $c->detach('oauth_failure');
     }
 
+    if (FixMyStreet->config('STAGING_SITE')) {
+        my $message = '';
+        for my $key (sort keys %{$id_token->payload}) {
+            $message .= $key . " : " . $id_token->payload->{$key} . "\n" if $id_token->payload->{$key};
+        }
+        $c->log->info($message) if $message;
+    }
+
     # sanity check the token audience is us...
     unless ($id_token->payload->{aud} eq $c->forward('oidc_config')->{client_id}) {
         $c->log->info("Social::oidc_callback invalid id_token: expected aud to be " . $c->forward('oidc_config')->{client_id} . " but it was " . $id_token->payload->{aud});
@@ -333,7 +342,7 @@ sub oidc_callback: Path('/auth/OIDC') : Args(0) {
     $c->session->{oauth}{id_token} = $id_token->token_string;
 
     # Cobrands can use different fields for name and email
-    my ($name, $email) = $c->cobrand->call_hook(user_from_oidc => $id_token->payload);
+    my ($name, $email) = $c->cobrand->call_hook(user_from_oidc => $id_token->payload, $access_token);
     $name = '' if $name && $name !~ /\w/;
 
     # There's a chance that a user may have multiple OIDC logins, so build a namespaced uid to prevent collisions

perllib/FixMyStreet/Cobrand/HighwaysEngland.pm

@@ -1,16 +1,31 @@
+=head1 NAME
+
+FixMyStreet::Cobrand::HighwaysEngland - code specific to the National Highways cobrand
+
+=head1 SYNOPSIS
+
+National Highways, previously Highways England, is the national roads
+authority, and responsible for motorways and major roads in England.
+
+=head1 DESCRIPTION
+
+=cut
+
 package FixMyStreet::Cobrand::HighwaysEngland;
 use parent 'FixMyStreet::Cobrand::UK';
 
 use strict;
 use warnings;
 use utf8;
 use DateTime;
+use JSON::MaybeXS;
+use LWP::UserAgent;
 
 sub council_name { 'National Highways' }
 
-sub council_url { 'highwaysengland' }
+sub council_url { 'nationalhighways' }
 
-sub site_key { 'highwaysengland' }
+sub site_key { 'nationalhighways' }
 
 sub restriction { { cobrand => shift->moniker } }
 
@@ -22,7 +37,12 @@
 
 sub all_reports_single_body { { name => 'National Highways' } }
 
-# Copying of functions from UKCouncils that are needed here also - factor out to a role of some sort?
+=over 4
+
+=item * It is not a council, so inherits from UK, not UKCouncils, but a number of functions are shared with what councils do
+
+=cut
+
 sub cut_off_date { '2020-11-09' }
 sub problems_restriction { FixMyStreet::Cobrand::UKCouncils::problems_restriction($_[0], $_[1]) }
 sub problems_on_map_restriction { $_[0]->problems_restriction($_[1]) }
@@ -33,7 +53,10 @@
 sub contact_name { FixMyStreet::Cobrand::UKCouncils::contact_name($_[0]) }
 sub contact_email { FixMyStreet::Cobrand::UKCouncils::contact_email($_[0]) }
 
-# Make sure any reports made when site was only fully anonymous remain anonymous
+=item * Any report made when the site was only fully anonymous should remain anonymous
+
+=cut
+
 my $non_anon = DateTime->new( year => 2022, month => 10, day => 5 );
 
 sub munge_problem_list {
@@ -56,6 +79,23 @@
     return $user->from_body->get_column('name') eq 'National Highways';
 }
 
+=item * We reword a few admin permissions to be clearer
+
+=cut
+
+sub available_permissions {
+    my $self = shift;
+    my $perms = $self->next::method();
+    $perms->{Problems}->{default_to_body} = "Default to creating reports/updates as " . $self->council_name;
+    $perms->{Problems}->{contribute_as_body} = "Create reports/updates as " . $self->council_name;
+    $perms->{Problems}->{view_body_contribute_details} = "See user detail for reports created as " . $self->council_name;
+    return $perms;
+}
+
+=item * There is an extra question asking where you heard about the site
+
+=cut
+
 sub report_form_extras {
     ( { name => 'where_hear' } )
 }
@@ -67,6 +107,10 @@
     return $self->feature('example_places') || $self->next::method();
 }
 
+=item * Provide nicer help if it looks like they're searching for a road name
+
+=cut
+
 sub geocode_postcode {
     my ( $self, $s ) = @_;
 
@@ -79,6 +123,10 @@
     return $self->next::method($s);
 }
 
+=item * Allow lookup by FMSid
+
+=cut
+
 sub lookup_by_ref_regex {
     return qr/^\s*((?:FMS\s*)?\d+)\s*$/i;
 }
@@ -93,13 +141,11 @@
     return 0;
 }
 
-sub allow_photo_upload { 0 }
+=item * No photos
 
-sub allow_anonymous_reports { 'button' }
+=cut
 
-sub admin_user_domain { ( 'highwaysengland.co.uk', 'nationalhighways.co.uk' ) }
-
-sub abuse_reports_only { 1 }
+sub allow_photo_upload { 0 }
 
 # Bypass photo requirement, we have none
 sub recent_photos {
@@ -108,6 +154,28 @@
     return [];
 }
 
+=item * Anonymous reporting is allowed
+
+=cut
+
+sub allow_anonymous_reports { 'button' }
+
+=item * Two domains for admin users
+
+=cut
+
+sub admin_user_domain { ( 'highwaysengland.co.uk', 'nationalhighways.co.uk' ) }
+
+=item * No contact form
+
+=cut
+
+sub abuse_reports_only { 1 }
+
+=item * Only works in England
+
+=cut
+
 sub area_check {
     my ( $self, $params, $context ) = @_;
 
@@ -148,6 +216,10 @@
     "eg ‘This road sign has been obscured for two months and…’"
 }
 
+=item * New reports are possibly redacted
+
+=cut
+
 sub report_new_munge_after_insert {
     my ($self, $report) = @_;
 
@@ -194,6 +266,56 @@
     return $s;
 }
 
+=back
+
+=head1 OIDC single sign on
+
+Noational Highways has a single-sign on option
+
+=over 4
+
+=item * Single sign on is enabled if the configuration is set up
+
+=cut
+
+sub social_auth_enabled {
+    my $self = shift;
+
+    return $self->feature('oidc_login') ? 1 : 0;
+}
+
+=item * Different single sign-ons send user details differently, user_from_oidc extracts the relevant parts
+
+=cut
+
+sub user_from_oidc {
+    my ($self, $payload, $access_token) = @_;
+
+    my $name = $payload->{name} ? $payload->{name} : '';
+    my $email = $payload->{email} ? lc($payload->{email}) : '';
+
+    if ($payload->{oid} && $access_token) {
+        my $ua = LWP::UserAgent->new;
+        my $response = $ua->get(
+            'https://graph.microsoft.com/v1.0/users/' . $payload->{oid} . '?$select=displayName,department',
+            Authorization => 'Bearer ' . $access_token,
+        );
+        my $user = decode_json($response->decoded_content);
+        $payload->{roles} = [ $user->{department} ] if $user->{department};
+    }
+
+    return ($name, $email);
+}
+
+=head2 Report categories
+
+
+There is special handling of NH body/contacts, to handle the fact litter is not
+NH responsibility on most, but not all, NH roads; NH categories must end "(NH)"
+(this is stripped for display).
+
+=cut
+
 sub munge_report_new_bodies {
     my ($self, $bodies) = @_;
     # On the cobrand there is only the HE body
@@ -298,6 +420,19 @@
     return scalar @$features ? 0 : 1;
 }
 
+=item * Only Admin roles can access the dashboard
+
+=cut
+
+sub dashboard_permission {
+    my $self = shift;
+    my $c = $self->{c};
+
+    my $admin = grep { $_->name eq 'Admin' } $c->user->obj->roles->all;
+    return 0 unless $admin;
+    return undef;
+}
+
 sub dashboard_export_problems_add_columns {
     my ($self, $csv) = @_;
 

perllib/FixMyStreet/Cobrand/TfL.pm

@@ -375,40 +375,6 @@ sub user_from_oidc {
     return ($name, $email);
 }
 
-=item * TfL sends the user role in the single sign-on payload, which we use to set the FMS role
-
-=cut
-
-sub roles_from_oidc {
-    my ($self, $user, $roles) = @_;
-
-    return unless $roles && @$roles;
-
-    $user->user_roles->delete;
-    $user->from_body($self->body->id);
-
-    my $cfg = $self->feature('oidc_login') || {};
-    my $role_map = $cfg->{role_map} || {};
-
-    my @body_roles;
-    for ($user->from_body->roles->order_by('name')->all) {
-        push @body_roles, {
-            id => $_->id,
-            name => $_->name,
-        }
-    }
-
-    for my $assign_role (@$roles) {
-        my ($body_role) = grep { $role_map->{$assign_role} && $_->{name} eq $role_map->{$assign_role} } @body_roles;
-
-        if ($body_role) {
-            $user->user_roles->find_or_create({
-                role_id => $body_role->{id},
-            });
-        }
-    }
-}
-
 sub state_groups_inspect {
     my $rs = FixMyStreet::DB->resultset("State");
     my @open = grep { $_ !~ /^(planned|investigating|for triage)$/ } FixMyStreet::DB::Result::Problem->open_states;

perllib/FixMyStreet/Cobrand/UK.pm

@@ -634,4 +634,38 @@ sub _email_to_body {
     return $body;
 }
 
+=item * Some OIDC users send the user role in the single sign-on payload, which we use to set the FMS role
+
+=cut
+
+sub roles_from_oidc {
+    my ($self, $user, $roles) = @_;
+
+    return unless $roles && @$roles;
+
+    $user->user_roles->delete;
+    $user->from_body($self->body->id);
+
+    my $cfg = $self->feature('oidc_login') || {};
+    my $role_map = $cfg->{role_map} || {};
+
+    my @body_roles;
+    for ($user->from_body->roles->order_by('name')->all) {
+        push @body_roles, {
+            id => $_->id,
+            name => $_->name,
+        }
+    }
+
+    for my $assign_role (@$roles) {
+        my ($body_role) = grep { $role_map->{$assign_role} && $_->{name} eq $role_map->{$assign_role} } @body_roles;
+
+        if ($body_role) {
+            $user->user_roles->find_or_create({
+                role_id => $body_role->{id},
+            });
+        }
+    }
+}
+
 1;

perllib/FixMyStreet/DB/Result/Comment.pm

@@ -310,6 +310,9 @@ sub meta_line {
                 $body = 'Island Roads';
             } elsif ($body eq 'Thamesmead') {
                $body = 'Peabody';
+            } elsif ($body eq 'National Highways') {
+                # Always use what was saved on the comment
+                $body = FixMyStreet::Template::html_filter($self->name);
             }
         }
         my $cobrand_always_view_body_user = $cobrand->call_hook(always_view_body_contribute_details => $contributed_as);

perllib/OIDC/Lite/Client/IDTokenResponseParser.pm

@@ -50,7 +50,10 @@ sub parse {
             message => sprintf("Response doesn't include 'id_token'")
         ) unless exists $result->{id_token};
 
-        $token = OIDC::Lite::Model::IDToken->load($result->{id_token});
+        $token = {
+            id_token => OIDC::Lite::Model::IDToken->load($result->{id_token}),
+            access_token => $result->{access_token},
+        };
 
     } else {