Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
Hayley Patton
netfarm
Commits
b3c56270
Commit
b3c56270
authored
Oct 28, 2019
by
Hayley Patton
🐢
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
use babel for byte array <-> string conversion, include CCL in CI, more stuff I forgot about
parent
57f59f99
Pipeline
#998
passed with stage
in 3 minutes and 37 seconds
Changes
14
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
90 additions
and
66 deletions
+90
-66
.gitlab-ci.yml
.gitlab-ci.yml
+1
-0
Code/Codecs/codecs.lisp
Code/Codecs/codecs.lisp
+4
-4
Code/Crypto/keys.lisp
Code/Crypto/keys.lisp
+8
-7
Code/Objects/inbuilt-schemas.lisp
Code/Objects/inbuilt-schemas.lisp
+3
-1
Code/Objects/mop.lisp
Code/Objects/mop.lisp
+4
-4
Code/Objects/schema.lisp
Code/Objects/schema.lisp
+1
-2
Code/Scripts/opcode-information.lisp
Code/Scripts/opcode-information.lisp
+2
-1
Code/Scripts/package.lisp
Code/Scripts/package.lisp
+1
-1
Code/package.lisp
Code/package.lisp
+2
-1
README.md
README.md
+57
-42
Server/netfarm-server.asd
Server/netfarm-server.asd
+4
-0
Tests/package.lisp
Tests/package.lisp
+1
-1
netfarm-tests.asd
netfarm-tests.asd
+1
-1
netfarm.asd
netfarm.asd
+1
-1
No files found.
.gitlab-ci.yml
View file @
b3c56270
...
...
@@ -13,3 +13,4 @@ test:
stage
:
test
script
:
-
sbcl --load tests.lisp --disable-debugger --quit
-
ccl -l tests.lisp -e '(quit)'
Code/Codecs/codecs.lisp
View file @
b3c56270
...
...
@@ -80,18 +80,18 @@
(
split-sequence
#\Space
line
:remove-empty-subseqs
t
))
(
defun
parse-atom
(
atom
&key
(
allow-codecs
t
))
(
case
(
count
#\
Colon
atom
:test
#'
char=
)
(
case
(
count
#\
:
atom
:test
#'
char=
)
(
0
atom
)
(
1
(
destructuring-bind
(
codecs
data
)
(
split-sequence
#\
Colon
atom
)
(
split-sequence
#\
:
atom
)
(
if
allow-codecs
(
decode-codecs
(
split-sequence
#\
Comma
codecs
)
data
)
(
decode-codecs
(
split-sequence
#\
,
codecs
)
data
)
(
error
'parser-codecs-in-key
:atom
atom
))))
(
otherwise
(
error
"Too many colons in ~a"
atom
))))
(
defun
render-string
(
string
)
(
if
(
or
(
find
#\Space
string
)
(
find
#\
Colon
string
)
(
find
#\
:
string
)
(
find
#\Newline
string
))
(
with-output-to-string
(
acc
)
(
write-char
#\"
acc
)
...
...
Code/Crypto/keys.lisp
View file @
b3c56270
...
...
@@ -24,9 +24,9 @@
(
defun
object->keys
(
object
)
(
make-keys
:signature-public
(
make-public-key
:ed25519
:y
(
object-value
object
'sign-key
))
:y
(
user-sign-key
object
))
:exchange-public
(
make-public-key
:curve25519
:y
(
object-value
object
'ecdh-key
))))
:y
(
user-ecdh-key
object
))))
(
defun
keys->object
(
keys
)
(
make-instance
'user
...
...
@@ -49,16 +49,17 @@
(
digest-sequence
:ripemd-128
key
)))
(
defun
symmetric-encrypt
(
key
text
)
(
encrypt-message
key
(
string-to-octets
text
)))
(
encrypt-message
key
(
babel:
string-to-octets
text
:encoding
:utf-8
)))
(
defun
symmetric-decrypt
(
key
text
)
(
octets-to-string
(
encrypt-message
key
text
)))
(
babel:octets-to-string
(
encrypt-message
key
text
)
:encoding
:utf-8
))
;;; Elliptic Curve Digital Signing Algorithm helpers
(
defun
hash-text
(
text
)
(
digest-sequence
:sha256
(
ascii-
string-to-
byte-array
text
)))
(
digest-sequence
:sha256
(
babel:
string-to-
octets
text
:encoding
:utf-8
)))
(
defun
sign-text
(
key
text
)
(
sign-message
(
keys-signature-private
key
)
...
...
@@ -93,7 +94,7 @@
(
defun
readable-verifier
(
key
)
(
when
(
stringp
key
)
(
setf
key
(
string-to-octets
key
)))
(
setf
key
(
babel:
string-to-octets
key
:encoding
:utf-8
)))
(
format
nil
"~{~a ~(~a ~a ~a~)~^,~%~}"
(
loop
with
digest
=
(
digest-sequence
:sha256
key
)
...
...
Code/Objects/inbuilt-schemas.lisp
View file @
b3c56270
...
...
@@ -10,7 +10,9 @@
(
:schema-names
"inbuilt/schema"
))
(
defclass
user
()
(
sign-key
ecdh-key
map
)
((
sign-key
:initarg
:sign-key
:reader
user-sign-key
)
(
ecdh-key
:initarg
:ecdh-key
:reader
user-ecdh-key
)
(
map
:initarg
:map
:initform
nil
:reader
user-map
))
(
:metaclass
netfarm-class
)
(
:schema-names
"inbuilt/user"
))
...
...
Code/Objects/mop.lisp
View file @
b3c56270
...
...
@@ -3,9 +3,9 @@
;;; The new, MOP-backed, Netfarm object implementation.
(
defclass
netfarm-class
(
standard-class
)
((
schema-names
:initform
'
()
:initarg
:schema-names
:reader
netfarm-class-schema-names
)
(
scripts
:initform
'
()
:initarg
:scripts
:reader
netfarm-class-scripts
)
((
scripts
:initform
'
()
:initarg
:scripts
:reader
netfarm-class-scripts
)
(
allowed-scripts
:initform
'
()
:initarg
:allowed-scripts
:reader
netfarm-class-allowed-scripts
)
(
schema-names
:initform
'
()
:initarg
:schema-names
:reader
netfarm-class-schema-names
)
(
slot-table
:reader
netfarm-class-slot-table
)))
(
defmethod
netfarm-class-slot-table
:before
((
class
netfarm-class
))
...
...
@@ -14,7 +14,7 @@
(
defmethod
netfarm-class-name
((
class
netfarm-class
))
(
if
(
null
(
netfarm-class-schema-names
class
))
(
slot-miss
ing
(
cl
as
s
-o
f
class
)
class
'netfarm-name
'slot-value
)
(
byte-array-to-hex-str
ing
(
h
as
h
-o
bject
(
class->schema
class
))
)
(
first
(
netfarm-class-schema-names
class
))))
(
defclass
netfarm-slot
(
closer-mop:standard-direct-slot-definition
)
...
...
@@ -67,6 +67,7 @@
(
labels
((
recur
(
class
)
;; Find every netfarm-slot in the class and its superclasses.
(
unless
(
gethash
class
checked-classes
)
(
setf
(
gethash
class
checked-classes
)
t
)
(
dolist
(
slot
(
closer-mop:class-direct-slots
class
))
(
when
(
typep
slot
'netfarm-slot
)
(
let
((
name
(
slot-netfarm-name
slot
)))
...
...
@@ -74,7 +75,6 @@
(
error
"duplicate slot name: ~s"
name
)
(
setf
(
gethash
name
slot-table
)
(
closer-mop:slot-definition-name
slot
))))))
(
setf
(
gethash
class
checked-classes
)
t
)
(
mapc
#'
recur
(
closer-mop:class-direct-superclasses
class
)))))
(
recur
class
))
(
setf
(
slot-value
class
'slot-table
)
slot-table
)))
...
...
Code/Objects/schema.lisp
View file @
b3c56270
...
...
@@ -46,8 +46,7 @@ keys in the vague-object's values table."
(
defun
class->schema
(
class
)
(
let
((
schema
(
make-instance
'schema
:scripts
(
netfarm-class-scripts
class
)
:allowed-scripts
(
netfarm-class-allowed-scripts
class
)
:name
(
netfarm-class-name
class
))))
:allowed-scripts
(
netfarm-class-allowed-scripts
class
))))
(
setf
(
schema-slots
schema
)
(
loop
for
name
being
the
hash-keys
of
(
netfarm-class-slot-table
class
)
collect
name
))
...
...
Code/Scripts/opcode-information.lisp
View file @
b3c56270
(
in-package
:netfarm-scripts
)
(
declaim
((
simple-array
function
(
*
))
*operators*
))
(
defvar
*operators*
(
make-array
256
(
#-
sbcl
defvar
#+
sbcl
sb-ext:defglobal
*operators*
(
make-array
256
:initial-element
(
lambda
(
interpreter
opcode
)
(
error
"illegal opcode ~d on ~s"
opcode
interpreter
))
:element-type
'function
))
...
...
Code/Scripts/package.lisp
View file @
b3c56270
(
defpackage
:netfarm-scripts
(
:use
:cl
:netfarm
)
(
:export
#:assemble
#:define-script
#:script
#:opcode-information
#:run-interpreter
#:run-interpreter
#:setup-interpreter
#:continue-interpreting
))
Code/package.lisp
View file @
b3c56270
...
...
@@ -47,7 +47,8 @@
#:symmetric-cipher
#:symmetric-encrypt
#:symmetric-decrypt
#:keys
#:hash-text
#:sign-text
#:sign-object
#:hash-text
#:sign-text
#:hash-object
#:sign-object
#:verify-text
#:verify-object
#:readable-verifier
#:object->keys
#:keys->object
...
...
README.md
View file @
b3c56270
...
...
@@ -12,12 +12,20 @@ Here's why we think it's right:
-
it's actually distributed. Federation isn't much better than centralization;
if your server goes down, you need to have another account to keep using the
fediverse. Distribution has much greater fault tolerance.
-
it isn't a pain to program for. This implementation uses Common Lisp's
meta-object protocol to perform introspection on classes and instances, so
that there is as little of an impedance mismatch between Netfarm-land and
Lisp-land code.
-
it's portable. This library defines a portable text format for describing
objects and schemas, but doesn't handle any networking or connectivity; so
Netfarm can be partially used over other protocols like HTTP or IPFS.
-
data is cryptographically signed. This allows for a proof that someone did
write something without needing a central authority to identify them for the
most part.
-
objects can have scripts executed on them to provide mutability. Netfarm, like
most distributed hash tables, is effectively immutable, but using a
deterministic script interpreter and a separate computed value system allows us
to perform a decent amount of things that require mutation.
-
data is represented as objects, instead of just values. This allows programs
to perform type-checking, and data can be strictly validated. Additionally,
"schemas", similar but not as powerful as classes, can be used to provide
...
...
@@ -40,10 +48,13 @@ It's not too hard to install, let's give that a go.
great if you
[
created an issue
](
https://gitlab.com/cal-coop/netfarm/netfarm/issues
)
detailing what went wrong.
## Examples
Cool, what can you do now?
-
Write out a random Lisp object to its Netfarm form then parse it back into Lisp.
We can take lists, strings, integers and booleans (encoded as
`:true`
or
`:false`
).
We can take lists, strings, integers, byte vectors and booleans (encoded as
`:true`
or
`:false`
).
```
lisp
CL-USER>
(
netfarm:render
42
)
...
...
@@ -52,51 +63,58 @@ CL-USER> (netfarm:parse *)
42
```
-
Create a schema and render it:
-
Create a class and render an instance of it:
As mentioned previously, this implementation of Netfarm hooks into the
meta-object protocol by providing a metaclass
`netfarm:netfarm-class`
. A hash
of the class will be used to identify the schema, but other names can be provided
using the class initarg
`:schema-names`
.
```
lisp
CL-USER>
(
netfarm:define-schema
*example-schema*
"example/schema"
(
a
b
c
))
*EXAMPLE-SCHEMA*
CL-USER>
(
netfarm:render-object
(
netfarm:schema->object
*example-schema*
))
CL-USER>
(
defclass
foo-class
()
((
a
:initarg
:a
)
(
b
:initarg
:b
)
(
c
:initarg
:c
))
(
:metaclass
netfarm:netfarm-class
)
(
:schema-names
"foo-class"
))
#
<NETFARM:NETFARM-CLASS
COMMON-LISP-USER::FOO-CLASS>
CL-USER>
(
netfarm:render-object
(
make-instance
'foo-class
:a
"This is A"
:b
'
(
"This"
"is"
2
)
:c
#(
1
2
3
4
5
)))
"---
schema
inbuilt/schema
schema
foo-class
---
slots (a b c)
traits ()
a \"This is A\"
b (This is integer:2)
c base64-data:AQIDBAU=
"
```
-
Create an instance of that schema
:
-
Parse it back in
:
```
lisp
CL-USER>
(
netfarm:make-object
*example-schema*
:a
1
:b
:true
:c
'
(
"Hello"
"world!"
))
CL-USER>
(
netfarm:parse-block
*
)
#
<NETFARM:VAGUE-OBJECT
:SOURCE
NIL
:SIGNATURES
NIL
:METADATA
#
<HASH-TABLE
:TEST
EQUAL
:COUNT
1
{100DDA19E3}>
:VALUES
#
<HASH-TABLE
:TEST
EQUAL
:COUNT
3
{100DDA21A3}>
:NAME
NIL
:COMPUTED-VALUES
#
<HASH-TABLE
:TEST
EQUAL
:COUNT
0
{100DDA3BF3}>
{100DE72AD3}>
CL-USER>
(
netfarm:apply-class
*
(
find-class
'foo-class
))
#
<FOO-CLASS
{100DF985E3}>
CL-USER>
(
describe
*
)
#
<FOO-CLASS
{100DF985E3}>
[standard-object]
#
<NETFARM:OBJECT
:SCHEMA
#
<NETFARM:SCHEMA
:NAME
"example/schema"
:SLOTS
(
#
<NETFARM:SLOT
:NAME
"a"
{10080544D3}>
#
<NETFARM:SLOT
:NAME
"b"
{100809BFC3}>
#
<NETFARM:SLOT
:NAME
"c"
{10080E3603}>
)
:TRAITS
NIL
{1008148113}>
:SIGNATURES
NIL
:METADATA
#
<HASH-TABLE
:TEST
EQUAL
:COUNT
0
{1008CF71F3}>
:COMPUTED-VALUES
#
<HASH-TABLE
:TEST
EQUAL
:COUNT
0
{1008CF7613}>
:SOURCE
NIL
:NAME
NIL
:VALUES
#
<HASH-TABLE
:TEST
EQUAL
:COUNT
3
{1008CF7A33}>
{1008CF6E03}>
CL-USER>
(
netfarm:render-object
*
)
"---
schema example/schema
---
a integer:1
b boolean:true
c (Hello world!)
"
```
Slots
with
:INSTANCE
allocation:
A
=
"This is A"
B
=
(
"This"
"is"
2
)
C
=
#(
1
2
3
4
5
)
SIGNATURES
=
NIL
METADATA
=
#
<HASH-TABLE
:TEST
EQUAL
:COUNT
1
{100DDA19E3}>
COMPUTED-VALUES
=
#
<HASH-TABLE
:TEST
EQUAL
:COUNT
0
{100DDA3BF3}>
SOURCE
=
NIL
NAME
=
NIL
```
## Todo
...
...
@@ -105,11 +123,8 @@ In no particular order:
-
Connect the code to a database (initially SQL, then we should create our own
as there is likely to be plenty of duplication in Netfarm) and
cl-decentralise2 to allow Netfarm data to be distributed
-
Write a "script"/"trait" interpreter to handle a reproducable form of
side-effects (such as forward references and updating objects)
-
A CLIM-based object viewer, possibly using the forementioned interpreter to
-
A CLIM-based object viewer, possibly using the script interpreter to
generate presentations
-
Flesh out the environment model, which handles providing subjective
-
Flesh out the environment
/map
model, which handles providing subjective
human-friendly names to objects and a weighted voting system which makes use
of locality of human trust and opinion (also todo: explain this idea better!)
-
Add (multiple) inheritance to schemas.
of locality of human trust and opinion
Server/netfarm-server.asd
0 → 100644
View file @
b3c56270
(
asdf:defsystem
:netfarm-server
:depends-on
(
:netfarm
:decentralise2
)
:components
((
:module
"Code"
:components
((
:file
"package"
)))))
Tests/package.lisp
View file @
b3c56270
(
defpackage
:netfarm-tests
(
:use
:cl
:fiveam
:netfarm
)
(
:export
:run-tests
:gitlab-ci-test
))
(
:export
#
:run-tests
#
:gitlab-ci-test
))
netfarm-tests.asd
View file @
b3c56270
(
defsystem
:netfarm-tests
:depends-on
(
:netfarm
:fiveam
:the-cost-of-nothing
)
:depends-on
(
:netfarm
:fiveam
:the-cost-of-nothing
:uiop
)
:components
((
:module
"Tests"
:components
((
:file
"package"
)
(
:file
"fuzzing"
)
...
...
netfarm.asd
View file @
b3c56270
(
asdf:defsystem
:netfarm
:depends-on
(
:ironclad
:s-base64
:closer-mop
:depends-on
(
:ironclad
:s-base64
:closer-mop
:babel
:split-sequence
:alexandria
:flexi-streams
)
:components
((
:module
"Code"
:components
((
:file
"package"
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment