repo.fs

(* Copyright © 2014 G Roberts. All Rights Reserved *)

namespace MiniForum.Model

open System
open System.Threading.Tasks
open MiniForum
open MiniForum.Model
open Fredis






(*
  _   _                   ____                     
 | | | | ___   ___  _ __ |  _ \  ___  _ __    ___  
 | | | |/ __| / _ \| '__|| |_) |/ _ \| '_ \  / _ \ 
 | |_| |\__ \|  __/| |   |  _ <|  __/| |_) || (_) |
  \___/ |___/ \___||_|   |_| \_\\___|| .__/  \___/ 
                                     |_|           
*)
[<Sealed>]
type UserRepo (db: Connection) = class
    let _db = db;

    member x.Get (guid: string) = 
        assert User.IsValidGuid(guid)        
        async {        
            if guid = null then return None
            else    
                let! user_json = !!_db.Hashes.Get(1, "User", guid)
                return match user_json with
                       | null -> None
                       | _ -> User.fromJSON user_json |> Some
        }


    member x.Get (guid_list: string array) =  
        assert (guid_list.Length > 0)
        async {
            let! json_list = !!_db.Hashes.Get(1, "User", guid_list)
            return [| for json in json_list do
                        yield match json with
                              | null -> None
                              | _ -> User.fromJSON(json) |> Some |]
        }


    member x.Save (user: User) =
        assert User.IsValidGuid(user.Guid)
        async {   
            let! user_exists = !!_db.Hashes.Exists(1, "User", user.Guid)
            if user_exists then
                let! did_set = _db.Hashes.Set(1, "User", user.Guid, user.toJSON())    
                               |> Async.AwaitTask
                (* false = key was overwritten... *)
                return did_set = false
            else
                return false
        }
    

    member x.Create (user: User) =
        assert (user.Guid = null)
        (* Users are assigned a random GUID on creation *)    
        let rec trycreate (user: User) = async {        
            user.Guid <- "U" + GUID.Random(10)
            let! was_created = !!_db.Hashes.SetIfNotExists(1, "User", user.Guid, user.toJSON())
            if was_created then return user
            else return! trycreate user
        }
        trycreate user


    (* Delete a user *)
    member x.Delete (guid: string) = 
        assert User.IsValidGuid(guid)        
        _db.Hashes.Remove(1, "User", guid)
        |> Async.AwaitTask


    member x.Delete (user: User) =
        x.Delete user.Guid
end






(*
  _____              _        ____                     
 |_   _|___   _ __  (_)  ___ |  _ \  ___  _ __    ___  
   | | / _ \ | '_ \ | | / __|| |_) |/ _ \| '_ \  / _ \ 
   | || (_) || |_) || || (__ |  _ <|  __/| |_) || (_) |
   |_| \___/ | .__/ |_| \___||_| \_\\___|| .__/  \___/ 
             |_|                         |_|           
