Use concurrent dictionary directly in RemoteDownload - references #1101

RELEASE_NOTES.md

@@ -1,3 +1,6 @@
+#### 2.5.4 - 01.10.2015
+* COSMETICS: Cache calls to GitHub in order to reduce stress on API limit - https://github.com/fsprojects/Paket/issues/1101
+
 #### 2.5.3 - 30.09.2015
 * PERFORMANCE: Run all calls against different NuGet protocols in parallel and take the fastest - https://github.com/fsprojects/Paket/issues/1085
 

src/Paket.Core/RemoteDownload.fs

@@ -8,21 +8,43 @@ open Paket.ModuleResolver
 open System.IO.Compression
 open Paket.Domain
 
+let private githubCache = System.Collections.Concurrent.ConcurrentDictionary<_, _>()
+let private lookupDocument (auth,url : string)  = async {
+    let key = auth,url
+    match githubCache.TryGetValue key with
+    | true, document -> return document
+    | _ ->
+        let! document = safeGetFromUrl(auth, url, null)
+        githubCache.TryAdd(key, document) |> ignore
+        return document
+    }
+
 // Gets the sha1 of a branch
 let getSHA1OfBranch origin owner project branch = 
     async { 
+        let key = origin,owner,project,branch
         match origin with
         | ModuleResolver.SingleSourceFileOrigin.GitHubLink -> 
             let url = sprintf "https://api.github.com/repos/%s/%s/commits/%s" owner project branch
-            let! document = getFromUrl(None, url, null)
-            let json = JObject.Parse(document)
-            return json.["sha"].ToString()
-        | ModuleResolver.SingleSourceFileOrigin.GistLink ->  
+            let! document = lookupDocument(None,url)
+            match document with
+            | Some document ->
+                let json = JObject.Parse(document)
+                return json.["sha"].ToString()
+            | None -> 
+                failwithf "Could not find hash for %s" url
+                return ""
+        | ModuleResolver.SingleSourceFileOrigin.GistLink ->
             let url = sprintf "https://api.github.com/gists/%s/%s" project branch
-            let! document = getFromUrl(None, url, null)
-            let json = JObject.Parse(document)
-            let latest = json.["history"].First.["version"]
-            return latest.ToString()
+            let! document = lookupDocument(None,url)
+            match document with
+            | Some document ->
+                let json = JObject.Parse(document)
+                let latest = json.["history"].First.["version"]
+                return latest.ToString()
+            | None -> 
+                failwithf "Could not find hash for %s" url
+                return ""
         | ModuleResolver.SingleSourceFileOrigin.HttpLink _ -> return ""
     }
 
