├── .build.yml ├── .ghci ├── .gitignore ├── LICENSE ├── Main.hs ├── README.md ├── Urbit └── API.hs ├── default.nix ├── fakezod.sh ├── nixpkgs.nix ├── shell.nix ├── test.hs ├── urbit-api.cabal └── urbit-api.nix /.build.yml: -------------------------------------------------------------------------------- 1 | arch: null 2 | artifacts: [] 3 | environment: 4 | NIXPKGS_ALLOW_BROKEN: 1 5 | PORT: 8080 6 | image: nixos/20.09 7 | packages: [] 8 | secrets: [] 9 | shell: false 10 | triggers: [] 11 | 12 | sources: 13 | - https://github.com/bsima/urbit-airlock 14 | 15 | tasks: 16 | - build: | 17 | cd urbit-airlock 18 | nix-build 19 | #- test: | 20 | # cd urbit-airlock 21 | # # get urbit 22 | # curl -O https://bootstrap.urbit.org/urbit-v0.10.8-linux64.tgz 23 | # tar xzf urbit-v0.10.8-linux64.tgz 24 | # mkdir ~/bin 25 | # install ./urbit-v0.10.8-linux64/urbit ~/bin 26 | # export PATH=~/bin:$PATH 27 | # # start urbit daemon 28 | # ./fakezod.sh 29 | # # run tests 30 | # nix-shell --command "runghc ./test.hs" 31 | -------------------------------------------------------------------------------- /.ghci: -------------------------------------------------------------------------------- 1 | :set -XOverloadedStrings 2 | :set prompt "λ " 3 | :set prompt-cont "| " 4 | :set -Wall 5 | -- :set -haddock 6 | -- ':iq Module M' -> 'import qualified Module as M' 7 | :def iq (\arg -> let [x, y] = Prelude.words arg in return $ "import qualified " ++ x ++ " as " ++ y) 8 | :def hoogle \s -> return $ ":! hoogle search --count=15 \"" ++ s ++ "\"" 9 | :def hdoc \s -> return $ ":! hoogle search --info \"" ++ s ++ "\"" 10 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle 2 | dist 3 | zod 4 | result 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 Urbit 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. -------------------------------------------------------------------------------- /Main.hs: -------------------------------------------------------------------------------- 1 | import Urbit.Airlock 2 | 3 | main = print "TODO" 4 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell Urbit API 2 | 3 | [![License MIT](https://img.shields.io/badge/license-MIT-brightgreen.svg)](https://opensource.org/licenses/MIT) 4 | [![Hackage](https://img.shields.io/hackage/v/urbit-api.svg?style=flat)](https://hackage.haskell.org/package/urbit-api) 5 | [![builds.sr.ht status](https://builds.sr.ht/~ben/urbit-api.svg)](https://builds.sr.ht/~ben/urbit-api?) 6 | [![awesome urbit badge](https://img.shields.io/badge/~-awesome%20urbit-lightgrey)](https://github.com/urbit/awesome-urbit) 7 | 8 | 9 | 10 | This library helps you talk to your Urbit from Haskell, via HTTP. 11 | 12 | The Urbit API is a command-query API that lets you hook into apps running on 13 | your Urbit. You can submit commands (called "pokes") and subscribe to 14 | responses. 15 | 16 | See the `test.hs` file for some example usages. 17 | 18 | ## Design 19 | 20 | The Urbit vane `eyre` is responsible for defining the API interface. The path to 21 | the API is `/~/channel/...`, where we send messages to the global log (called 22 | `poke`s) which are then dispatched to the appropriate apps. To receive 23 | responses, we stream messages from a path associated with the app, such as 24 | `/mailbox/~/~zod/mc`. Internally, I believe Urbit calls these `wire`s. 25 | 26 | `urbit-api` handles most of the path, session, and HTTP request stuff 27 | automatically. See the 28 | [haddocks](https://hackage.haskell.org/package/urbit-api/docs/Urbit-API.html) 29 | for more details. 30 | 31 | This library is built on req, conduit, and aeson, all of which are very stable 32 | and usable libraries for working with HTTP requests and web data. 33 | 34 | ## Example usage 35 | 36 | ```haskell 37 | import qualified Data.Aeson as Aeson 38 | import Data.Aeson ((.=)) 39 | import qualified Data.Text as Text 40 | import qualified Data.UUID.V4 as UUID 41 | 42 | import Urbit.API 43 | 44 | main :: IO () 45 | main = do 46 | let fakezod = Ship 47 | { uid = "0123456789abcdef", 48 | name = "zod", 49 | lastEventId = 1, 50 | url = "http://localhost:8081", 51 | code = "lidlut-tabwed-pillex-ridrup" 52 | } 53 | 54 | -- Establish connection 55 | sess <- connect ship 56 | 57 | -- Send a message by poking the chat-hook 58 | uuid <- UUID.nextRandom 59 | poke sess ship "zod" "chat-hook" "json" $ 60 | Aeson.object 61 | [ "message" 62 | .= Aeson.object 63 | [ "path" .= Text.pack "/~/~zod/mc", 64 | "envelope" 65 | .= Aeson.object 66 | [ "uid" .= UUID.toText uuid, 67 | "number" .= (1 :: Int), 68 | "author" .= Text.pack "~zod", 69 | "when" .= (1602118786225 :: Int), 70 | "letter" .= Aeson.object ["text" .= Text.pack "hello world from haskell!"] 71 | ] 72 | ] 73 | ] 74 | ``` 75 | 76 | ## TODO 77 | 78 | - fix test suite on travis (OOM when trying to compile urbit) 79 | - more sophisticated test cases, also use cabal test instead of homegrown thing 80 | - add an exe that wraps the library with a cli 81 | - port to ghcjs 82 | - put some examples in the docs 83 | - graph store interface 84 | - additional agent interfaces 85 | -------------------------------------------------------------------------------- /Urbit/API.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE NamedFieldPuns #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | {-# OPTIONS_GHC -fno-warn-orphans #-} 7 | 8 | -- | 9 | -- Module: Urbit.API 10 | -- Copyright: © 2020–present Ben Sima 11 | -- License: MIT 12 | -- 13 | -- Maintainer: Ben Sima 14 | -- Stability: experimental 15 | -- Portability: non-portableo 16 | -- 17 | -- === About the Urbit API 18 | -- 19 | -- The Urbit API is a command-query API that lets you hook into apps running on 20 | -- your Urbit. You can submit commands and subscribe to responses. 21 | -- 22 | -- The Urbit vane @eyre@ is responsible for defining the API interface. The HTTP 23 | -- path to the API is @\/~\/channel\/...@, where we send messages to the global 24 | -- log (called @poke@s) which are then dispatched to the appropriate apps. To 25 | -- receive responses, we stream messages from a path associated with the app, 26 | -- such as @\/mailbox\/~\/~zod\/mc@. Internally, I believe Urbit calls these 27 | -- @wire@s. 28 | -- 29 | -- === About this library 30 | -- 31 | -- This library helps you talk to your Urbit from Haskell, via HTTP. It handles 32 | -- most of the path, session, and HTTP request stuff automatically. You'll need 33 | -- to know what app and mark (data type) to send to, which path/wire listen to, 34 | -- and the shape of the message. The latter can be found in the Hoon source 35 | -- code, called the @vase@ on the poke arm. 36 | -- 37 | -- This library is built on req, conduit, and aeson, all of which are very 38 | -- stable and usable libraries for working with HTTP requests and web data. 39 | -- Released under the MIT License, same as Urbit. 40 | module Urbit.API 41 | ( -- * Types 42 | Ship (..), 43 | Session, 44 | 45 | -- * Functions 46 | connect, 47 | poke, 48 | ack, 49 | subscribe, 50 | ) 51 | where 52 | 53 | import Conduit (ConduitM, runConduitRes, (.|)) 54 | import qualified Conduit 55 | import qualified Control.Exception as Exception 56 | import Data.Aeson ((.=)) 57 | import qualified Data.Aeson as Aeson 58 | import Data.ByteString (ByteString) 59 | import Data.Text (Text) 60 | import qualified Data.Text as Text 61 | import qualified Network.HTTP.Client as HTTP 62 | import Network.HTTP.Req ((=:)) 63 | import qualified Network.HTTP.Req as Req 64 | import qualified Network.HTTP.Req.Conduit as Req 65 | import qualified Text.URI as URI 66 | 67 | -- | Some information about your ship needed to establish connection. 68 | data Ship = Ship 69 | { -- | A random string for your channel 70 | uid :: Text, 71 | -- | The @\@p@ of your ship 72 | name :: Text, 73 | -- | Track the latest event we saw (needed for poking) 74 | lastEventId :: Int, 75 | -- | Network access point, with port if necessary, like 76 | -- @https://sampel-palnet.arvo.network@, or @http://localhost:8080@ 77 | url :: Text, 78 | -- | Login code, @+code@ in the dojo. Don't share this publically 79 | code :: Text 80 | } 81 | deriving (Show) 82 | 83 | channelUrl :: Ship -> Text 84 | channelUrl Ship {url, uid} = url <> "/~/channel/" <> uid 85 | 86 | nextEventId :: Ship -> Int 87 | nextEventId Ship {lastEventId} = lastEventId + 1 88 | 89 | -- | A wrapper type for the session cookies. 90 | type Session = HTTP.CookieJar 91 | 92 | -- | Connect and login to the ship. 93 | connect :: Ship -> IO Session 94 | connect ship = 95 | Req.useURI <$> (URI.mkURI $ url ship <> "/~/login") >>= \case 96 | Nothing -> error "could not parse ship url" 97 | Just uri -> 98 | Req.runReq Req.defaultHttpConfig $ 99 | Req.responseCookieJar <$> either con con uri 100 | where 101 | body = "password" =: (code ship) 102 | con (url, opts) = 103 | Req.req Req.POST url (Req.ReqBodyUrlEnc body) Req.bsResponse $ 104 | opts 105 | 106 | -- | Poke a ship. 107 | poke :: 108 | Aeson.ToJSON a => 109 | -- | Session cookie from 'connect' 110 | Session -> 111 | -- | Your ship 112 | Ship -> 113 | -- | Name of the ship to poke 114 | Text -> 115 | -- | Name of the gall application you want to poke 116 | Text -> 117 | -- | The mark of the message you are sending 118 | Text -> 119 | -- | The actual JSON message, serialized via aeson 120 | a -> 121 | IO Req.BsResponse 122 | poke sess ship shipName app mark json = 123 | Req.useURI <$> (URI.mkURI $ channelUrl ship) >>= \case 124 | Nothing -> error "could not parse ship url" 125 | Just uri -> 126 | Req.runReq Req.defaultHttpConfig $ 127 | either con con uri 128 | where 129 | con (url, opts) = 130 | Req.req 131 | Req.POST 132 | url 133 | (Req.ReqBodyJson body) 134 | Req.bsResponse 135 | $ opts <> Req.cookieJar sess 136 | body = 137 | [ Aeson.object 138 | [ "id" .= nextEventId ship, 139 | "action" .= Text.pack "poke", 140 | "ship" .= shipName, 141 | "app" .= app, 142 | "mark" .= mark, 143 | "json" .= json 144 | ] 145 | ] 146 | 147 | -- | Acknowledge receipt of a message. (This clears it from the ship's queue.) 148 | ack :: 149 | -- | Session cookie from 'connect' 150 | Session -> 151 | -- | Your ship 152 | Ship -> 153 | -- | The event number 154 | Int -> 155 | IO Req.BsResponse 156 | ack sess ship eventId = 157 | Req.useURI <$> (URI.mkURI $ channelUrl ship) >>= \case 158 | Nothing -> error "could not parse ship url" 159 | Just uri -> 160 | Req.runReq Req.defaultHttpConfig $ 161 | either con con uri 162 | where 163 | con (url, opts) = 164 | Req.req 165 | Req.POST 166 | url 167 | (Req.ReqBodyJson body) 168 | Req.bsResponse 169 | $ opts <> Req.cookieJar sess 170 | body = 171 | [ Aeson.object 172 | [ "action" .= Text.pack "ack", 173 | "event-id" .= eventId 174 | ] 175 | ] 176 | 177 | instance Req.MonadHttp (ConduitM i o (Conduit.ResourceT IO)) where 178 | handleHttpException = Conduit.liftIO . Exception.throwIO 179 | 180 | -- | Subscribe to ship events on some path. 181 | subscribe :: 182 | -- | Session cookie from 'connect' 183 | Session -> 184 | -- | Your ship 185 | Ship -> 186 | -- | The path to subscribe to. 187 | Text -> 188 | -- | A handler conduit to receive the response from the server, e.g. 189 | -- @Data.Conduit.Binary.sinkFile "my-file.out"@ 190 | ConduitM ByteString Conduit.Void (Conduit.ResourceT IO) a -> 191 | IO a 192 | subscribe sess ship path fn = 193 | Req.useURI <$> (URI.mkURI $ url ship <> "/" <> path) >>= \case 194 | Nothing -> error "could not parse ship url" 195 | Just uri -> runConduitRes $ do 196 | either con con uri $ \request manager -> 197 | Conduit.bracketP 198 | (HTTP.responseOpen request manager) 199 | HTTP.responseClose 200 | Req.responseBodySource 201 | .| fn 202 | where 203 | con (url, opts) = 204 | Req.req' 205 | Req.POST 206 | url 207 | Req.NoReqBody 208 | $ opts <> Req.cookieJar sess 209 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import ./nixpkgs.nix 2 | , compiler ? "ghc884" 3 | }: 4 | nixpkgs.pkgs.haskell.packages.${compiler}.callPackage ./urbit-api.nix { } 5 | -------------------------------------------------------------------------------- /fakezod.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | set -ex 3 | if [[ -d ./zod ]] 4 | then 5 | urbit $@ zod 6 | else 7 | urbit $@ -F zod 8 | fi 9 | -------------------------------------------------------------------------------- /nixpkgs.nix: -------------------------------------------------------------------------------- 1 | let 2 | depsOverlay = self: super: { 3 | haskell = super.haskell // { 4 | packages = super.haskell.packages // { 5 | ghc884 = super.haskell.packages.ghc884.override (old: { 6 | overrides = with super.pkgs.haskell.lib; haskellSelf: haskellSuper: { 7 | req-conduit = dontCheck haskellSuper.req-conduit; # wants network for tests 8 | }; 9 | }); 10 | }; 11 | }; 12 | }; 13 | nixpkgs = builtins.fetchTarball { 14 | url = "https://github.com/NixOS/nixpkgs/archive/13209156c191524437d5556bd8b24a132c4a899a.tar.gz"; 15 | sha256 = "06g21xf0nd0r2nziw72qk3vp8cd3vdy39snd44fir6j3fyjx1p98"; 16 | }; 17 | in 18 | import nixpkgs { 19 | overlays = [ 20 | depsOverlay 21 | ]; 22 | } 23 | -------------------------------------------------------------------------------- /shell.nix: -------------------------------------------------------------------------------- 1 | { nixpkgs ? import ./nixpkgs.nix 2 | , compiler ? "ghc884" 3 | }: 4 | 5 | nixpkgs.mkShell { 6 | name = "urbit-api-shell"; 7 | buildInputs = [ 8 | nixpkgs.ormolu.bin 9 | 10 | (nixpkgs.pkgs.haskell.packages.${compiler}.ghcWithPackages (hp: with hp; [ 11 | 12 | aeson base bytestring conduit conduit-extra http-client modern-uri 13 | req req-conduit text uuid 14 | 15 | ])) 16 | ]; 17 | } 18 | -------------------------------------------------------------------------------- /test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module Main where 6 | 7 | import Control.Exception (SomeException (..), try) 8 | import Data.Aeson (KeyValue ((.=))) 9 | import qualified Data.Aeson as Aeson 10 | import qualified Data.Conduit.Binary 11 | import Data.Text (Text) 12 | import qualified Data.Text as Text 13 | import qualified Data.Text.IO as Text.IO 14 | import qualified Data.UUID as UUID 15 | import qualified Data.UUID.V4 as UUID 16 | import qualified System.Environment as Env 17 | import qualified System.Exit as Exit 18 | import Urbit.API 19 | 20 | main :: IO () 21 | main = do 22 | port <- Text.pack <$> Env.getEnv "PORT" 23 | let ship = fakezod port 24 | sess <- connect ship 25 | testing "ship connection" $ 26 | connect ship >> return True 27 | 28 | testing "poke ship" $ 29 | do 30 | uuid <- UUID.nextRandom 31 | _ <- 32 | poke sess ship "zod" "chat-hook" "json" $ 33 | Aeson.object 34 | [ "message" 35 | .= Aeson.object 36 | [ "path" .= Text.pack "/~/~zod/mc", 37 | "envelope" 38 | .= Aeson.object 39 | [ "uid" .= UUID.toText uuid, 40 | "number" .= (1 :: Int), -- FIXME: should this be lastEventId? 41 | "author" .= Text.pack "~zod", 42 | "when" .= (1602118786225 :: Int), 43 | "letter" .= Aeson.object ["text" .= Text.pack "hello world from haskell!"] 44 | ] 45 | ] 46 | ] 47 | return $ True 48 | 49 | testing "ack" $ 50 | ack sess ship 1 >> return True 51 | 52 | -- These tests are basically just checking that a connection happens and 53 | -- doesn't throw, I need to pull in async in order to check for more 54 | -- correctness. Ideally: subscribe, send a message, then read the message to 55 | -- ensure its the same as the one sent. But maybe this is already tested in 56 | -- urbit core? 57 | 58 | testing "subscribe" $ do 59 | _ <- subscribe sess ship "/mailbox/~/~zod/mc" Data.Conduit.Binary.sinkLbs 60 | return True 61 | 62 | fakezod :: Text -> Ship 63 | fakezod port = 64 | Ship 65 | { uid = "0123456789abcdef", 66 | name = "zod", 67 | lastEventId = 1, 68 | url = "http://localhost:" <> port, 69 | code = "lidlut-tabwed-pillex-ridrup" 70 | } 71 | 72 | -- | Poor man's testing framework 73 | testing :: Text -> IO Bool -> IO () 74 | testing description f = 75 | (putStrLn $ replicate 80 '-') >> try f >>= \case 76 | Left (err :: SomeException) -> do 77 | Text.IO.putStrLn $ "FAIL: " <> description 78 | Exit.die $ show err 79 | Right False -> do 80 | Text.IO.putStrLn $ "FAIL: " <> description 81 | Exit.die "expected True, got False" 82 | Right True -> 83 | Text.IO.putStrLn $ "PASS: " <> description 84 | -------------------------------------------------------------------------------- /urbit-api.cabal: -------------------------------------------------------------------------------- 1 | name: urbit-api 2 | version: 0.2.0.0 3 | synopsis: Talk to Urbit from Haskell 4 | description: 5 | @urbit-api@ is a Haskell library that helps you connect to the Urbit 6 | API. 7 | . 8 | Built on req, conduit, and aeson for stability and simplicity. 9 | homepage: https://github.com/bsima/haskell-urbit-api 10 | license: BSD3 11 | license-file: LICENSE 12 | author: Ben Sima 13 | maintainer: bsima@me.com 14 | copyright: 2020 Ben Sima 15 | category: Web 16 | build-type: Simple 17 | cabal-version: >=1.10 18 | extra-source-files: README.md 19 | 20 | library 21 | default-language: Haskell2010 22 | exposed-modules: 23 | Urbit.API 24 | build-depends: 25 | base >= 4.7 && < 5, 26 | aeson, 27 | bytestring, 28 | conduit, 29 | conduit-extra, 30 | http-client, 31 | modern-uri, 32 | req, 33 | req-conduit, 34 | text, 35 | uuid 36 | 37 | -- executable urlock 38 | -- hs-source-dirs: . 39 | -- main-is: Main.hs 40 | -- default-language: Haskell2010 41 | -- build-depends: 42 | -- base >= 4.7 && < 5, 43 | -- urbit-api 44 | -- 45 | -- Test-Suite test-urbit-api 46 | -- type: exitcode-stdio-1.0 47 | -- main-is: test.hs 48 | -- build-depends: 49 | -- base >= 4.7 && < 5, 50 | -- urbit-api 51 | -------------------------------------------------------------------------------- /urbit-api.nix: -------------------------------------------------------------------------------- 1 | { mkDerivation, aeson, base, bytestring, conduit, conduit-extra 2 | , http-client, modern-uri, req, req-conduit, stdenv, text, uuid 3 | }: 4 | mkDerivation { 5 | pname = "urbit-api"; 6 | version = "0.1.0.0"; 7 | src = ./.; 8 | libraryHaskellDepends = [ 9 | aeson base bytestring conduit conduit-extra http-client modern-uri 10 | req req-conduit text uuid 11 | ]; 12 | homepage = "https://github.com/bsima/haskell-urbit-api"; 13 | description = "Talk to Urbit from Haskell"; 14 | license = stdenv.lib.licenses.bsd3; 15 | } 16 | --------------------------------------------------------------------------------