*)
[<Sealed>]
type TopicRepo (db: Connection) = class
    let _db = db

    member x.Create (topic: Topic) =
        assert (topic.Guid = null)
        (* Topics are assigned a random GUID on creation *)
        let rec trycreate (topic: Topic) = async {        
            topic.Guid <- "T" + GUID.Random(10)
            if topic.Created.IsNone then
                topic.Created <- DateTime.UtcNow |> Some
            let! was_created = !!_db.Hashes.SetIfNotExists(1, "Topic", topic.Guid, topic.toJSON())
            if was_created then                
                (* XXX: the transaction could fail, gotta re-try the transaction until it returns true *)
                do! using (_db.CreateTransaction()) (fun tx ->
                    tx.Hashes.Set(1, "Topics_PostCount", topic.Guid, "0") |> ignore
                    tx.SortedSets.Add(1, "Topics_Timestamp", topic.Guid, topic.Timestamp) |> ignore
                    tx.SortedSets.Add(1, "Topics_Created", topic.Guid, topic.Timestamp) |> ignore
                    tx.Execute() |> Async.AwaitTask |> Async.Ignore
                )
                return topic
            else
                return! trycreate topic
        }
        trycreate topic


    member x.Get (guid: string) =
        assert Topic.IsValidGuid(guid)
        async {                     
            if guid = null then return None
            else
                let! json = !!_db.Hashes.Get(1, "Topic", guid.ToUpper())
                return match json with
                       | null -> None
                       | _ -> Topic.fromJSON json |> Some
        }
    member x.Get (guid: string option) =
        async {        
            match guid with
            | None -> return None
            | Some value -> return! x.Get(value)
        }


    (*
     * Retrieve one or more topics
     *)
    member x.Get (guid_list: string array) =
        assert (guid_list.Length > 0)
        async {
            let! json_list = !!_db.Hashes.Get(1, "Topic", guid_list)
            return [| for json in json_list do
                        yield match json with
                              | null -> None
                              | _ -> Topic.fromJSON(json) |> Some |]
        }


    (*
     * Removes the topic and all posts
     *)     
    member x.Delete (guid: string) =   
        assert Topic.IsValidGuid(guid)
        async {        
            let posts_key = "Topic_" + guid + "_Posts"
            let! guid_score_pairs = !!_db.SortedSets.RangeString(1, posts_key, 0L, -1L)
            return! using (_db.CreateTransaction()) (fun tx ->
                tx.Keys.Remove(1, posts_key) |> ignore
                tx.SortedSets.Remove(1, "Topics_Timestamp", guid) |> ignore
                tx.SortedSets.Remove(1, "Topics_Created", guid) |> ignore
                tx.Hashes.Remove(1, "Topic", guid) |> ignore
                tx.Hashes.Remove(1, "Topics_LatestPost", guid) |> ignore
                tx.Hashes.Remove(1, "Topics_PostCount", guid) |> ignore
                if guid_score_pairs.Length > 0 then
                    let posts_guid_list = [| for KeyValue(guid,_) in guid_score_pairs -> guid |]            
                    tx.Hashes.Remove(1, posts_key, posts_guid_list) |> ignore
                tx.Execute() |> Async.AwaitTask
            )
        }

    member x.Delete (topic: Topic) =
        topic.Guid |> x.Delete

    (*
     * Ensure that there are at most N topics
     * Topics which have been updated recently are more likely to be kept
     *)
    member x.GarbageCollect (maxTopics: int) =
        assert (maxTopics > 0)
        async {        
            let! guid_list = !!_db.SortedSets.RangeString(1, "Topics_Timestamp", int64(maxTopics), -1L, false)

            (* XXX: could be made parallel? *)
            for KeyValue(guid, _) in guid_list do
                x.Delete(guid)
                |> Async.Ignore
                |> Async.RunSynchronously

            return guid_list.Length
        }

    (*
     * Retrieve a slice of N topics on the site in ascending or descending order
     *)
    member private x.Slice (table: string, offset: int64, limit: int64, ascending: bool) =
        assert (offset > 0L)
        assert (limit > 0L)
        async {        
            let! guid_score_pair = !!_db.SortedSets.RangeString(1, table, offset, offset + (limit - 1L), ascending)
            return! [| for KeyValue(guid,_) in guid_score_pair -> guid |] |> x.Get
        }

    (* Descending Order, newest first, top N *)
    member x.NewestByCreation (offset: int64, limit: int64) =
        x.Slice("Topics_Created", offset, limit, false)

    (* Ascending Order, oldest first, bottom N *)
    member x.OldestByCreation (offset: int64, limit: int64) =
        x.Slice("Topics_Created", offset, limit, true)


    (* Total number of Topics on the whole site *)
    member x.Count () =
        async {
            return! !!_db.Hashes.GetLength(1, "Topic")
        }


    member x.PostCounts (topic_guids: string array) =
        async {
            let! counts = !!_db.Hashes.GetString(1, "Topics_PostCount", topic_guids)
            let makeint (count: string) =
                if count = null then 0
                else try Convert.ToInt32(count)
                     with ex -> 0
            return [| for count in counts -> makeint(count) |]
        }



    (* How many posts exist within a topic? *)
    member x.PostCount (topic_guid: string) =
        assert Topic.IsValidGuid(topic_guid)
        async {
            let! postcount = !!_db.Hashes.Get(1, "Topics_PostCount", topic_guid)
            return match postcount with
                   | null -> 0
                   | _ -> postcount
                          |> System.Text.Encoding.ASCII.GetString
                          |> Convert.ToInt32
        }


    member x.PostCount(topic: Topic) =
        x.PostCount(topic.Guid)


    member x.LatestPostGuids (topic_guids: string array) =
        assert (topic_guids.Length > 0)
        async {
            let! guids = !!_db.Hashes.GetString(1, "Topics_LatestPost", topic_guids)
            return [| for guid in guids ->
                        match guid with
                        | null -> None
                        | _ -> guid |> Some |]
        }
end





(*
  ____              _    ____                     
 |  _ \  ___   ___ | |_ |  _ \  ___  _ __    ___  
 | |_) |/ _ \ / __|| __|| |_) |/ _ \| '_ \  / _ \ 
 |  __/| (_) |\__ \| |_ |  _ <|  __/| |_) || (_) |
 |_|    \___/ |___/ \__||_| \_\\___|| .__/  \___/ 
                                    |_|           
