src/PrayerTracker.Data/Access.fs

@@ -0,0 +1,214 @@
+namespace PrayerTracker.Data
+
+open NodaTime
+open Npgsql
+open Npgsql.FSharp
+open PrayerTracker.Entities
+
+/// Helper functions for the PostgreSQL data implementation
+[<AutoOpen>]
+module private Helpers =
+    
+    /// Map a row to a Church instance
+    let mapToChurch (row : RowReader) =
+        {   Id               = ChurchId         (row.uuid "id")
+            Name             = row.string       "name"
+            City             = row.string       "city"
+            State            = row.string       "state"
+            HasVpsInterface  = row.bool         "has_vps_interface"
+            InterfaceAddress = row.stringOrNone "interface_address"
+        }
+    
+    /// Map a row to a ListPreferences instance
+    let mapToListPreferences (row : RowReader) =
+        {   SmallGroupId = SmallGroupId (row.uuid "small_group_id")
+            DaysToKeepNew = row.int "days_to_keep_new"
+            DaysToExpire  = row.int "days_to_expire"
+            LongTermUpdateWeeks = row.int "long_term_update_weeks"
+            EmailFromName       = row.string "email_from_name"
+            EmailFromAddress    = row.string "email_from_address"
+            Fonts               = row.string "fonts"
+            HeadingColor        = row.string "heading_color"
+            LineColor           = row.string "line_color"
+            HeadingFontSize     = row.int    "heading_font_size"
+            TextFontSize        = row.int    "text_font_size"
+            RequestSort         = RequestSort.fromCode (row.string "request_sort")
+            GroupPassword       = row.string "group_password"
+            DefaultEmailType    = EmailFormat.fromCode (row.string "default_email_type")
+            IsPublic            = row.bool "is_public"
+            TimeZoneId          = TimeZoneId (row.string "time_zone_id")
+            PageSize            = row.int "page_size"
+            AsOfDateDisplay     = AsOfDateDisplay.fromCode (row.string "as_of_date_display")
+            TimeZone = TimeZone.empty
+        }
+    
+    /// Map a row to a Small Group instance
+    let mapToSmallGroup (row : RowReader) =
+        {   Id          = SmallGroupId (row.uuid "id")
+            ChurchId    = ChurchId     (row.uuid "church_id")
+            Name        = row.string   "group_name"
+            Preferences = ListPreferences.empty
+            Church = Church.empty
+            Members = ResizeArray ()
+            PrayerRequests = ResizeArray ()
+            Users = ResizeArray ()
+        }
+    
+    /// Map a row to a Small Group instance with populated list preferences    
+    let mapToSmallGroupWithPreferences (row : RowReader) =
+        { mapToSmallGroup row with
+            Preferences = mapToListPreferences row
+        }
+    
+    /// Map a row to a User instance
+    let mapToUser (row : RowReader) =
+        {   Id           = UserId     (row.uuid "id")
+            FirstName    = row.string "first_name"
+            LastName     = row.string "last_name"
+            Email        = row.string "email"
+            IsAdmin      = row.bool   "is_admin"
+            PasswordHash = row.string "password_hash"
+            Salt         = None
+            LastSeen     = row.fieldValueOrNone<Instant> "last_seen"
+            SmallGroups = ResizeArray ()
+        }
+
+
+module Churches =
+    let tryById (churchId : ChurchId) conn = backgroundTask {
+        let! church =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query "SELECT * FROM pt.church WHERE id = @id"
+            |> Sql.parameters [ "@id", Sql.uuid churchId.Value ]
+            |> Sql.executeAsync mapToChurch
+        return List.tryHead church
+    }
+
+
+/// Functions to retrieve small group information
+module SmallGroups =
+    
+    /// Get a list of small group IDs along with a description that includes the church name
+    let listAll conn =
+        conn
+        |> Sql.existingConnection
+        |> Sql.query """
+            SELECT g.group_name, g.id, c.church_name
+              FROM pt.small_group g
+                   INNER JOIN pt.church c ON c.id = g.church_id
+             ORDER BY c.church_name, g.group_name"""
+        |> Sql.executeAsync (fun row ->
+            Giraffe.ShortGuid.fromGuid (row.uuid "id"), $"""{row.string "church_name"} | {row.string "group_name"}""")
+    
+    let tryByIdWithPreferences (groupId : SmallGroupId) conn = backgroundTask {
+        let! group =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query """
+                SELECT sg.*, lp.*
+                  FROM pt.small_group sg
+                       INNER JOIN list_preference lp ON lp.small_group_id = sg.id
+                 WHERE sg.id = @id"""
+            |> Sql.parameters [ "@id", Sql.uuid groupId.Value ]
+            |> Sql.executeAsync mapToSmallGroupWithPreferences
+        return List.tryHead group
+    }
+
+
+/// Functions to manipulate users
+module Users =
+    
+    /// Retrieve all PrayerTracker users
+    let all conn =
+        conn
+        |> Sql.existingConnection
+        |> Sql.query "SELECT * FROM pt.pt_user ORDER BY last_name, first_name"
+        |> Sql.executeAsync mapToUser
+    
+    /// Delete a user by its database ID
+    let deleteById (userId : UserId) conn = backgroundTask {
+        let! _ =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query "DELETE FROM pt.pt_user WHERE id = @id"
+            |> Sql.parameters [ "@id", Sql.uuid userId.Value ]
+            |> Sql.executeNonQueryAsync
+        return ()
+    }
+    
+    /// Save a user's information
+    let save user conn = backgroundTask {
+        let! _ =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query """
+                INSERT INTO pt.pt_user (
+                    id, first_name, last_name, email, is_admin, password_hash
+                ) VALUES (
+                    @id, @firstName, @lastName, @email, @isAdmin, @passwordHash
+                ) ON CONFLICT (id) DO UPDATE
+                SET first_name    = EXCLUDED.first_name,
+                    last_name     = EXCLUDED.last_name,
+                    email         = EXCLUDED.email,
+                    is_admin      = EXCLUDED.is_admin,
+                    password_hash = EXCLUDED.password_hash"""
+            |> Sql.parameters
+                [   "@id",           Sql.uuid   user.Id.Value
+                    "@firstName",    Sql.string user.FirstName
+                    "@lastName",     Sql.string user.LastName
+                    "@email",        Sql.string user.Email
+                    "@isAdmin",      Sql.bool   user.IsAdmin
+                    "@passwordHash", Sql.string user.PasswordHash
+                ]
+            |> Sql.executeNonQueryAsync
+        return ()
+    }
+    
+    /// Find a user by its e-mail address and authorized small group
+    let tryByEmailAndGroup email (groupId : SmallGroupId) conn = backgroundTask {
+        let! user =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query """
+                SELECT u.*
+                  FROM pt.pt_user u
+                       INNER JOIN pt.user_small_group usg ON usg.user_id = u.id AND usg.small_group_id = @groupId
+                 WHERE u.email = @email"""
+            |> Sql.parameters [ "@email", Sql.string email; "@groupId", Sql.uuid groupId.Value ]
+            |> Sql.executeAsync mapToUser
+        return List.tryHead user
+    }
+    
+    /// Find a user by their database ID
+    let tryById (userId : UserId) conn = backgroundTask {
+        let! user =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query "SELECT * FROM pt.pt_user WHERE id = @id"
+            |> Sql.parameters [ "@id", Sql.uuid userId.Value ]
+            |> Sql.executeAsync mapToUser
+        return List.tryHead user
+    }
+    
+    /// Update a user's last seen date/time
+    let updateLastSeen (userId : UserId) (now : Instant) conn = backgroundTask {
+        let! _ =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query "UPDATE pt.pt_user SET last_seen = @now WHERE id = @id"
+            |> Sql.parameters [ "@id", Sql.uuid userId.Value; "@now", Sql.parameter (NpgsqlParameter ("@now", now)) ]
+            |> Sql.executeNonQueryAsync
+        return ()            
+    }
+    
+    /// Update a user's password hash
+    let updatePassword user conn = backgroundTask {
+        let! _ =
+            conn
+            |> Sql.existingConnection
+            |> Sql.query "UPDATE pt.pt_user SET password_hash = @passwordHash WHERE id = @id"
+            |> Sql.parameters [ "@id", Sql.uuid user.Id.Value; "@passwordHash", Sql.string user.PasswordHash ]
+            |> Sql.executeNonQueryAsync
+        return ()
+    }

src/PrayerTracker.Data/Entities.fs

@@ -396,9 +396,6 @@ type [<CLIMutable; NoComparison; NoEquality>] Church =
         
         /// The address for the interface
         InterfaceAddress : string option
-        
-        /// Small groups for this church
-        SmallGroups : ResizeArray<SmallGroup>
     }
 with
     /// An empty church
@@ -410,7 +407,6 @@ with
             State            = ""
             HasVpsInterface  = false
             InterfaceAddress = None
-            SmallGroups      = ResizeArray<SmallGroup> ()
         }
     
     /// Configure EF for this entity

src/PrayerTracker.Data/PrayerTracker.Data.fsproj

@@ -6,6 +6,7 @@
 
   <ItemGroup>
     <Compile Include="Entities.fs" />
+    <Compile Include="Access.fs" />
     <Compile Include="AppDbContext.fs" />
     <Compile Include="DataAccess.fs" />
     <Compile Include="Migrations\20161217153124_InitialDatabase.fs" />
@@ -19,6 +20,8 @@
     <PackageReference Include="NodaTime" Version="3.1.0" />
     <PackageReference Include="Npgsql.EntityFrameworkCore.PostgreSQL" Version="6.0.6" />
     <PackageReference Update="FSharp.Core" Version="6.0.5" />
