Copy url utils from cybozu-http-clj

README.md

@@ -19,6 +19,7 @@ They return a channel of core.async.
 - `kintone.connection` : Make connection object.
 - `kintone.types` : Type definitions such as response object.
 - `kintone.record` : kintone REST Record API.
+- `kintone.url`: kintone url utilities.
 
 ## Usage
 
@@ -118,10 +119,27 @@ You should use `Connection` object as the first argument on every API call.
       (:res res))))
 ```
 
-For more information, See [API documents](https://cljdoc.org/d/toyokumo/kintone-clj/CURRENT) and dev/test.clj.
+### url utilities
+```clojure
+(extract-base-url "https://hoge.cybozu.com/k/12")
+;; => "https://hoge.cybozu.com"
+(parse-base-url "https://hoge.kintone.com/k/12")
+;; => {:domain "kintone.com", :subdomain "hoge"}
+(valid-base-url? "https://hoge.cybozu.com/k/12")
+;; => true
+(extract-app-url "https://hoge.cybozu.com/k/12/show")
+;; => "https://hoge.cybozu.com/k/12"
+(parse-app-url "https://foo.s.cybozu.com/k/guest/11/1")
+;; => {:domain "cybozu.com", :subdomain "foo", :guest-space-id "11", :app-id "1"}
+(valid-app-url? "https://hoge.cybozu.com")
+;; => true
+```
+
+For more information, See [API documents](https://cljdoc.org/d/toyokumo/kintone-clj/CURRENT), `test/`, and `dev/test.clj`.
 
 ## dev/test.clj
-These tests actually interact with a kintone app. These are good examples of kintone-clj.
+These tests actually interact with a kintone app (not included in CI). These are good examples of the usage of kintone-clj.
+
 ### how to run
 - import dev-resources/kintone-clj-test.zip
 - fill dev-resources/config.edn
@@ -135,6 +153,7 @@ These tests actually interact with a kintone app. These are good examples of kin
 
 ## License
 
+```
 Copyright 2019 TOYOKUMO,Inc.
 
 Licensed under the Apache License, Version 2.0 (the "License");
@@ -148,3 +167,30 @@ distributed under the License is distributed on an "AS IS" BASIS,
 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 See the License for the specific language governing permissions and
 limitations under the License.
