Failed type check

build.boot

;-*- mode: Clojure;-*-
(set-env!
 ;;:source-paths #{"src"}
 :repositories {"clojars.org" "https://clojars.org/repo/"
                "central" "http://repo1.maven.org/maven2/"
                "sonatype-oss-public" "https://oss.sonatype.org/content/groups/public/"}
 :dependencies '[[org.clojure/clojure "1.7.0-alpha4"]
                 [sonian/carica "1.1.0" :exclusions [cheshire]]
                 [environ "1.0.0"]
                 [clj-time "0.9.0"]
                 [com.taoensso/timbre "3.3.1" :exclusions [com.taoensso/carmine]]
                 [org.zeromq/jeromq "0.3.4"]
                 [org.zeromq/cljzmq "0.1.5-SNAPSHOT" :exclusions [org.zeromq/jzmq]]
                 [com.taoensso/nippy "2.7.1" :exclusions [com.taoensso/encore]]
                 [cc.qbits/nippy-lz4 "0.1.0"]
                 [org.clojure/core.async "0.1.346.0-17112a-alpha"]
                 [org.clojure/core.match "0.3.0-alpha4"]
                 [org.clojure/core.typed "0.2.77"]
                 [com.stuartsierra/component "0.2.2"]

                 [boot-deps "0.1.2" :scope "test"]
                 [zilti/boot-midje "0.0.1-SNAPSHOT" :scope "test"]
                 [zilti/boot-typed "0.1.0" :scope "test"]
                 [midje "1.6.3" :scope "test"]])

(require '[boot.pod :as pod]
         '[boot.core :as core]
         '[clojure.java.io :as io]
         '[zilti.boot-midje :refer [midje]]
         '[zilti.boot-typed :refer [typed]])

(def +version+ "0.0.5-SNAPSHOT")

(task-options!
 pom {:project 'rag-frontend
      :version +version+
      :description "The RAG Frontend."
      :url "https://bitbucket.com/zilti/rag-frontend"
      :scm {:url "https://bitbucket.com/zilti/rag-frontend"}
      :license {:name "Eclipse Public License"
                :url "http://www.eclipse.org/legal/epl-v10.html"}})

(def sub-dependencies
  {:client '[]
   :server '[[com.mchange/c3p0 "0.9.2.1"]
             [clojurewerkz/scrypt "1.2.0"]
             [org.postgresql/postgresql "9.2-1004-jdbc41"]]})

