From a1fb94cabd148d67d57282da1eac27b58b22249e Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Thu, 27 Aug 2020 08:34:41 -0400
Subject: [PATCH] init with 'connect' working

---
 .ghci               |  9 +++++
 .gitignore          |  1 +
 Urbit/Airlock.hs    | 91 +++++++++++++++++++++++++++++++++++++++++++++
 urbit-airlock.cabal | 36 ++++++++++++++++++
 4 files changed, 137 insertions(+)
 create mode 100644 .ghci
 create mode 100644 .gitignore
 create mode 100644 Urbit/Airlock.hs
 create mode 100644 urbit-airlock.cabal

diff --git a/.ghci b/.ghci
new file mode 100644
index 0000000..695e4cf
--- /dev/null
+++ b/.ghci
@@ -0,0 +1,9 @@
+:set -XOverloadedStrings
+:set prompt "λ "
+:set prompt-cont "| "
+:set -Wall
+-- :set -haddock
+-- ':iq Module M' -> 'import qualified Module as M'
+:def iq (\arg -> let [x, y] = Prelude.words arg in return $ "import qualified " ++ x ++ " as " ++ y)
+:def hoogle \s -> return $ ":! hoogle search --count=15 \"" ++ s ++ "\""
+:def hdoc \s -> return $ ":! hoogle search --info \"" ++ s ++ "\""
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..48a004c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+dist-newstyle
diff --git a/Urbit/Airlock.hs b/Urbit/Airlock.hs
new file mode 100644
index 0000000..3702000
--- /dev/null
+++ b/Urbit/Airlock.hs
@@ -0,0 +1,91 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Urbit.Airlock where
+
+import Control.Lens
+import qualified Data.Aeson as Aeson
+import Data.ByteString.Lazy (ByteString)
+import Data.Text (Text)
+import Network.Wreq (FormParam((:=)))
+import qualified Network.Wreq as Wreq
+import qualified Network.Wreq.Session as Session
+-- import qualified Network.Wai.EventSource as Event
+
+
+data Ship = Ship
+  { session :: Maybe Session.Session,
+    lastEventId :: Int,
+    url :: Url,
+    code :: Text,
+    sseClient :: Bool
+  }
+  deriving (Show)
+
+
+channelUrl :: Ship -> String
+channelUrl Ship { url } = url <> "/channel.js"
+
+
+type Url = String
+type App = Text
+type Path = Text
+type Mark = Text
+type ShipName = Text
+type Subscription = Text
+
+
+-- |
+nextEventId :: Ship -> Int
+nextEventId Ship { lastEventId } = lastEventId + 1
+
+
+-- |
+connect :: Ship -> IO (Wreq.Response ByteString)
+connect ship = do
+  -- post to <ship>/~/login with json {"password": <code>}
+  let params = Wreq.defaults & Wreq.param "password" .~ [(code ship)]
+  r <- Wreq.getWith params (url ship <> "/~/login")
+  return r
+
+
+-- |
+poke :: Ship -> ShipName -> App -> Mark -> Aeson.Value -> IO (Wreq.Response ByteString)
+poke ship shipName app mark json = do
+  r <- Wreq.put (channelUrl ship)
+         ["id" := nextEventId ship
+         , "action" := ("poke"::Text)
+         , "ship" := shipName
+         , "app" := app
+         , "mark" := mark
+         , "json" := Aeson.encode json]
+  return r
+
+
+-- |
+ack :: Ship -> Int -> IO (Wreq.Response ByteString)
+ack ship eventId = do
+  r <- Wreq.post (channelUrl ship)
+        ["action" := ("ack"::Text)
+        , "event-id" := eventId]
+  return r
+
+
+-- TODO
+-- ssePipe :: Ship -> IO _
+-- ssePipe ship = undefined
+
+
+-- |
+subscribe :: Ship -> ShipName -> App -> Path -> IO Subscription
+subscribe = undefined
+
+
+-- |
+unsubscribe :: Ship -> Subscription -> IO ()
+unsubscribe = undefined
+
+
+-- |
+delete :: Ship -> IO ()
+delete = undefined
diff --git a/urbit-airlock.cabal b/urbit-airlock.cabal
new file mode 100644
index 0000000..35d4b8c
--- /dev/null
+++ b/urbit-airlock.cabal
@@ -0,0 +1,36 @@
+name:                urbit-airlock
+version:             0.1.0.0
+-- synopsis:
+-- description:
+homepage:            https://github.com/bsima/urbit-airlock#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Ben Sima
+maintainer:          bsima@me.com
+copyright:           2020 Ben Sima
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+extra-source-files:  README.md
+
+library
+  default-language:    Haskell2010
+  exposed-modules:
+    Urbit.Airlock
+  build-depends:
+    base >= 4.7 && < 5,
+    aeson,
+    bytestring,
+    lens,
+    text,
+    wai,
+    wai-extra,
+    wreq
+
+executable urlock
+  hs-source-dirs:      urlock
+  main-is:             Main.hs
+  default-language:    Haskell2010
+  build-depends:
+    base >= 4.7 && < 5,
+    urbit-airlock