@@ -51,10 +73,10 @@ let downloadDependenciesFile(rootPath,groupName,parserF,remoteFile:ModuleResolve
                 |> Option.map (fun (un, pwd) -> { Username = un; Password = pwd })
             auth, url
 
-    let! result = safeGetFromUrl(auth,url,null)
+    let! result = lookupDocument(auth,url)
 
     match result with
-    | Some text when parserF text ->        
+    | Some text when parserF text ->
         let destination = remoteFile.ComputeFilePath(rootPath,groupName,dependenciesFileName)
 
         Directory.CreateDirectory(destination |> Path.GetDirectoryName) |> ignore

src/Paket.Core/Utils.fs

@@ -99,7 +99,7 @@ let inline createRelativePath root path =
         else root
 
     let uri = Uri(basePath)
-    uri.MakeRelativeUri(Uri(path)).ToString().Replace("/", "\\").Replace("%20", " ")  
+    uri.MakeRelativeUri(Uri(path)).ToString().Replace("/", "\\").Replace("%20", " ")
 
 let extractPath infix (fileName : string) : string option=
     let path = fileName.Replace("\\", "/").ToLower()
@@ -196,12 +196,6 @@ let inline createWebClient(url,auth:Auth option) =
     client.Proxy <- getDefaultProxyFor url
     client
 
-//More generic variant of http://www.fssnip.net/c4
-open System.Collections.Concurrent
-
-let cache = ConcurrentDictionary<(string * obj), Lazy<obj>>()
-let memoizeConcurrent (caller : string) (f : 'a -> 'b) = 
-    fun (x : 'a) -> (cache.GetOrAdd((caller, x |> box), lazy ((f x) |> box)).Force() |> unbox) : 'b
 
 #nowarn "40"
 
@@ -212,14 +206,10 @@ open System.Threading
 let downloadFromUrl (auth:Auth option, url : string) (filePath: string) =
     async {
         try
-            let memoized = 
-                memoizeConcurrent "downloadFromUrl" (fun (a, u) p ->
-                    use client = createWebClient(u,a)
-                    client.DownloadFileTaskAsync(Uri(u), p) |> Async.AwaitTask
-                )
-            let task = memoized (auth,url) filePath
-            do! task
+            use client = createWebClient(url,auth)
 
+            let task = client.DownloadFileTaskAsync(Uri(url), filePath) |> Async.AwaitTask
+            do! task
         with
         | exn ->
             failwithf "Could not download from %s%s Message: %s" url Environment.NewLine exn.Message
@@ -229,13 +219,10 @@ let downloadFromUrl (auth:Auth option, url : string) (filePath: string) =
 let getFromUrl (auth:Auth option, url : string, contentType : string) =
     async { 
         try
-            let memoized = memoizeConcurrent "getFromUrl" (fun (a, u, c) ->
-                    use client = createWebClient(u,a)
-                    if notNullOrEmpty c then
-                        client.Headers.Add(HttpRequestHeader.Accept, c)
-                    client.DownloadStringTaskAsync(Uri(u)) |> Async.AwaitTask
-                )
-            let s = memoized(auth, url, contentType)
+            use client = createWebClient(url,auth)
+            if notNullOrEmpty contentType then
+                client.Headers.Add(HttpRequestHeader.Accept, contentType)
+            let s = client.DownloadStringTaskAsync(Uri(url)) |> Async.AwaitTask
             return! s
         with
         | exn -> 
@@ -246,19 +233,16 @@ let getFromUrl (auth:Auth option, url : string, contentType : string) =
 let getXmlFromUrl (auth:Auth option, url : string) =
     async { 
         try
-          let memoized = memoizeConcurrent "getXmlFromUrl" (fun (a,u) ->
-            use client = createWebClient(u,a)
+            use client = createWebClient(url,auth)
 
             // mimic the headers sent from nuget client to odata/ endpoints
             client.Headers.Add(HttpRequestHeader.Accept, "application/atom+xml, application/xml")
             client.Headers.Add(HttpRequestHeader.AcceptCharset, "UTF-8")
             client.Headers.Add("DataServiceVersion", "1.0;NetFx")
             client.Headers.Add("MaxDataServiceVersion", "2.0;NetFx")
 
-            client.DownloadStringTaskAsync(Uri(u)) |> Async.AwaitTask
-          )
-          let s = memoized(auth, url) 
-          return! s
+            let s = client.DownloadStringTaskAsync(Uri(url)) |> Async.AwaitTask
+            return! s
         with
         | exn -> 
             failwithf "Could not retrieve data from %s%s Message: %s" url Environment.NewLine exn.Message
@@ -269,16 +253,14 @@ let getXmlFromUrl (auth:Auth option, url : string) =
 let safeGetFromUrl (auth:Auth option, url : string, contentType : string) =
     async { 
         try 
-          let memoized = memoizeConcurrent "safeGetFromUrl" (fun (a,u,c) ->
-            use client = createWebClient(u,a)
+            use client = createWebClient(url,auth)
 
-            if notNullOrEmpty c then
-                client.Headers.Add(HttpRequestHeader.Accept, c)
+            if notNullOrEmpty contentType then
+                client.Headers.Add(HttpRequestHeader.Accept, contentType)
 
-            client.DownloadStringTaskAsync(Uri(u)) |> Async.AwaitTask
-          )
-          let! raw =  memoized(auth, url, contentType)
-          return Some raw
+            let s = client.DownloadStringTaskAsync(Uri(url)) |> Async.AwaitTask
+            let! raw = s
+            return Some raw
         with _ -> return None
     }