+    <PackageReference Include="Npgsql.FSharp" Version="5.3.0" />
+    <PackageReference Include="Npgsql.NodaTime" Version="6.0.6" />
   </ItemGroup>
 
 </Project>

src/PrayerTracker.Tests/Data/EntitiesTests.fs

@@ -43,8 +43,6 @@ let churchTests =
             Expect.equal mt.State "" "The state should have been blank"
             Expect.isFalse mt.HasVpsInterface "The church should not show that it has an interface"
             Expect.isNone mt.InterfaceAddress "The interface address should not exist"
-            Expect.isNotNull mt.SmallGroups "The small groups navigation property should not be null"
-            Expect.isEmpty mt.SmallGroups "There should be no small groups for an empty church"
         }
     ]
 

src/PrayerTracker/App.fs

@@ -71,7 +71,6 @@ module Configure =
         let _ = svc.AddSingleton<IClock> SystemClock.Instance
         
         let config = svc.BuildServiceProvider().GetRequiredService<IConfiguration> ()
-        //NpgsqlConnection.GlobalTypeMapper.
         let _      =
             svc.AddDbContext<AppDbContext> (
                 (fun options ->

src/PrayerTracker/Church.fs

@@ -16,7 +16,8 @@ let private findStats (db : AppDbContext) churchId = task {
 /// POST /church/[church-id]/delete
 let delete chId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
     let  churchId = ChurchId chId
-    match! ctx.Db.TryChurchById churchId with
+    use! conn     = ctx.Conn
+    match! Data.Churches.tryById churchId conn with
     | Some church ->
         let! _, stats = findStats ctx.Db churchId
         ctx.Db.RemoveEntry church
@@ -39,7 +40,8 @@ let edit churchId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> ta
             |> Views.Church.edit EditChurch.empty ctx
             |> renderHtml next ctx
     else
-        match! ctx.Db.TryChurchById (ChurchId churchId) with
+        use! conn = ctx.Conn
+        match! Data.Churches.tryById (ChurchId churchId) conn with
         | Some church -> 
             return!
                 viewInfo ctx
@@ -65,9 +67,10 @@ open System.Threading.Tasks
 let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
     match! ctx.TryBindFormAsync<EditChurch> () with
     | Ok model ->
+        let! conn = ctx.Conn
         let! church =
             if model.IsNew then Task.FromResult (Some { Church.empty with Id = (Guid.NewGuid >> ChurchId) () })
-            else ctx.Db.TryChurchById (idFromShort ChurchId model.ChurchId)
+            else Data.Churches.tryById (idFromShort ChurchId model.ChurchId) conn
         match church with
         | Some ch ->
             model.PopulateChurch ch

src/PrayerTracker/Extensions.fs

@@ -69,15 +69,31 @@ type ClaimsPrincipal with
         else None
 
 
+open System.Threading.Tasks
 open Giraffe
+open Microsoft.Extensions.Configuration
+open Npgsql
 open PrayerTracker
 
 /// Extensions on the ASP.NET Core HTTP context
 type HttpContext with
     
+    // TODO: is this disposed?
+    member private this.LazyConn : Lazy<Task<NpgsqlConnection>> = lazy (backgroundTask {
+        let cfg  = this.GetService<IConfiguration> ()
+        let conn = new NpgsqlConnection (cfg.GetConnectionString "PrayerTracker")
+        do! conn.OpenAsync ()
+        return conn
+    })
+    
     /// The EF Core database context (via DI)
     member this.Db = this.GetService<AppDbContext> ()
     
+    /// The PostgreSQL connection (configured via DI)
+    member this.Conn = backgroundTask {
+        return! this.LazyConn.Force ()
+    }
+    
     /// The system clock (via DI)
     member this.Clock = this.GetService<IClock> ()
     

src/PrayerTracker/User.fs

@@ -5,6 +5,7 @@ open Giraffe
 open Microsoft.AspNetCore.Http
 open Microsoft.AspNetCore.Identity
 open PrayerTracker
+open PrayerTracker.Data
 open PrayerTracker.Entities
 open PrayerTracker.ViewModels
 
@@ -52,16 +53,15 @@ module Hashing =
 
     
 /// Retrieve a user from the database by password, upgrading password hashes if required
-let private findUserByPassword model (db : AppDbContext) = task {
-    match! db.TryUserByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) with
+let private findUserByPassword model conn = task {
+    match! Users.tryByEmailAndGroup model.Email (idFromShort SmallGroupId model.SmallGroupId) conn with
     | Some user ->
         let hasher = PrayerTrackerPasswordHasher ()
         match hasher.VerifyHashedPassword (user, user.PasswordHash, model.Password) with
         | PasswordVerificationResult.Success -> return Some user
         | PasswordVerificationResult.SuccessRehashNeeded ->
             let upgraded = { user with PasswordHash = hasher.HashPassword (user, model.Password) }
-            db.UpdateEntry upgraded
-            let! _ = db.SaveChangesAsync ()
+            do! Users.updatePassword upgraded conn
             return Some upgraded
         | _ -> return None
     | None -> return None
@@ -81,8 +81,9 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
         let  s      = Views.I18N.localizer.Force ()
         let  curUsr = ctx.Session.CurrentUser.Value
         let  hasher = PrayerTrackerPasswordHasher ()
+        let! conn   = ctx.Conn
         let! user   = task {
-            match! ctx.Db.TryUserById curUsr.Id with
+            match! Users.tryById curUsr.Id conn with
             | Some usr ->
                 if hasher.VerifyHashedPassword (usr, usr.PasswordHash, model.OldPassword)
                        = PasswordVerificationResult.Success then
@@ -92,8 +93,7 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
         }
         match user with
         | Some usr when model.NewPassword = model.NewPasswordConfirm ->
-            ctx.Db.UpdateEntry { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) }
-            let! _ = ctx.Db.SaveChangesAsync ()
+            do! Users.updatePassword { usr with PasswordHash = hasher.HashPassword (usr, model.NewPassword) } conn
             addInfo ctx s["Your password was changed successfully"]
             return! redirectTo false "/" next ctx
         | Some _ ->
@@ -108,10 +108,10 @@ let changePassword : HttpHandler = requireAccess [ User ] >=> validateCsrf >=> f
 /// POST /user/[user-id]/delete
 let delete usrId : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
     let  userId = UserId usrId
-    match! ctx.Db.TryUserById userId with
+    let! conn   = ctx.Conn
+    match! Users.tryById userId conn with
     | Some user ->
-        ctx.Db.RemoveEntry user
-        let! _ = ctx.Db.SaveChangesAsync ()
+        do! Users.deleteById userId conn
         let s = Views.I18N.localizer.Force ()
         addInfo ctx s["Successfully deleted user {0}", user.Name]
         return! redirectTo false "/users" next ctx
@@ -129,9 +129,10 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
     match! ctx.TryBindFormAsync<UserLogOn> () with
     | Ok model -> 
         let  s    = Views.I18N.localizer.Force ()
-        match! findUserByPassword model ctx.Db with
+        let! conn = ctx.Conn
+        match! findUserByPassword model conn with
         | Some user ->
-            match! ctx.Db.TryGroupById (idFromShort SmallGroupId model.SmallGroupId) with
+            match! SmallGroups.tryByIdWithPreferences (idFromShort SmallGroupId model.SmallGroupId) conn with
             | Some group ->
                 ctx.Session.CurrentUser  <- Some user
                 ctx.Session.CurrentGroup <- Some group
@@ -145,8 +146,7 @@ let doLogOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> validateCsr
                         AuthenticationProperties (
                             IssuedUtc    = DateTimeOffset.UtcNow,
                             IsPersistent = defaultArg model.RememberMe false))
-                ctx.Db.UpdateEntry { user with LastSeen = Some ctx.Now }
-                let! _ = ctx.Db.SaveChangesAsync ()
+                do! Users.updateLastSeen user.Id ctx.Now conn
                 addHtmlInfo ctx s["Log On Successful • Welcome to {0}", s["PrayerTracker"]]
                 return! redirectTo false (sanitizeUrl model.RedirectUrl "/small-group") next ctx
             | None -> return! fourOhFour ctx
@@ -177,7 +177,8 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
             |> Views.User.edit EditUser.empty ctx
             |> renderHtml next ctx
     else
-        match! ctx.Db.TryUserById userId with
+        let! conn = ctx.Conn
+        match! Users.tryById userId conn with
         | Some user ->
             return!
                 viewInfo ctx
@@ -189,7 +190,8 @@ let edit usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task
 /// GET /user/log-on
 let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx -> task {
     let  s      = Views.I18N.localizer.Force ()
-    let! groups = ctx.Db.GroupList ()
+    let! conn   = ctx.Conn
+    let! groups = SmallGroups.listAll conn
     let  url    = Option.ofObj <| ctx.Session.GetString Key.Session.redirectUrl
     match url with
     | Some _ ->
@@ -204,7 +206,8 @@ let logOn : HttpHandler = requireAccess [ AccessLevel.Public ] >=> fun next ctx
 
 /// GET /users
 let maintain : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
-    let! users = ctx.Db.AllUsers ()
+    let! conn  = ctx.Conn
+    let! users = Users.all conn
     return!
         viewInfo ctx
         |> Views.User.maintain users ctx
@@ -223,15 +226,15 @@ open System.Threading.Tasks
 let save : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun next ctx -> task {
     match! ctx.TryBindFormAsync<EditUser> () with
     | Ok model ->
+        let! conn = ctx.Conn
         let! user =
             if model.IsNew then Task.FromResult (Some { User.empty with Id = (Guid.NewGuid >> UserId) () })
-            else ctx.Db.TryUserById (idFromShort UserId model.UserId)
+            else Users.tryById (idFromShort UserId model.UserId) conn
         match user with
         | Some usr ->
             let hasher      = PrayerTrackerPasswordHasher ()
             let updatedUser = model.PopulateUser usr (fun pw -> hasher.HashPassword (usr, pw))
-            updatedUser |> if model.IsNew then ctx.Db.AddEntry else ctx.Db.UpdateEntry
-            let! _ = ctx.Db.SaveChangesAsync ()
+            do! Users.save updatedUser conn
             let s = Views.I18N.localizer.Force ()
             if model.IsNew then
                 let h = CommonFunctions.htmlString
@@ -284,10 +287,11 @@ let saveGroups : HttpHandler = requireAccess [ Admin ] >=> validateCsrf >=> fun
 
 /// GET /user/[user-id]/small-groups
 let smallGroups usrId : HttpHandler = requireAccess [ Admin ] >=> fun next ctx -> task {
+    let! conn   = ctx.Conn
     let  userId = UserId usrId
     match! ctx.Db.TryUserByIdWithGroups userId with
     | Some user ->
-        let! groups    = ctx.Db.GroupList ()
+        let! groups    = SmallGroups.listAll conn
         let  curGroups = user.SmallGroups |> Seq.map (fun g -> shortGuid g.SmallGroupId.Value) |> List.ofSeq
         return! 
             viewInfo ctx