*)
[<Sealed>]
type PostRepo (db : Connection) = class
    let _db = db

    (* Creates a post with a random GUID
     * Also maintains indexes for:
     * - When topics were last updated
     * - Latest posts for topics
     *)
    member x.Create (post: Post) =
        assert (post.Guid = null)
        assert Topic.IsValidGuid(post.Topic)
        let posts_key = "Topic_" + post.Topic + "_Posts"
        if post.Created.IsNone then
            post.Created <- DateTime.UtcNow |> Some
        let rec trycreate (post: Post) = async {
            post.Guid <- "P" + GUID.Random(10)
            let! was_created = !!_db.Hashes.SetIfNotExists(1, "Post", post.Guid, post.toJSON())
            if was_created then
                (* Update indexes and counters for topic & site *)
                using (_db.CreateTransaction()) (fun tx ->
                    tx.SortedSets.Add(1, posts_key, post.Guid, post.Timestamp) |> ignore
                    tx.SortedSets.Add(1, "Topics_Timestamp", post.Topic, post.Timestamp) |> ignore
                    tx.SortedSets.Add(1, "Posts_Timestamp", post.Guid, post.Timestamp) |> ignore
                    tx.Hashes.Increment(1, "Topics_PostCount", post.Topic) |> ignore
                    tx.Hashes.Set(1, "Topics_LatestPost", post.Topic, post.Guid) |> ignore
                    tx.Execute() |> Async.AwaitTask |> Async.Ignore |> Async.RunSynchronously
                )
                return post
            else return! trycreate post
        }
        trycreate post


    (* Get a single User object *)
    member x.Get (guid: string) =
        assert Post.IsValidGuid(guid)
        async {        
            if guid = null then return None
            else
                let! post_json = !!_db.Hashes.Get(1, "User", guid.ToUpper()) in
                return match post_json with
                       | null -> None
                       | _ -> Post.fromJSON post_json
                              |> Some
        }


    (* Retrieve an array of Posts *)
    member x.Get (guids: string array) =
        async {
            let! post_jsons = !!_db.Hashes.Get(1, "Post", guids) in
            return [| for json in post_jsons do
                        yield match json with
                              | null -> None
                              | _ -> Post.fromJSON(json) |> Some |]
        }    


    (* Retrieve a slice of N posts made across any topic in ascending or descending order *)
    member private x.Slice (offset: int64, limit: int64, ascending: bool) =
        assert (offset > 0L)
        assert (limit > 0L)
        async {        
            let! guid_score_pair = !!_db.SortedSets.RangeString(1, "Posts_Timestamp", offset, offset + (limit - 1L), ascending)
            return! [| for KeyValue(guid,_) in guid_score_pair -> guid |] |> x.Get
        }


    (* Descending Order, newest first, top N *)
    member x.Newest (offset: int64, limit: int64) =
        x.Slice(offset, limit, false)

    (* Ascending Order, oldest first, bottom N *)
    member x.Oldest (offset: int64, limit: int64) =
        x.Slice(offset, limit, true)

    member x.Count () =
        async {
            return! !!_db.SortedSets.GetLength(1, "Posts_Timestamp")
        }

    member x.Delete (post: Post) =
        x.Delete(post.Guid, post.Topic)
    member x.Delete (post_guid: string, topic_guid: string) =
        (*
         * XXX: do we need to update the LatestPost for the Topic?
         * Should be optional if we're doing bulk deletes?
         *)
        assert (Post.IsValidGuid(post_guid))
        assert (Topic.IsValidGuid(topic_guid))
        let posts_key = "Topic_" + topic_guid + "_Posts"
        async {
            return! using (_db.CreateTransaction()) (fun tx ->
                tx.Hashes.Remove(1, "Post", post_guid) |> ignore
                tx.Hashes.Increment(1, "Topics_PostCount", topic_guid, -1) |> ignore
                tx.SortedSets.Remove(1, posts_key, post_guid) |> ignore
                tx.SortedSets.Remove(1, "Posts_Timestamp", post_guid) |> ignore
                tx.Execute() |> Async.AwaitTask
            )
        }   


    (* Retrieve a slice of N posts on a topic in ascending or descending order *)
    member x.SliceByTopic (topic_guid: string, offset: int64, limit: int64, ascending: bool) =
        assert (offset >= 0L)
        assert (limit > 0L)
        assert Topic.IsValidGuid(topic_guid)
        let posts_key = "Topic_" + topic_guid + "_Posts"
        async {        
            let! guid_score_pair = !!_db.SortedSets.RangeString(1, posts_key, offset, offset + (limit - 1L), ascending)
            return! [| for KeyValue(guid,_) in guid_score_pair -> guid |] |> x.Get
        }


    (* Descending order, newest first, top N *)
    member x.NewestByTopic (topic: Topic, offset: int64, limit: int64) =
        x.SliceByTopic (topic.Guid, offset, limit, false)
    member x.NewestByTopic (topic_guid: string, offset: int64, limit: int64) =
        x.SliceByTopic (topic_guid, offset, limit, false)


    (* Ascending order, oldest first, bottom N *)
    member x.OldestByTopic (topic: Topic, offset: int64, limit: int64) =
        x.SliceByTopic (topic.Guid, offset, limit, true)    
    member x.OldestByTopic (topic_guid: string, offset: int64, limit: int64) =
        x.SliceByTopic (topic_guid, offset, limit, true)    
