mirror of
https://github.com/bsima/haskell-urbit-api.git
synced 2024-08-17 14:00:31 +03:00
init with 'connect' working
This commit is contained in:
commit
a1fb94cabd
9
.ghci
Normal file
9
.ghci
Normal file
@ -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 ++ "\""
|
1
.gitignore
vendored
Normal file
1
.gitignore
vendored
Normal file
@ -0,0 +1 @@
|
||||
dist-newstyle
|
91
Urbit/Airlock.hs
Normal file
91
Urbit/Airlock.hs
Normal file
@ -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
|
36
urbit-airlock.cabal
Normal file
36
urbit-airlock.cabal
Normal file
@ -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
|
Loading…
Reference in New Issue
Block a user