(deftask prepare-server
  "Prepares the server part for further tasks."
  []
  (set-env! :source-paths #{"server/src"}
            :dependencies #(into % (:server sub-dependencies)))
  
  (task-options! midje {:test-path #{"server/test"}}
                 typed {:namespaces #{'server.core 'server.util}}
                 jar {:main 'server.core})
  
  (with-pre-wrap fileset
    (add-source fileset (io/file "server/src"))))

(deftask prepare-client
  "Prepares the client part for further tasks."
  []
  (set-env! :source-paths #{"client/src"}
            :dependencies #(into % (:client sub-dependencies)))
  
  (task-options! midje {:test-path #{"client/test"}}
                 jar {:main 'client.core})
  
  (with-pre-wrap fileset
    (add-source fileset (io/file "client/src"))))

core.clj

(ns server.core
  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send])
  (:require [zeromq.zmq :as zmq]
            [taoensso.nippy :as nippy]
            [qbits.nippy-lz4 :refer [lz4-compressor lz4hc-compressor]]
            [clj-time.core :as joda]
            [clojure.string :as str]
            [clojure.core.async :refer [put! <! >! <!! >!!] :as async]
            [com.stuartsierra.component :as component]
            [server.util :as util]
            [clojure.core.typed :refer :all]
            [clojure.core.typed.unsafe :refer [ignore-with-unchecked-cast]]
            [clojure.core.typed.async :refer [go chan go-loop Chan]]
            [server.externs :refer :all])
  (:gen-class))

(defalias HandlerComp
  (HMap :mandatory {:active-users (Atom1 (Map Int (Chan Any)))
                    :actions (Atom1 (Map Keyword Any))
                    :sender Sender}))

(defalias ZeroMQMessage
  (HMap :mandatory {:id Int
                    :msg (HMap :mandatory {:action Keyword
                                           :data (Map Any Any)})}))

(declare-datatypes Sender)

(ann-record Handler [sender :- Sender])
(defrecord Handler [sender]
  component/Lifecycle
  (start [component]
    (info "Starting handler")
    ;; (merge component
    ;;        {:active-users (atom {})
    ;;         :actions (atom {})
    ;;         :sender sender})
    component)
  (stop [component]
    (info "Stopping handler")
    (assert ((pred ZeroMQMessage) component))
    (doseq [[k v] @(:active-users component)] ;; <=
      (put! (sender :queue) {:id k
                             :msg {:action :disconnect
                                   :data {:reason :shutdown}}})
      (async/close! v))
    component))

;; (ann create-user-loop [Sender Int -> (Chan ZeroMQMessage)])
;; (defn create-user-loop [sender id]
;;   (let [channel :- (Chan ZeroMQMessage) (chan)]
;;     (go-loop [{:keys [id msg] :as packet} (<! channel)]
;;       "Do stuff with the message"
;;       (if-let [item (<! channel)]
;;         (recur item)
;;         (debug "Ended user loop for" id)))
;;     channel))

;; (ann verify-or-forward [HandlerComp ZeroMQMessage -> Any])
;; (defn verify-or-forward [{:keys [sender] :as handler} {:keys [id msg] :as packet}]
;;   (if-let [user (-> handler :active-users id)]
;;     (async/put! user packet)
;;     (if "authenticated"
;;       (do
;;         (swap! handler assoc-in [:active-users id] (create-user-loop id))
;;         (put! (:queue sender) {:id id
;;                                :msg {:action :authentication
;;                                      :data {:result :success}}}))
;;       (put! (:queue sender) {:id id
;;                              :msg {:action :authentication
;;                                    :data {:result :failure}}}))))

(declare-datatypes Socket)
(defalias SocketComp "An extended Socket type."
  (I Socket
     (HMap :mandatory {:socket org.zeromq.ZMQ$Socket
                       :context org.zeromq.ZMQ$Context})))

(ann-record Socket)
(defrecord Socket []
  component/Lifecycle
  (start [component]
    (info "Starting socket")
    (let [context :- org.zeromq.ZMQ$Context (zmq/context 1)
          socket :- org.zeromq.ZMQ$Socket (zmq/socket context :router)
          component :- SocketComp (ignore-with-unchecked-cast (assoc component
                                                                     :socket socket
                                                                     :context context) SocketComp) ;; TODO
          server-address (util/config :server :address)]
      (assert (string? server-address))
      (try (zmq/bind socket server-address)
           (catch org.zeromq.ZMQException ex (fatal ex)))
      component))
  (stop [component]
    (info "Stopping socket")
    (let [socket (tc-ignore (get component :socket))] ;; TODO
      (assert (instance? org.zeromq.ZMQ$Socket socket))
      (zmq/close socket))
    component))

(ann receive [org.zeromq.ZMQ$Socket -> ZeroMQMessage])
(defn receive [socket]
  (let [[id :- Int data :- Any] (zmq/receive-all socket)]
    {:id id
     :msg (nippy/thaw data {:compressor (tc-ignore lz4-compressor)})})) ;; TODO

(ann send [SocketComp ZeroMQMessage -> Any])
(defn send [socket msg]
  (let [{:keys [id msg]} msg]
    (zmq/send (:socket socket) id zmq/send-more)
    (zmq/send (:socket socket) (nippy/freeze msg {:compressor (tc-ignore lz4-compressor)}))))

;; (ann receive-loop [Socket Handler (Atom1 Boolean) -> Any])
;; (defn receive-loop [socket handler condition]
;;   (while @condition
;;     (Thread/sleep 10)
;;     (let [incoming (receive (:socket socket))]
;;       (trace "Received message" incoming)
;;       (verify-or-forward handler incoming))))

(declare-datatypes Sender)
(defalias SenderComp "An extended Sender type."
  (I Sender
     (HMap :mandatory {:queue (Chan ZeroMQMessage)})))

(ann-record Sender [socket :- SocketComp])
(defrecord Sender [socket]
  component/Lifecycle
  (start [component]
    (info "Starting sender")
    (let [queue :- (Chan ZeroMQMessage) (chan 5)]
      (go-loop [input :- (U nil ZeroMQMessage) (<! queue)]
        (assert input)
        (send socket input)
        (if-let [input (<! queue)]
          (recur input)))
      (ignore-with-unchecked-cast (assoc component :queue queue) SenderComp))) ;; TODO
  (stop [component]
    (info "Stopping sender")
    (let [queue (tc-ignore (get component :queue))] ;; TODO
      (assert (instance? clojure.core.async.impl.channels.ManyToManyChannel queue))
      (async/close! queue))
    component))

;; (ann-record Receiver [socket :- Socket handler :- Handler])
;; (defrecord Receiver [socket handler]
;;   component/Lifecycle
;;   (start [component] :- (Map Keyword Any)
;;     (info "Starting receiver")
;;     (let [condition (atom true)
;;           runnable (future (receive-loop socket handler condition))]
;;       (-> component
;;          (assoc :condition condition)
;;          (assoc :runnable runnable))))
;;   (stop [component] :- (Map Keyword Any)
;;     (info "Stopping receiver")
;;     (reset! (:condition component) false)
;;     component))

externs.clj

(ns server.externs
  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for])
  (:require [clojure.core.typed :refer :all]
            [com.stuartsierra.component :as component]
            taoensso.timbre
            clojure.edn
            carica.core
            environ.core
            [zeromq.zmq :as zmq]))

(import 'com.stuartsierra.component.Lifecycle)
(ann-protocol [[a :variance :covariant :< com.stuartsierra.component.Lifecycle]
               [b :variance :covariant :< a]]
              component/Lifecycle
              start
              [component/Lifecycle -> a]
              stop
              [a -> b])

(ann ^:no-check zeromq.zmq/context [Int -> org.zeromq.ZMQ$Context])
(ann ^:no-check zeromq.zmq/socket [org.zeromq.ZMQ$Context Keyword -> org.zeromq.ZMQ$Socket])
(ann ^:no-check zeromq.zmq/bind [org.zeromq.ZMQ$Socket String -> org.zeromq.ZMQ$Socket])
(ann ^:no-check zeromq.zmq/unbind [org.zeromq.ZMQ$Socket String -> org.zeromq.ZMQ$Socket])
(ann ^:no-check zeromq.zmq/close [org.zeromq.ZMQ$Socket -> Any])
(ann ^:no-check zeromq.zmq/receive-all [org.zeromq.ZMQ$Socket -> (HVec [Int Any])])
(ann ^:no-check zeromq.zmq/send [org.zeromq.ZMQ$Socket Any * -> Any])

(ann ^:no-check clojure.edn/read-string [String -> Any])

(ann ^:no-check carica.core/config [Keyword * -> Any])

(ann ^:no-check environ.core/env [Keyword -> String])

(ann ^:no-check taoensso.nippy/thaw [Any (Map Keyword Any) -> (HMap :mandatory {:action Keyword, :data (Map Any Any)})]) ;; TODO
(ann ^:no-check taoensso.nippy/freeze [(HMap :mandatory {:action Keyword :data (Map Any Any)}) (Map Keyword Any) -> Any])

(ann ^:no-check taoensso.timbre/refer-timbre [-> Any])
(ann trace [Any * -> Any])
(defn trace [& args] (tc-ignore (eval `(taoensso.timbre/trace ~@args))))
(ann debug [Any * -> Any])
(defn debug [& args] (tc-ignore (eval `(taoensso.timbre/debug ~@args))))
(ann info [Any * -> Any])
(defn info [& args] (tc-ignore (eval `(taoensso.timbre/info ~@args))))
(ann warn [Any * -> Any])
(defn warn [& args] (tc-ignore (eval `(taoensso.timbre/warn ~@args))))
(ann error [Any * -> Any])
(defn error [& args] (tc-ignore (eval `(taoensso.timbre/error ~@args))))
(ann fatal [Any * -> Any])
(defn fatal [& args] (tc-ignore (eval `(taoensso.timbre/fatal ~@args))))

util.clj

(ns server.util
  (:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send])
  (:require [carica.core :as carica]
            [environ.core :as environ]
            [clojure.string :as str]
            [clojure.edn :as edn]
            [clojure.core.typed :refer :all]
            [server.externs :refer :all]))

(ann config [Keyword * -> Any])
(defn config [& keys]
  (let [env-var (->> keys
                     (map name)
                     (str/join "-")
                     keyword)]
    (info env-var "=>" (or (environ/env env-var) (apply carica/config keys)))
    (or (edn/read-string (environ/env env-var)) (apply carica/config keys))))

(ann remove-nilkeys [(Map (U Any nil) Any) -> (Map Any Any)])
(defn remove-nilkeys [m]
  (loop [mkeys :- (clojure.lang.Seqable Any) (keys m)
         new-m :- (Map Any Any) {}]
    (if (empty? mkeys)
      new-m
      (recur (rest mkeys)
             (if (nil? (get m (first mkeys)))
               new-m
               (assoc new-m (first mkeys) (get m (first mkeys))))))))

(ann ^:no-check keywordify-keys [(Map Any Any) -> (Map Keyword Any)])
(defn keywordify-keys [m]
  (loop [k :- (clojure.lang.Seqable Any) (keys m)
         newmap :- clojure.lang.PersistentArrayMap$TransientArrayMap (transient {})]
    (if-let [kw (keyword (first k))]
      (recur (rest k)
             (assoc! newmap (keyword k) (get m k)))
      (persistent! newmap))))