+```
+
+For src/kintone/url.cljc and test/kintone/url_test.cljc:
+
+```
+MIT License
+
+Copyright (c) 2017 ayato-p
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+```

script/cljs/test_runner.cljs

@@ -3,8 +3,10 @@
             ;; require all the namespaces that have tests in them
             [kintone.authentication-test]
             [kintone.connection-test]
-            [kintone.record-test]))
+            [kintone.record-test]
+            [kintone.url-test]))
 
 (doo-tests 'kintone.authentication-test
            'kintone.connection-test
-           'kintone.record-test)
+           'kintone.record-test
+           'kintone.url-test)

src/kintone/url.cljc

@@ -0,0 +1,156 @@
+;MIT License
+;
+;Copyright (c) 2017 ayato-p
+;
+;Permission is hereby granted, free of charge, to any person obtaining a copy
+;of this software and associated documentation files (the "Software"), to deal
+;in the Software without restriction, including without limitation the rights
+;to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+;copies of the Software, and to permit persons to whom the Software is
+;furnished to do so, subject to the following conditions:
+;
+;The above copyright notice and this permission notice shall be included in all
+;copies or substantial portions of the Software.
+;
+;THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+;IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+;FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+;AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+;LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+;OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+;SOFTWARE.
+(ns kintone.url
+  (:require [clojure.string :as str]))
+
+(def domain-list
+  ["cybozu.com"
+   "cybozu-dev.com"
+   "kintone.com"
+   "kintone-dev.com"
+   "cybozu.cn"
+   "cybozu-dev.cn"])
+
+(def ^:private re-base-url*
+  (str "^https://([a-zA-Z0-9][a-zA-Z0-9\\-]{1,30}[a-zA-Z0-9])(?:\\.s)?\\."
+       "("
+       (->> (map #(str/replace % "." "\\.") domain-list)
+            (str/join "|"))
+       ")"))
+
+(def ^:private re-base-url
+  (re-pattern re-base-url*))
+
+(defn extract-base-url
+  "
+  (extract-base-url \"https://hoge.cybozu.com\")\n=> \"https://hoge.cybozu.com\"
+  (extract-base-url \"https://hoge.cybozu.com/k/12\")\n=> \"https://hoge.cybozu.com\"\n
+  (extract-base-url \"https://foo.s.cybozu.com/k/guest/11/1\")\n=> \"https://foo.s.cybozu.com\"\n
+  (extract-base-url \"https://hoge.hoge.com/k/11\")\n=> nil
+  "
+  [url]
+  (some-> (re-find re-base-url url) first))
+
+(comment
+ (extract-base-url "https://hoge.cybozu.com")
+ (extract-base-url "https://hoge.cybozu.com/k/12")
+ (extract-base-url "https://foo.s.cybozu.com/k/guest/11/1")
+ (extract-base-url "https://hoge.hoge.com/k/11"))
+
+(defn parse-base-url
+  "
+  (parse-base-url \"https://hoge.cybozu.com\")\n=> {:domain \"cybozu.com\", :subdomain \"hoge\"}
+  (parse-base-url \"https://hoge.cybozu.com/k/12\")\n=> {:domain \"cybozu.com\", :subdomain \"hoge\"}\n
+  (parse-base-url \"https://foo.s.cybozu.com/k/guest/11/1\")\n=> {:domain \"cybozu.com\", :subdomain \"foo\"}\n
+  (parse-base-url \"https://hoge.hoge.com/k/11\")\n=> nil
+  "
+  [url]
+  (when-let [[_ subdomain domain] (re-find re-base-url url)]
+    {:domain domain
+     :subdomain subdomain}))
+
+(comment
+ (parse-base-url "https://hoge.cybozu.com")
+ (parse-base-url "https://hoge.cybozu.com/k/12")
+ (parse-base-url "https://foo.s.cybozu.com/k/guest/11/1")
+ (parse-base-url "https://hoge.hoge.com/k/11"))
+
+(defn valid-base-url?
+  "
+  (valid-base-url? \"https://hoge.cybozu.com\")\n=> true
+  (valid-base-url? \"https://hoge.cybozu.com/k/12\")\n=> true\n
+  (valid-base-url? \"https://foo.s.cybozu.com/k/guest/11/1\")\n=> true\n
+  (valid-base-url? \"https://hoge.hoge.com/k/11\")\n=> false
+  "
+  [url]
+  (not (str/blank? (extract-base-url url))))
+
+(comment
+ (valid-base-url? "https://hoge.cybozu.com")
+ (valid-base-url? "https://hoge.cybozu.com/k/12")
+ (valid-base-url? "https://foo.s.cybozu.com/k/guest/11/1")
+ (valid-base-url? "https://hoge.hoge.com/k/11"))
+
+(def ^:private re-app-url
+  (re-pattern (str re-base-url* "/k/(\\d+)")))
+
+(def ^:private re-guest-app-url
+  (re-pattern (str re-base-url* "/k/guest/(\\d+)/(\\d+)")))
+
+(defn extract-app-url
+  "
+  (extract-app-url \"https://hoge.cybozu.com\")\n=> nil\n
+  (extract-app-url \"https://hoge.cybozu.com/k/12\")\n=> \"https://hoge.cybozu.com/k/12\"\n
+  (extract-app-url \"https://foo.s.cybozu.com/k/guest/11/1\")\n=> \"https://foo.s.cybozu.com/k/guest/11/1\"\n
+  (extract-app-url \"https://hoge.hoge.com/k/11\")\n=> nil
+  "
+  [url]
+  (or (some-> (re-find re-app-url url) first)
+      (some-> (re-find re-guest-app-url url) first)))
+
+(comment
+ (extract-app-url "https://hoge.cybozu.com")
+ (extract-app-url "https://hoge.cybozu.com/k/12")
+ (extract-app-url "https://foo.s.cybozu.com/k/guest/11/1")
+ (extract-app-url "https://hoge.hoge.com/k/11"))
+
+(defn parse-app-url
+  "
+  (parse-app-url \"https://hoge.cybozu.com\")\n=> nil\n
+  (parse-app-url \"https://hoge.cybozu.com/k/12\")\n=> {:domain \"cybozu.com\", :subdomain \"hoge\", :app-id \"12\"}\n
+  (parse-app-url \"https://foo.s.cybozu.com/k/guest/11/1\")\n=> {:domain \"cybozu.com\", :subdomain \"foo\", :guest-space-id \"11\", :app-id \"1\"}\n
+  (parse-app-url \"https://hoge.hoge.com/k/11\")\n=> nil
+  "
+  [url]
+  (or
+   (when-let [[_ subdomain domain app-id] (re-find re-app-url url)]
+     {:domain domain
+      :subdomain subdomain
+      :app-id app-id})
+   (when-let [[_ subdomain domain guest-space-id app-id] (re-find re-guest-app-url url)]
+     {:domain domain
+      :subdomain subdomain
+      :guest-space-id guest-space-id
+      :app-id app-id})))
+
+(comment
+ (parse-app-url "https://hoge.cybozu.com")
+ (parse-app-url "https://hoge.cybozu.com/k/12")
+ (parse-app-url "https://foo.s.cybozu.com/k/guest/11/1")
+ (parse-app-url "https://hoge.hoge.com/k/11"))
+
+(defn valid-app-url?
+  "
+  (valid-app-url? \"https://hoge.cybozu.com\")\n=> false\n
+  (valid-app-url? \"https://hoge.cybozu.com/k/12\")\n=> true\n
+  (valid-app-url? \"https://foo.s.cybozu.com/k/guest/11/1\")\n=> true\n
+  (valid-app-url? \"https://hoge.hoge.com/k/11\")\n=> false
+  "
+  [url]
+  (some? (or (re-find re-app-url url)
+             (re-find re-guest-app-url url))))
+
+(comment
+ (valid-app-url? "https://hoge.cybozu.com")
+ (valid-app-url? "https://hoge.cybozu.com/k/12")
+ (valid-app-url? "https://foo.s.cybozu.com/k/guest/11/1")
+ (valid-app-url? "https://hoge.hoge.com/k/11"))