end







(*
  _____                                ___                            _                 
 |  ___|___   _ __  _   _  _ __ ___   / _ \ __   __ ___  _ __ __   __(_)  ___ __      __
 | |_  / _ \ | '__|| | | || '_ ` _ \ | | | |\ \ / // _ \| '__|\ \ / /| | / _ \\ \ /\ / /
 |  _|| (_) || |   | |_| || | | | | || |_| | \ V /|  __/| |    \ V / | ||  __/ \ V  V / 
 |_|   \___/ |_|    \__,_||_| |_| |_| \___/   \_/  \___||_|     \_/  |_| \___|  \_/\_/  
                                                                                        
*)
type ForumOverview = {
    Topic: Topic;
    (* Owner may have been deleted *)
    Owner: User option;
    PostCount: int;
    (* Post may have been deleted *)
    Post: Post option;
    (* Post or Post's.Owner may have been deleted *)
    PostOwner: User option;
}








(*
  ____     _     ___  
 |  _ \   / \   / _ \ 
 | | | | / _ \ | | | |
 | |_| |/ ___ \| |_| |
 |____//_/   \_\\___/ 

*)
[<Sealed>]
type DAO () = class
    static let _redis = new Connection("localhost", allowAdmin=true)    
    static let _user = new UserRepo(_redis)
    static let _topic = new TopicRepo(_redis)
    static let _post = new PostRepo(_redis)

    static member User = _user
    static member Topic = _topic
    static member Post = _post

    static member FlushDB () = 
        !~!_redis.Server.FlushDb(10)

    static member Overview (topics : Topic array) =
        async {
            let topic_guids = [| for topic in topics -> topic.Guid |]
            let topic_owner_guids = [| for topic in topics -> topic.Owner |]

            (* Start tasks to retrieve everything we can get from the topics concurrently *)
            let! featured_post_guids_task = _topic.LatestPostGuids(topic_guids) |> Async.StartChild
            let! topic_owners_task = _user.Get(topic_owner_guids) |> Async.StartChild
            let! topic_postcounts_task = _topic.PostCounts(topic_guids) |> Async.StartChild

            let! featured_post_guids = featured_post_guids_task
            let! featured_posts = _post.Get([| for post_guid in featured_post_guids do
                                                    if post_guid.IsSome then
                                                        yield post_guid.Value |])
            
            (* If any of the posts are missing then there will be sections of the post owners list missing *)
            let! featured_owners = _user.Get([| for post in featured_posts do
                                                    if post.IsSome then
                                                        yield post.Value.Owner |])

            let! topic_owners = topic_owners_task
            let! topic_postcounts = topic_postcounts_task

            (* featured_post_guids may have None's
             * featured_posts will have missing items relating to None's in featured_post_guids
             * featured_owners will have missing items relating to missing items in featured_posts
             *
             * Somehow we have to output ForumOverview records with everything matched up
             *)
            let rec outputfn (result, n, fp_offset, fo_offset) =
                if n >= topics.Length then result
                else
                    let mutable new_fp_offset = fp_offset
                    let mutable has_fp = featured_post_guids.[fp_offset].IsSome = true
                    if has_fp = false then
                        new_fp_offset <- new_fp_offset - 1

                    let mutable new_fo_offset = fo_offset
                    let mutable has_fo = has_fp && featured_owners.[fo_offset].IsSome = true
                    if has_fo = false then
                        new_fo_offset <- new_fo_offset - 1

                    let record = {
                        Topic = topics.[n];
                        Owner = topic_owners.[n];
                        PostCount = topic_postcounts.[n];
                        Post = if has_fp then featured_posts.[fp_offset] else None;
                        PostOwner = if has_fo then featured_owners.[fo_offset] else None;
                    }

                    outputfn (result @ [record], n + 1, new_fp_offset + 1, new_fo_offset + 1)

            return outputfn ([], 0, 0, 0)
        }
end