diff options
Diffstat (limited to 'com/simatime')
35 files changed, 2113 insertions, 0 deletions
diff --git a/com/simatime/alpha.hs b/com/simatime/alpha.hs new file mode 100644 index 0000000..438b97a --- /dev/null +++ b/com/simatime/alpha.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | Commonly useful functions, a Prelude replacement. +module Com.Simatime.Alpha ( + -- * Re-export Protolude + module X + -- * General functions + , (/@) + -- * Debugging tools + , say + -- * TODO: remove this + , Prelude.read + ) where + +import qualified Prelude +import Protolude as X +import Data.String + +-- | Debugging printf +say :: String -> IO () +say msg = putStrLn msg + +-- | Alias for map, fmap, <$> +(/@) :: Functor f => (a -> b) -> f a -> f b +(/@) = fmap diff --git a/com/simatime/bild.scm b/com/simatime/bild.scm new file mode 100644 index 0000000..11403e8 --- /dev/null +++ b/com/simatime/bild.scm @@ -0,0 +1,145 @@ +;; bild - a simple build tool +;; +;;; Commentary: +;; +;; Design constraints +;; +;; - only input is a namespace, no subcommands, no packages +;; - no need to write specific build rules +;; - one rule for hs, one for rs, one for scm, and so on +;; - no need to distinguish between exe and lib, just have a single output +;; - never concerned with deployment/packaging - leave that to another tool (scp? tar?)) +;; +;; Features +;; +;; - namespace maps to filesystem +;; - no need for `bild -l` for listing available targets. Use `ls` or `tree` +;; - you build namespaces, not files/modules/packages/etc +;; - namespace maps to language modules +;; - build settings can be set in the file comments +;; - pwd is always considered the the source directory, no `src` vs `doc` etc. +;; - build methods automaticatly detected with file extensions +;; - flags modify the way to interact with the build +;; - -s = jump into a shell and/or repl +;; - -p = turn on profiling +;; - -t = limit build by type +;; - -e = exclude some regex in the ns tree +;; - -o = optimize level +;; +;; Example Commands +;; +;; bild [-rpt] <target..> +;; +;; The general scheme is to build the things described by the targets. A target +;; is a namespace. You can list as many as you want, but you must list at least +;; one. It could just be `.` for the current directory. Build outputs will go +;; into the _bild directory in the root of the project. +;; +;; bild biz.web +;; +;; Or `bild biz/web`. This shows building a file at ./biz/web.hs, this will +;; translate to something like `ghc --make Biz.Web`. +;; +;; bild -r <target> +;; +;; Starts a repl/shell for target. +;; - if target.hs, load ghci +;; - if target.scm, load scheme repl +;; - if target.clj, load a clojure repl +;; - if target.nix, load nix-shell +;; - and so on. +;; +;; bild -p <target> +;; +;; build target with profiling (if available) +;; +;; bild -t nix target +;; +;; only build target.nix, not target.hs and so on (in the case of multiple +;; targets with the same name but different extension). +;; +;; Here is an example integration with GHC. Given the following command-line +;; invocation to compile the namespace 'com.simatime.bild' which depends on +;; 'com.simatime.lib': +;; +;; ghc com/simatime/bild.hs -i com/simatime/lib.hs -o _bild/bild -v \ +;; -main-is Com.Simatime.Bild.main +;; +;; The general template of which is: +;; +;; ghc <source> -i <deps..> -o <target> -main-is <target>.main +;; +;; Some definitions: +;; +;; - <source> is some source file +;; - <deps..> is the stack of dependencies +;; - <target> is the target namespace, indicated by 'bild <target>' +;; +;; To fill out the build template, we can parse the file for known +;; namespaces. The general recipe is: +;; +;; 1. Create a list of namespaces in my git repo. This can be cached, or I can +;; integrate with git somehow. +;; 2. Read the <source> file corresponding to <target> +;; 3. Look for 'import <namespace>', where <namespace> is a namespace in the +;; aforementioned cache. +;; 4. If found, then save current build as a continuation and compile +;; <namespace>. Result gets put on the dependency stack +;; 5. When finished, return to building <target> +;; +;; Once the build command template is filled out, we can create the nix expression. +;; +;; TODO +;; +;; Questions +;; +;; - how to import (third-party) dependencies? +;; 1 just don't have them...? yeah right +;; 2 the target.nix could be the build description for target.hs +;; 3 just use a default.nix for the com.whatever +;; 4 have a deps.nix file +;; 5 list them in the file with other settings +;; - how to handle multiple output formats? +;; - e.g. that ghcjs and ghc take the same input files... +;; - say you have a .md file, you want to bild it to pdf, html, and more. What do? +;; - i guess the nix file could return a set of drvs instead of a single drv +;; - the top of the file should +;; +;;; Code: + +(define-module (com simatime bild) + #:use-module ((ice-9 ftw) #:prefix ftw:) + #:export (ns? + ns->path)) + +(define ns? symbol?) + +(define (ns->path ns) + ;; in place of a spec + (when (ns? ns) + (string-fold + (lambda (a b) + (if (eq? a #\.) + (string-concatenate (list b (string #\/))) + (string-concatenate (list b (string a))))) + "" + (symbol->string ns)))) + +(define ns->module-name (ns) + TODO) + +(define (ns sym) + (define-module (ns->module-name))) + +(define (prn a) (display a) (newline)) + +;; todo +;; +;; - find buildable files given a namespace +;; - select a build method based on ext +;; - run the build +(define (find-buildable ns) + (ftw:ftw ns + (lambda (a b c) + (map prn (list a b c)) + #t))) diff --git a/com/simatime/core.scm b/com/simatime/core.scm new file mode 100644 index 0000000..6a4f09d --- /dev/null +++ b/com/simatime/core.scm @@ -0,0 +1,73 @@ +(define-module (com simatime core)) + +;; +;; old core, do i still need this? +;; + +(define (not x) (if x #f #t)) +(define (null? obj) (if (eqv? obj '()) #t #f)) +(define (list objs) objs) +(define (identity obj) obj) +(define (flip f) (lambda (x y) (f y x))) +(define (curry f a) (lambda (b) (apply f (cons a (list b))))) +(define (compose f g) (lambda (x) (f (apply g x)))) +(define zero? (curry = 0)) +(define positive? (curry < 0)) +(define negative? (curry > 0)) +(define (odd? n) (= (mod n 2) 1)) +(define (even? n) (= (mod n 2) 0)) + +(define (foldr f end lst) + (if (null? lst) + end + (f (car lst) (foldr f end (cdr lst))))) + +(define (foldl f acc lst) + (if (null? lst) + acc + (foldl f (f acc (car lst)) (cdr lst)))) + +(define fold foldl) + +(define (unfold f init pred) + (if (pred init) + (cons init '()) + (cons init (unfold f (f init) pred)))) + +(define (mem* pred op) + (lambda (acc next) + (if (and (not acc) (pred (op next))) + next + acc))) + +(define (sum lst) (fold + 0 lst)) +(define (produce lst) (fold * 0 1 lst)) + +(define (max nums) + (fold (lambda (x y) (if (> x y) x y)) + (car nums) (cdr nums))) + +(define (min nums) + (fold (lambda (x y) (if (< x y) x y)) + (car nums) (cdr nums))) + +(define (length lst) (fold (lambda (x y) (+ x 1)) 0 lst)) +(define (reverse lst) (fold (flip cons) '() lst)) +(define (memq obj lst) (fold (mem* (curry eq? obj) identity) #f lst)) +(define (memv obj lst) (fold (mem* (curry eqv? obj) identity) #f lst)) +(define (member obj lst) (fold (mem* (curry equal? obj) identity) #f lst)) +(define (assq obj alist) (fold (mem* (curry eq? obj) car) #f alist)) +(define (assv obj alist) (fold (mem* (curry eqv? obj) car) #f alist)) +(define (assoc obj alist) (fold (mem* (curry equal? obj) car) #f alist)) +(define (map f lst) (foldr (lambda (x y) (cons (f x) y)) '() lst)) +(define (filter pred lst) (foldr (lambda (x y) (if (pred x) (cons x y) y)) '() lst)) + + +;; +;; clojure-like stuff +;; + +(define (pr . a) + (for-each display args)) + +(define (prn . a) (apply pr a) (newline)) diff --git a/com/simatime/dev.nix b/com/simatime/dev.nix new file mode 100644 index 0000000..a45a92b --- /dev/null +++ b/com/simatime/dev.nix @@ -0,0 +1,20 @@ +{ nixos }: + +/* + +com.simatime.dev - main development/build server. Lives in ben's apartment in +Mountain View. + +*/ + +nixos { + system = "x86_64-linux"; + configuration = { + imports = [ + ./users.nix + ./packages.nix + ./dev/hardware.nix + ./dev/configuration.nix + ]; + }; +} diff --git a/com/simatime/dev/configuration.nix b/com/simatime/dev/configuration.nix new file mode 100644 index 0000000..b313a36 --- /dev/null +++ b/com/simatime/dev/configuration.nix @@ -0,0 +1,215 @@ +{ config, lib, pkgs, ... }: + +{ + networking = { + hostName = "lithium"; + hosts = { + "::1" = [ "localhost" "ipv6-localhost" "ipv6-loopback" ]; + }; + + firewall = { + allowedTCPPorts = [ + 22 8000 8443 443 8080 8081 # std + 500 10000 # no idea + 8096 # emby + 8112 # deluge + ]; + allowedTCPPortRanges = [ + { from = 3000; to = 3100; } # dev stuff + ]; + checkReversePath = false; + }; + + }; + + # Use the systemd-boot EFI boot loader. + boot.loader.systemd-boot.enable = true; + boot.loader.efi.canTouchEfiVariables = true; + boot.enableContainers = true; + + boot.initrd.luks.devices = [ + { + name = "root"; + device = "/dev/disk/by-uuid/a0160f25-e0e3-4af0-8236-3e298eac957a"; + preLVM = true; + } + ]; + + powerManagement.enable = false; + + time.timeZone = "America/Los_Angeles"; + + fonts.fonts = with pkgs; [ + google-fonts mononoki source-code-pro fantasque-sans-mono hack-font + fira fira-code fira-code-symbols + ]; + + nixpkgs = { + config = { + allowUnfree = true; + allowBroken = true; + }; + }; + + hardware = { + opengl.enable = true; + pulseaudio = { + enable = true; + extraConfig = '' + load-module module-loopback + ''; + }; + }; + + programs = { + bash.enableCompletion = true; + command-not-found.enable = true; + gnupg.agent = { + enable = true; + enableSSHSupport = true; + }; + mosh.enable = true; + }; + + virtualisation = { + docker = { + enable = true; + liveRestore = false; + }; + libvirtd.enable = true; + virtualbox = { + host = { + enable = false; + headless = false; + addNetworkInterface = false; + }; + guest = { + enable = false; + x11 = false; + }; + }; + }; + + # https://github.com/NixOS/nixpkgs/issues/53985 + systemd.services.gitlab-runner.path = ["/run/wrappers"]; + + services = { + pcscd.enable = true; + logind = { + lidSwitch = "ignore"; + extraConfig = "IdleAction=ignore"; + }; + + # runner for hero ci + gitlab-runner = { + packages = [ pkgs.bash pkgs.git pkgs.python3 ]; + enable = true; + gracefulTimeout = "2min"; + gracefulTermination = true; + configFile = "/home/ben/gitlab-runner.toml"; + }; + + openssh = { + enable = true; + forwardX11 = true; + }; + + deluge = { + enable = true; + openFilesLimit = 10240; + web.enable = true; + }; + + printing.enable = true; + + xserver = { + enable = true; + layout = "us"; + xkbOptions = "caps:ctrl_modifier"; + displayManager.sddm.enable = true; + desktopManager = { + kodi.enable = true; + plasma5.enable = true; + xterm.enable = true; + }; + }; + + jupyter = { + enable = false; + port = 3099; + ip = "*"; + password = "'sha1:4b14a407cabe:fbab8e5400f3f4f3ffbdb00e996190d6a84bf51e'"; + kernels = { + python3 = let + env = (pkgs.python3.withPackages (p: with p; [ + ipykernel pandas scikitlearn numpy matplotlib sympy ipywidgets + ])); + in { + displayName = "py3"; + argv = [ + "${env.interpreter}" + "-m" + "ipykernel_launcher" + "-f" + "{connection_file}" + ]; + language = "python"; + #logo32 = "${env.sitePackages}/lib/python3.6/site-packages/ipykernel/resources/logo-32x32.png"; + #logo64 = "${env.sitePackages}/lib/python3.6/site-packages/ipykernel/resources/logo-64x64.png"; + }; + }; + }; + + emby = { + enable = true; + user = "emby"; + }; + + vnstat.enable = true; + + # security stuff + fail2ban.enable = true; + clamav = { + daemon.enable = true; + updater.enable = true; + }; + + postgresql = { + enable = true; + package = pkgs.postgresql_10; + authentication = '' + local all pprjam md5 + local all pprjam_test md5 + ''; + enableTCPIP = true; + }; + redis = { + enable = true; + }; + }; + + nix = { + gc = { + automatic = true; + dates = "03:15"; + }; + binaryCaches = [ "https://cache.nixos.org/" ]; + nixPath = [ + "nixpkgs=/nix/var/nix/profiles/per-user/root/channels/nixos/nixpkgs" + "nixos-config=/etc/nixos/configuration.nix" + "/nix/var/nix/profiles/per-user/root/channels" + ]; + extraOptions = '' + gc-keep-outputs = true + gc-keep-derivations = true + ''; + }; + + # This value determines the NixOS release with which your system is to be + # compatible, in order to avoid breaking some software such as database + # servers. You should change this only after NixOS release notes say you + # should. + system.stateVersion = "17.09"; # Did you read the comment? + system.autoUpgrade.enable = true; + +} diff --git a/com/simatime/dev/hardware.nix b/com/simatime/dev/hardware.nix new file mode 100644 index 0000000..fc0e7a0 --- /dev/null +++ b/com/simatime/dev/hardware.nix @@ -0,0 +1,34 @@ +# Do not modify this file! It was generated by ‘nixos-generate-config’ +# and may be overwritten by future invocations. Please make changes +# to /etc/nixos/configuration.nix instead. +{ config, lib, pkgs, ... }: + +{ + imports = + [ <nixpkgs/nixos/modules/installer/scan/not-detected.nix> + ]; + + boot.initrd.availableKernelModules = [ "xhci_pci" "ahci" "usbhid" "sd_mod" ]; + boot.kernelModules = [ "kvm-intel" ]; + boot.extraModulePackages = [ ]; + + fileSystems."/" = + { device = "/dev/disk/by-uuid/0d8b0e52-10de-4af2-bcd9-b36278352e77"; + fsType = "ext4"; + }; + + fileSystems."/boot" = + { device = "/dev/disk/by-uuid/9B89-85C7"; + fsType = "vfat"; + }; + + fileSystems."/mnt/lake" = + { device = "/dev/disk/by-uuid/037df3ae-4609-402c-ab1d-4593190d0ee7"; + fsType = "ext4"; + }; + + swapDevices = [ ]; + + nix.maxJobs = lib.mkDefault 4; + powerManagement.cpuFreqGovernor = "powersave"; +} diff --git a/com/simatime/fathom.nix b/com/simatime/fathom.nix new file mode 100644 index 0000000..40e8b0b --- /dev/null +++ b/com/simatime/fathom.nix @@ -0,0 +1,109 @@ +{ options +, lib +, config +, pkgs +, modulesPath +, stdenv +}: + +with lib; + +let + cfg = config.services.fathom + pkgs.fathom = stdenv.mkDerivation rec { + name = "fathom-v${version}"; + version = "1.2.1"; + src = builtins.fetchurl { + url = "https://github.com/usefathom/fathom/releases/download/v${version}/fathom_${version}_linux_amd64.tar.gz"; + sha256 = "0sfpxh2xrvz992k0ynib57zzpcr0ikga60552i14m13wppw836nh"; + }; + sourceRoot = "."; + dontBuild = true; + installPhase = '' + mkdir -p $out/bin + cp fathom $out/bin + cp LICENSE $out + cp README.md $out + ''; + }; +in { + options.services.fathom = { + enable = lib.mkEnableOption "Enable the Fathom Analytics service"; + + port = mkOption { + type = types.string; + default = "3000"; + description = '' + The port on which Fathom will listen for + incoming HTTP traffic. + ''; + }; + + gzip = mkOption { + type = types.bool; + default = true; + description = "Whether or not to enable gzip compression."; + }; + + debug = mkOption { + type = types.bool; + default = false; + description = "Whether or not to enable debug mode."; + }; + + dataDir = mkOption { + type = types.path; + default = "/var/lib/fathom"; + description = "Fathom data directory"; + }; + }; + + config = mkIf cfg.enable { + systemd.services.fathom = { + wantedBy = [ "multi-user.target" ]; + after = [ "network.target" ]; + + environment = { + FATHOM_SERVER_ADDR = cfg.port; + FATHOM_GZIP = builtins.toString cfg.gzip; + FATHOM_DEBUG = builtins.toString cfg.debug; + FATHOM_DATABASE_DRIVER = "sqlite3"; + FATHOM_DATABASE_NAME = "${cfg.dataDir}/fathom.db"; + FATHOM_SECRET = "random-secret-string"; + }; + preStart = '' + echo "[fathom] creating ${cfg.dataDir}" + mkdir -p ${cfg.dataDir} + chown -R fathom:fathom ${cfg.dataDir} + echo "[fathom]" creating ${cfg.dataDir}/.env + env | grep "^FATHOM" > ${cfg.dataDir}/.env + ''; + description = '' + Fathom Analytics + ''; + + serviceConfig = { + Type = "simple"; + User = "fathom"; + Group = "fathom"; + ExecStart = "${pkgs.fathom}/bin/fathom server"; + KillSignal = "INT"; + WorkingDirectory = cfg.dataDir; + Restart = "on-failure"; + RestartSec = "10"; + PermissionsStartOnly = "true"; + }; + }; + + environment.systemPackages = [ pkgs.fathom ]; + + users = { + groups = { fathom = {}; }; + users.fathom = { + description = "Fathom daemon user"; + home = cfg.dataDir; + group = "fathom"; + }; + }; + }; +} diff --git a/com/simatime/firefox.nix b/com/simatime/firefox.nix new file mode 100644 index 0000000..12316fb --- /dev/null +++ b/com/simatime/firefox.nix @@ -0,0 +1,12 @@ +{ ... }: + +{ + services = { + firefox.syncserver = { + enable = true; + allowNewUsers = true; + listen.port = 5001; + publicUri = "http://firefoxsync.simatime.com"; + }; + }; +} diff --git a/com/simatime/git.nix b/com/simatime/git.nix new file mode 100644 index 0000000..51e46b6 --- /dev/null +++ b/com/simatime/git.nix @@ -0,0 +1,18 @@ +{ pkgs, ... }: + +{ + services = { + gitolite = { + enable = true; + enableGitAnnex = true; + # TODO: change this to /var/lib/gitolite? + dataDir = "/srv/git"; + user = "git"; + group = "git"; + extraGitoliteRc = '' + $RC{SITE_INFO} = 'a computer is a bicycle for the mind.'; + ''; + adminPubkey = builtins.readFile ./keys/ben.pub; + }; + }; +} diff --git a/com/simatime/go.hs b/com/simatime/go.hs new file mode 100644 index 0000000..1b32230 --- /dev/null +++ b/com/simatime/go.hs @@ -0,0 +1,100 @@ +-- based on +-- https://stackoverflow.com/questions/4522387/how-can-i-emulate-gos-channels-with-haskell +-- but this version encodes end-of-stream on the communication channel, as a Nothing + +module Com.Simatime.Go + ( chan + , readCh + , (-<-) + , writeCh + , (->-) + , go + ) +where + +import Control.Concurrent ( forkIO + , ThreadId + , threadDelay + ) +import Control.Concurrent.STM.TChan ( newTChan + , readTChan + , writeTChan + , isEmptyTChan + , TChan + ) +import Control.Monad ( forM_ ) +import GHC.Conc ( atomically ) + +-- | Make a new channel. +chan :: _ +chan = atomically . newTChan + +-- | Take from a channel. +readCh :: TChan a -> IO a +readCh = atomically . readTChan + +-- | Alias for 'readCh'. +-- +-- >>> c <- chan +-- >>> writeCh c "val" +-- >>> -<- c +-- "val" +-- +-- I don't think this looks terrible with do-notation: +-- +-- >>> c <- chan +-- >>> writeCh c "val" +-- >>> result <- -<- c +-- >>> print result +-- "val" +(-<-) :: TChan a -> IO a +(-<-) = readCh + +-- | Write to a channel. +writeCh :: TChan a -> a -> IO () +writeCh ch v = atomically $ writeTChan ch v + +-- | Alias for 'writeCh', but flipped to make it read better. +-- +-- >>> c <- chan +-- >>> "val" ->- c +-- >>> readCh c +-- "val" +(->-) :: TChan a -> a -> IO () +(->-) = flip writeCh + +-- | Starts a background process. +go :: IO () -> IO ThreadId +go = forkIO + + +{- Example: (TODO: move to module-level docs) + +-- can I just implement forM/Traversable over the channel? +forRange :: TChan (Maybe a) -> (a -> IO b) -> IO [b] +forRange ch fn = helper fn [] where + -- helper :: (a -> IO b) -> [b] -> IO [b] + helper fn acc = do + jv <- readCh ch + case jv of + Nothing -> return $ reverse acc + Just v -> do + b <- fn v + helper fn (b : acc) + +feedData :: (Num a, Enum a) => TChan (Maybe a) -> IO () +feedData ch = do + forM_ [1 .. 9999] (\x -> writeCh ch (Just x)) + writeQ ch Nothing -- EOF value + +printData :: TChan (Maybe Int) -> IO () +printData c = do + forRange c (print :: Int -> IO ()) + return () + +main :: IO () +main = do + ch <- chan + go $ feedData ch + printData ch +-} diff --git a/com/simatime/hardware.nix b/com/simatime/hardware.nix new file mode 100644 index 0000000..8c88cb7 --- /dev/null +++ b/com/simatime/hardware.nix @@ -0,0 +1,6 @@ +{ ... }: +{ + imports = [ <nixpkgs/nixos/modules/profiles/qemu-guest.nix> ]; + boot.loader.grub.device = "/dev/vda"; + fileSystems."/" = { device = "/dev/vda1"; fsType = "ext4"; }; +} diff --git a/com/simatime/idea/duree-pitch.org b/com/simatime/idea/duree-pitch.org new file mode 100644 index 0000000..d4d9d6f --- /dev/null +++ b/com/simatime/idea/duree-pitch.org @@ -0,0 +1,80 @@ +#+TITLE: Duree: automated universal database +#+SUBTITLE: seeking pre-seed funding +#+AUTHOR: Ben Sima <ben@bsima.me> +#+EMAIL: ben@bsima.me +#+OPTIONS: H:1 num:nil toc:nil +#+LATEX_CLASS: article +#+LATEX_CLASS_OPTIONS: +#+LATEX_HEADER: +#+LATEX_HEADER_EXTRA: +#+LATEX_COMPILER: pdflatex +#+DATE: \today +#+startup: beamer +#+LaTeX_CLASS: beamer +#+LaTeX_CLASS_OPTIONS: [presentation,smaller] +Start with this: + - https://news.ycombinator.com/item?id=14605 + - https://news.ycombinator.com/item?id=14754 +Then build AI layers on top. +* Problem +Developers spend too much time managing database schemas. Every database +migration is a risk to the business because of the high possibility of data +corruption. If the data is modeled incorrectly at the beginning, it requires a +lot of work (months of developer time) to gut the system and re-architect it. +* Solution +- Using machine learning and AI, we automatically detect the schema of your data. +- Data can be dumped into a noSQL database withouth the developer thinking much + about structure, then we infer the structure automatically. +- We can also generate a library of queries and provide an auto-generated client + in the choosen language of our users. +* Existing solutions +- Libraries like alembic and migra (Python) make data migrations easier, but + don't help you make queries or properly model data. +- ORMs help with queries but don't give you much insight into the deep structure + of your data (you still have to do manual joins) and don't help you properly + model data. +- Graph QL is the closest competitor, but requires manually writing types and + knowing about the deep structure of your data. We automate both. + +* Unsolved problems +- Unsure whether to build this on top of existing noSQL databases, or to develop + our own data store. Could re-use an existing [[https://en.wikipedia.org/wiki/Category:Database_engines][database engine]] to provide an + end-to-end database solution. +* Key metrics +- How much time do developers spend dealing with database migrations? What does + this cost the business? We can decrease this, decreasing costs. +- How costly are failed data migrations and backups? We reduce this risk. +* Unique value proposition +We can automate the backend data mangling for 90% of software applications. +* Unfair advantage +- I have domain expertise, having worked on similar schemaless database problems + before. +- First-mover advantage in this space. Everyone else is focused on making + database migrations easier, we want to make them obsolete. +* Channels +- Cold calling mongoDB et al users. +* Customer segments +- *Early adopters:* users of mongoDB and graphQL who want to spend time writing + application code, not managing database schemas. The MVP would be to generate + the Graph QL code from their Mongo database automatically. +- Will expand support to other databases one by one. The tech could be used on + any database... or we expand by offering our own data store. +* Cost structure +** Fixed costs + - Initial development will take about 3 months (~$30k) + - Each new database support will take a month or two of development. +** Variable costs + - Initial analysis will be compute-heavy. + - Following analyses can be computationally cheap by buildiing off of the + existing model. + - Customer acquisition could be expensive, will likely hire a small sales + team. +* Revenue streams +- $100 per month per database analyzed + - our hosted service connects to their database directly + - includes client libraries via graphQL + - may increase this if it turns out we save companies a lot more than $100/mo, + which is likely +- enterprise licenses available for on-prem + - allows them to have complete control over their database access + - necessary for HIPAA/PCI compliance diff --git a/com/simatime/idea/flash.org b/com/simatime/idea/flash.org new file mode 100644 index 0000000..1c392f0 --- /dev/null +++ b/com/simatime/idea/flash.org @@ -0,0 +1,36 @@ +#+title: Flash +#+description: a system for quickly testing business ideas + +- Each marketing iteration for a product requires some gear. A "gear" pack is just a yaml + file with all data for a single flash test. It will include ad content, + pricing info, links to necessary images, and so on. + - even better: store these in a database? Depends on how often we need to edit them... +- Data gets marshalled into a bunch of templates, one for each sales pipeline in + the /Traction/ book by Gabriel Weinberg (7 pipelines total) +- Each sales pipeline will have a number of integrations, we'll need at least + one for each pipeline before going to production. E.g.: + - google adwords + - facebook ads + - email lists (sendgrid) + - simple marketing website + - producthunt + - etc +- Pipelines will need to capture metrics on a pre-set schedule. + - Above integrations must also pull performance numbers from Adwords etc APIs. + - Will need some kind of scheduled job queue or robot background worker to handle this. + - A simple dashboard might also be useful, not sure. +- Metrics determine the performance of a pipeline. After the defined trial + duration, some pipelines will be dropped. The high-performing pipelines we + double-down on. +- Metrics to watch: + - conversion rate + - usage time - minutes spent on site/app + - money spent per customer + - see baremetrics for more ideas +- This can eventually be integrated to a larger product design platform (what Sam + Altman calls a "product improvement engine" in his playbook - PIE?). + - metric improvement can be plotted on a relative scale + - "If you improve your product 5% every week, it will really compound." - Sam + - PIE will differ from Flash in that Flash is only for the early stages of a + product - sell it before you build it. PIE will operate on existing products + to make them better. diff --git a/com/simatime/keys/ben.pub b/com/simatime/keys/ben.pub new file mode 100644 index 0000000..c661508 --- /dev/null +++ b/com/simatime/keys/ben.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDDhmSEbvX6LSk1ZO/whhAWpxwUxGPwbn7ZKVmxLcIilLdkd/vhFQKSYyMBW+21G3cMbwyFVsCyPbADoXcvV5OSIklxgitP77/2TAgkEPjyklJ4KD0QNDjpu+YGGIyVTgE9YPBhpwuUlxRhux15vN8xzAXq4f5/xpyBPekIdbEaEUZHrKN/z9g8cgw9ZMWSrchbsE3QlU8MJK78HO+v3TjH7Ip+LffWNuhckiYnzT8Duy47vgc1OYqtJaDMN/ufK7yeNILK81M1ybHGOlqYxSfV/RM7oD0P5w5YeTXMpRsOyn4YVzhWSQFrlf08XbwlZUNm6Pb8eNRjM+3YyFTcUU/S81xKwOPRNNhlPnxz+tUltCR3H/0Falu1pxJYT2qfuM9j9z9xA1bJEsSSZ1b2bsHw7ujpRmg0xsPUk7DXIQ1Kh92BFfmDoZWeqsMF1E7H8iuaVsN9k96BwbBfiB4stQqI3ycuHO9zbsa12y8AQusDbr9W8rl/vR0pKNrcNO32ojOzkblJGWgyNxDvTS4l69+qi6pMBONicUUMQnXEtJoasjpECzwlAHIYJMmFQUuloEafR8b0ZAaCw+I5SfsyYF4hHLYseHvMavxgLNZ6W4ZlaL9XmQ7ZGhh10ub4ceW61QvCzKD34yO1yl8PcmS8Fa7bZbGxkq36oCusGbD65AlY+w== ben@lithium diff --git a/com/simatime/keys/deploy.pub b/com/simatime/keys/deploy.pub new file mode 100644 index 0000000..664a2d9 --- /dev/null +++ b/com/simatime/keys/deploy.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDlLRbbXgwjF7IqObf4dZE/jj0HoT6xJR6bP/6ZrJz7NPCPIgY3GacOtBfkJp6KK0zKQdFmxNpcfb3zgpe/Ru7pkmSfI9IoWAU3aLPWK2G3tbLPmktGmF9C53OhyXgFtBGr2Q/+wSRKAfN/FrEEa2FuRBtvtcAMiwbQLbFCzlmWhE7swSBvg38ZSFrjhANsEhfNVCtsrtG16fkfrfmBFv4JIog1fEoMKmXg7rhMjpaas8+n52HMFXvjllePRpywK4wB20GOcOuDSdc3i3zs7NFuicGunEpW2S/byrHotSWHZ9VuUwPn3GJ6xorrGyvsRuPS2anhHTSBxYCqYdXg0BIYUn1x5Uhtzd8kIU06gSLsvuhqGCLNucnXAT1Zix7pSlO21be81SX4vwQEth+6Dkm6kja0ArHZL6wglF8Njd1fV9iOwvcS07clwa/2S8suFLwVrQXz16vfAfA2zi4/qeop5Sv9W4DIOZuIMPmbWZCoy7L6Fu4+x4prb8LCQNM5m4CP3HngCW8PpxtBbBJd0dcXVap1HgDTIt/CLH8ms52uX5k3bHuvzryOihSuwmi/cDZAJAmbgclM9klsZr4R/GAoAWhhGxXM2tLuiwZ2nLvCPlXbBazZpdM2aC3VIwnMwJrJFu2u9B6RSsz2ijbygecT98UmiMYK7Mk1y6GkvY+mDQ== ben@lithium diff --git a/com/simatime/keys/nick.pub b/com/simatime/keys/nick.pub new file mode 100644 index 0000000..4dc08fb --- /dev/null +++ b/com/simatime/keys/nick.pub @@ -0,0 +1 @@ +ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAACAQDfSOxXJTQADjROqbaiJtjbJaHTsBtuWNvQpDvXLigl9R27VqIn7dYk2STuWglwFyrvYfU1UmjgJcJ6J2KbXGTH5mhaC04MJ4aqmOR3Ynnq7nDzmtEtn1I+K7LmpFXsFXgOTzIlzggIWflGd1pPBwgWqMoPDcSqNQFPI/+rk1JOxk3e2Mq60VTp9WM9hs0AJQEyZ+wwZ0vyrj588kQb6jQUZ7qx1UZoDzPc57zREEZbQeU1Gd9FK2bCHlKOBHYlqIftSRBGGCpuo7zobhajR0xHO9RnF0NmeLbW85XhDus8vVgBg/BTDPxHEzm5jKiCkc+i3ia0Ff9mp2zgtSdXCp5jbVZ3AYfYLi1zbPWmaSdWqFx2ntOLwWR3/RHjw6+b4KmUQ4xtQHyXOijTBCH29i7VCo7l8WL+I2mSGJ7/Wtw7NFtMpVVs8/0iKt2t12FIefzvbZoWU7vbmuO7+gQI5l+F+JE6DLWOl04vT/V98WxiHA5rbCjTT/bubs4gTeCR9qNehaoM+apitpUP8HXygnxD7EJeK6JNkdub9TY663IkiKlpnWgeoDTNSP7JF/jkU0Nt8yoR2pTyxQqMFYa37/3WKjmSHk1TgxLEmlwHQFtIkTPn8PL+VLa4ACYuWUjxS4aMRpxo9eJUHdy0Y04yKxXN8BLw7FAhytm2pTXtT4zqaQ== nicksima@gmail.com diff --git a/com/simatime/language/bs.hs b/com/simatime/language/bs.hs new file mode 100644 index 0000000..a810706 --- /dev/null +++ b/com/simatime/language/bs.hs @@ -0,0 +1,12 @@ +-- https://github.com/write-you-a-scheme-v2/scheme +-- https://github.com/justinethier/husk-scheme +module Language.Bs + ( module X + ) where + +import Language.Bs.Cli as X +import Language.Bs.Eval as X +import Language.Bs.Expr as X +import Language.Bs.Parser as X +import Language.Bs.Primitives as X +import Language.Bs.Repl as X diff --git a/com/simatime/language/bs/cli.hs b/com/simatime/language/bs/cli.hs new file mode 100644 index 0000000..4c48c86 --- /dev/null +++ b/com/simatime/language/bs/cli.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Language.Bs.Cli ( + run +) where + +import Data.String +import Data.Text.IO as TIO +import Language.Bs.Eval -- evalFile :: T.Text -> IO () +import Language.Bs.Repl -- Repl.mainLoop :: IO () +import Options.Applicative +import Protolude +import System.Directory + +-- SOURCES +--http://book.realworldhaskell.org/read/io.html +-- https://github.com/pcapriotti/optparse-applicative +-- https://hackage.haskell.org/package/optparse-applicative + +runScript :: FilePath -> IO () +runScript fname = do + exists <- doesFileExist fname + if exists + then TIO.readFile fname >>= evalFile fname + else TIO.putStrLn "File does not exist." + +data LineOpts = UseReplLineOpts | RunScriptLineOpts String + +parseLineOpts :: Parser LineOpts +parseLineOpts = runScriptOpt <|> runReplOpt + where + runScriptOpt = + RunScriptLineOpts <$> strOption (long "script" + <> short 's' + <> metavar "SCRIPT" + <> help "File containing the script you want to run") + runReplOpt = + UseReplLineOpts <$ flag' () (long "repl" + <> short 'r' + <> help "Run as interavtive read/evaluate/print/loop") + +schemeEntryPoint :: LineOpts -> IO () +schemeEntryPoint UseReplLineOpts = mainLoop --repl +schemeEntryPoint (RunScriptLineOpts script) = runScript script + +run :: IO () +run = execParser opts >>= schemeEntryPoint + where + opts = info (helper <*> parseLineOpts) + ( fullDesc + <> header "Executable binary for Write You A Scheme v2.0" + <> progDesc "contains an entry point for both running scripts and repl" ) diff --git a/com/simatime/language/bs/eval.hs b/com/simatime/language/bs/eval.hs new file mode 100644 index 0000000..290170b --- /dev/null +++ b/com/simatime/language/bs/eval.hs @@ -0,0 +1,241 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Language.Bs.Eval ( + evalText +, evalFile +, runParseTest +, safeExec +, runASTinEnv +, basicEnv +, fileToEvalForm +, textToEvalForm +, getFileContents +) where + +import Control.Exception +import Control.Monad.Reader +import qualified Data.Map as Map +import Data.String +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import Language.Bs.Expr +import Language.Bs.Parser +import Language.Bs.Primitives +import Protolude +import System.Directory + +funcEnv :: Map.Map T.Text Expr +funcEnv = Map.fromList $ primEnv + <> [ ("read" , IFun $ IFunc $ unop readFn) + , ("parse", IFun $ IFunc $ unop parseFn) + , ("eval", IFun $ IFunc $ unop eval) + , ("show", IFun $ IFunc $ unop (return . Tape . ppexpr)) + ] + +basicEnv :: Env +basicEnv = Env Map.empty funcEnv + +readFn :: Expr -> Eval Expr +readFn (Tape txt) = lineToEvalForm txt +readFn val = throw $ TypeMismatch "read expects string, instead got:" val + +parseFn :: Expr -> Eval Expr +parseFn (Tape txt) = either (throw . ParseError . show) return $ readExpr txt +parseFn val = throw $ TypeMismatch "parse expects string, instead got:" val + +safeExec :: IO a -> IO (Either String a) +safeExec m = do + result <- Control.Exception.try m + case result of + Left (eTop :: SomeException) -> + case fromException eTop of + Just (enclosed :: LispError) -> + return $ Left (show enclosed) + Nothing -> + return $ Left (show eTop) + Right val -> + return $ Right val + +runASTinEnv :: Env -> Eval b -> IO b +runASTinEnv code action = runReaderT (unEval action) code + +lineToEvalForm :: T.Text -> Eval Expr +lineToEvalForm input = either (throw . ParseError . show ) eval $ readExpr input + +evalFile :: FilePath -> T.Text -> IO () -- program file +evalFile filePath fileExpr = (runASTinEnv basicEnv $ fileToEvalForm filePath fileExpr) >>= print + +fileToEvalForm :: FilePath -> T.Text -> Eval Expr +fileToEvalForm filePath input = either (throw . ParseError . show ) evalBody $ readExprFile filePath input + +runParseTest :: T.Text -> T.Text -- for view AST +runParseTest input = either (T.pack . show) (T.pack . show) $ readExpr input + +getFileContents :: FilePath -> IO T.Text +getFileContents fname = do + exists <- doesFileExist fname + if exists then TIO.readFile fname else return "File does not exist." + +textToEvalForm :: T.Text -> Eval Expr +textToEvalForm input = either (throw . ParseError . show ) evalBody $ readExpr input + +evalText :: T.Text -> IO () --REPL +evalText textExpr = do + res <- runASTinEnv basicEnv $ textToEvalForm textExpr + print res + +getVar :: Expr -> Eval Expr +getVar (Atom atom) = do + Env{..} <- ask + case Map.lookup atom (Map.union fenv env) of -- lookup, but prefer functions + Just x -> return x + Nothing -> throw $ UnboundVar atom +getVar n = throw $ TypeMismatch "failure to get variable: " n + +ensureAtom :: Expr -> Eval Expr +ensureAtom n@(Atom _) = return n +ensureAtom n@(List _) = throw $ TypeMismatch "got list" n +ensureAtom n = throw $ TypeMismatch "expected an atomic value" n + +extractVar :: Expr -> T.Text +extractVar (Atom atom) = atom +extractVar n = throw $ TypeMismatch "expected an atomic value" n + +getEven :: [t] -> [t] +getEven [] = [] +getEven (x:xs) = x : getOdd xs + +getOdd :: [t] -> [t] +getOdd [] = [] +getOdd (_:xs) = getEven xs + +applyFunc :: Expr -> [Expr] -> [Expr] -> Eval Expr +applyFunc expr params args = bindArgsEval params args expr + +bindArgsEval :: [Expr] -> [Expr] -> Expr -> Eval Expr +bindArgsEval params args expr = do + Env{..} <- ask + let newVars = zipWith (\a b -> (extractVar a,b)) params args + let (newEnv, newFenv) = Map.partition (not . isFunc) $ Map.fromList newVars + local (const $ Env (newEnv <> env) (newFenv <> fenv)) $ eval expr + +isFunc :: Expr -> Bool +isFunc (List ((Atom "lambda"):_)) = True +isFunc _ = False + +eval :: Expr -> Eval Expr +eval (List [Atom "dumpEnv", x]) = do + Env{..} <- ask + liftIO $ print $ toList env + liftIO $ print $ toList fenv + eval x + +eval (Numb i) = return $ Numb i +eval (Tape s) = return $ Tape s +eval (Bool b) = return $ Bool b +eval (List []) = return Nil +eval Nil = return Nil +eval n@(Atom _) = getVar n + +eval (List [Atom "showSF", rest]) = return . Tape . T.pack $ show rest +eval (List ((:) (Atom "showSF") rest)) = return . Tape . T.pack . show $ List rest + +eval (List [Atom "quote", val]) = return val + +eval (List [Atom "if", pred_, then_, else_]) = do + ifRes <- eval pred_ + case ifRes of + (Bool True) -> eval then_ + (Bool False) -> eval else_ + _ -> + throw $ BadSpecialForm "if's first arg must eval into a boolean" +eval (List ( (:) (Atom "if") _)) = + throw $ BadSpecialForm "(if <bool> <s-expr> <s-expr>)" + +eval (List [Atom "begin", rest]) = evalBody rest +eval (List ((:) (Atom "begin") rest )) = evalBody $ List rest + +-- top-level define +-- TODO: how to make this eval correctly? +eval (List [Atom "define", List (name:args), body]) = do + Env{..} <- ask + _ <- eval body + bindArgsEval (name:args) [body] name + +eval (List [Atom "define", name, body]) = do + Env{..} <- ask + _ <- eval body + bindArgsEval [name] [body] name + +eval (List [Atom "let", List pairs, expr]) = do + Env{..} <- ask + atoms <- mapM ensureAtom $ getEven pairs + vals <- mapM eval $ getOdd pairs + bindArgsEval atoms vals expr + +eval (List (Atom "let":_) ) = + throw $ BadSpecialForm "let function expects list of parameters and S-Expression body\n(let <pairs> <s-expr>)" + + +eval (List [Atom "lambda", List params, expr]) = do + ctx <- ask + return $ Func (IFunc $ applyFunc expr params) ctx +eval (List (Atom "lambda":_) ) = throw $ BadSpecialForm "lambda function expects list of parameters and S-Expression body\n(lambda <params> <s-expr>)" + + +-- needed to get cadr, etc to work +eval (List [Atom "cdr", List [Atom "quote", List (_:xs)]]) = + return $ List xs +eval (List [Atom "cdr", arg@(List (x:xs))]) = + case x of + -- proxy for if the list can be evaluated + Atom _ -> do + val <- eval arg + eval $ List [Atom "cdr", val] + _ -> return $ List xs + + +eval (List [Atom "car", List [Atom "quote", List (x:_)]]) = + return $ x +eval (List [Atom "car", arg@(List (x:_))]) = + case x of + Atom _ -> do + val <- eval arg + eval $ List [Atom "car", val] + _ -> return $ x + + +eval (List ((:) x xs)) = do + Env{..} <- ask + funVar <- eval x + xVal <- mapM eval xs + case funVar of + (IFun (IFunc internalFn)) -> + internalFn xVal + + (Func (IFunc definedFn) (Env benv _)) -> + local (const $ Env benv fenv) $ definedFn xVal + + _ -> + throw $ NotFunction funVar + +updateEnv :: T.Text -> Expr -> Env -> Env +updateEnv var e@(IFun _) Env{..} = Env env $ Map.insert var e fenv +updateEnv var e@(Func _ _) Env{..} = Env env $ Map.insert var e fenv +updateEnv var e Env{..} = Env (Map.insert var e env) fenv + +evalBody :: Expr -> Eval Expr +evalBody (List [List ((:) (Atom "define") [Atom var, defExpr]), rest]) = do + evalVal <- eval defExpr + ctx <- ask + local (const $ updateEnv var evalVal ctx) $ eval rest + +evalBody (List ((:) (List ((:) (Atom "define") [Atom var, defExpr])) rest)) = do + evalVal <- eval defExpr + ctx <- ask + local (const $ updateEnv var evalVal ctx) $ evalBody $ List rest + +evalBody x = eval x diff --git a/com/simatime/language/bs/expr.hs b/com/simatime/language/bs/expr.hs new file mode 100644 index 0000000..a39c7b6 --- /dev/null +++ b/com/simatime/language/bs/expr.hs @@ -0,0 +1,154 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Language.Bs.Expr where + +import Data.String (String) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Show +import Protolude hiding (show) +import qualified Text.PrettyPrint.Leijen.Text as PP +import Text.PrettyPrint.Leijen.Text hiding ((<$>)) + +type Ctx = Map Text Expr +data Env = Env { env :: Ctx, fenv :: Ctx } + deriving (Eq) + +newtype Eval a = Eval { unEval :: ReaderT Env IO a } + deriving (Monad, Functor, Applicative, MonadReader Env, MonadIO) + +data IFunc = IFunc { fn :: [Expr] -> Eval Expr } + deriving (Typeable) + +instance Eq IFunc where + (==) _ _ = False + +data Expr + = Atom Text + | List [Expr] + | Numb Integer + | Tape Text + | IFun IFunc -- TODO: call this Kern + | Func IFunc Env + | Bool Bool + | Nil + deriving (Typeable, Eq) + +instance Show Expr where + show = T.unpack . ppexpr + +data LispErrorType + = NumArgs Integer [Expr] + | LengthOfList Text Int + | ExpectedList Text + | ParseError String + | TypeMismatch Text Expr + | BadSpecialForm Text + | NotFunction Expr + | UnboundVar Text + | Default Expr + | ReadFileError Text + deriving (Typeable) + +data LispError = LispError Expr LispErrorType + +instance Show LispErrorType where + show = T.unpack . ppexpr + +instance Show LispError where + show = T.unpack . ppexpr + +instance Exception LispErrorType +instance Exception LispError + +ppexpr :: Pretty a => a -> Text +ppexpr x = PP.displayTStrict (PP.renderPretty 1.0 70 (pretty x)) + +--prettyList :: [Doc] -> Doc +--prettyList = encloseSep lparen rparen PP.space + +instance Pretty Expr where + pretty v = + case v of + Atom a -> + textStrict a + + List ls -> + prettyList $ fmap pretty ls + + Numb n -> + integer n + + Tape t -> + textStrict "\"" <> textStrict t <> textStrict "\"" + + IFun _ -> + textStrict "<internal function>" + + Func _ _ -> + textStrict "<lambda function>" + + Bool True -> + textStrict "#t" + + Bool False -> + textStrict "#f" + + Nil -> + textStrict "'()" + +instance Pretty LispErrorType where + pretty err = case err of + NumArgs i args -> + textStrict "number of arguments" + <$$> textStrict "expected" + <+> textStrict (T.pack $ show i) + <$$> textStrict "received" + <+> textStrict (T.pack $ show $ length args) + + + LengthOfList txt i -> + textStrict "length of list in:" + <+> textStrict txt + <$$> textStrict "length:" + <+> textStrict (T.pack $ show i) + + ParseError txt -> + textStrict "cannot parse expr:" + <+> textStrict (T.pack txt) + + TypeMismatch txt expr -> + textStrict "type mismatch:" + <$$> textStrict txt + <$$> pretty expr + + BadSpecialForm txt -> + textStrict "bad special form:" + <$$> textStrict txt + + NotFunction expr -> + textStrict "not a function" + <$$> pretty expr + + UnboundVar txt -> + textStrict "unbound variable:" + <$$> textStrict txt + + Default _ -> + textStrict "default error" + + ReadFileError txt -> + textStrict "error reading file:" + <$$> textStrict txt + + ExpectedList txt -> + textStrict "expected list:" + <$$> textStrict txt + +instance Pretty LispError where + pretty (LispError expr typ) = + textStrict "error evaluating:" + <$$> indent 4 (pretty expr) + <$$> pretty typ diff --git a/com/simatime/language/bs/parser.hs b/com/simatime/language/bs/parser.hs new file mode 100644 index 0000000..3044a60 --- /dev/null +++ b/com/simatime/language/bs/parser.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Language.Bs.Parser ( + readExpr +, readExprFile +) where + +import Control.Monad (fail) +import Control.Monad (mzero) +import Data.Char (digitToInt) +import Data.Functor.Identity (Identity) +import Data.String +import qualified Data.Text as T +import Language.Bs.Expr +import Protolude hiding ((<|>), try) +import Text.Parsec +import qualified Text.Parsec.Language as Lang +import Text.Parsec.Text +import qualified Text.Parsec.Token as Tok + +lexer :: Tok.GenTokenParser T.Text () Identity +lexer = Tok.makeTokenParser style + +style :: Tok.GenLanguageDef T.Text () Identity +style = Lang.emptyDef { + Tok.commentStart = "#|" + , Tok.commentEnd = "|#" + , Tok.commentLine = ";" + , Tok.opStart = mzero + , Tok.opLetter = mzero + , Tok.identStart = letter <|> oneOf "!$%&*/:<=>?^_~" + , Tok.identLetter = digit <|> letter <|> oneOf "!$%&*/:<=>?^_~+-.@" + } + +parens :: Parser a -> Parser a +parens = Tok.parens lexer + +whitespace :: Parser () +whitespace = Tok.whiteSpace lexer + +lexeme :: Parser a -> Parser a +lexeme = Tok.lexeme lexer + +quoted :: Parser a -> Parser a +quoted p = try (char '\'') *> p + +identifier :: Parser T.Text +identifier = T.pack <$> (Tok.identifier lexer <|> specialIdentifier) <?> "identifier" + where + specialIdentifier :: Parser String + specialIdentifier = lexeme $ try $ + string "-" <|> string "+" <|> string "..." + +-- | The @Radix@ type consists of a base integer (e.g. @10@) and a parser for +-- digits in that base (e.g. @digit@). +type Radix = (Integer, Parser Char) + +-- | Parse an integer, given a radix as output by @radix@. +-- Copied from Text.Parsec.Token +numberWithRadix :: Radix -> Parser Integer +numberWithRadix (base, baseDigit) = do + digits <- many1 baseDigit + let n = foldl (\x d -> base*x + toInteger (digitToInt d)) 0 digits + seq n (return n) + +decimal :: Parser Integer +decimal = Tok.decimal lexer + +-- | Parse a sign, return either @id@ or @negate@ based on the sign parsed. +-- Copied from Text.Parsec.Token +sign :: Parser (Integer -> Integer) +sign = char '-' *> return negate + <|> char '+' *> return identity + <|> return identity + +intRadix :: Radix -> Parser Integer +intRadix r = sign <*> numberWithRadix r + +textLiteral :: Parser T.Text +textLiteral = T.pack <$> Tok.stringLiteral lexer + +nil :: Parser () +nil = try ((char '\'') *> string "()") *> return () <?> "nil" + +hashVal :: Parser Expr +hashVal = lexeme $ char '#' + *> (char 't' *> return (Bool True) + <|> char 'f' *> return (Bool False) + <|> char 'b' *> (Numb <$> intRadix (2, oneOf "01")) + <|> char 'o' *> (Numb <$> intRadix (8, octDigit)) + <|> char 'd' *> (Numb <$> intRadix (10, digit)) + <|> char 'x' *> (Numb <$> intRadix (16, hexDigit)) + <|> oneOf "ei" *> fail "Unsupported: exactness" + <|> char '(' *> fail "Unsupported: vector" + <|> char '\\' *> fail "Unsupported: char") + + +lispVal :: Parser Expr +lispVal = hashVal + <|> Nil <$ nil + <|> Numb <$> try (sign <*> decimal) + <|> Atom <$> identifier + <|> Tape <$> textLiteral + <|> _Quote <$> quoted lispVal + <|> List <$> parens manyExpr + +manyExpr :: Parser [Expr] +manyExpr = lispVal `sepBy` whitespace + +_Quote :: Expr -> Expr +_Quote x = List [Atom "quote", x] + +contents :: Parser a -> ParsecT T.Text () Identity a +contents p = whitespace *> lexeme p <* eof + +readExpr :: T.Text -> Either ParseError Expr +readExpr = parse (contents lispVal) "<stdin>" + +readExprFile :: SourceName -> T.Text -> Either ParseError Expr +readExprFile = parse (contents (List <$> manyExpr)) diff --git a/com/simatime/language/bs/primitives.hs b/com/simatime/language/bs/primitives.hs new file mode 100644 index 0000000..c074c59 --- /dev/null +++ b/com/simatime/language/bs/primitives.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +-- | bs primitives +-- +-- I would like to reduce the number of primitives in the language to some +-- minimal number, like SKI combinator or Nock instructions. I'm not sure what +-- the minimal number is. The idea is to move primitives from here into core.scm +-- over time. +module Language.Bs.Primitives where + +import Control.Exception +import Control.Monad.Except +import Data.Text as T +import Data.Text.IO as TIO +import Language.Bs.Expr +import Network.HTTP +import Protolude +import System.Directory +import System.IO + +type Prim = [(T.Text, Expr)] +type Unary = Expr -> Eval Expr +type Binary = Expr -> Expr -> Eval Expr + +mkF :: ([Expr] -> Eval Expr) -> Expr +mkF = IFun . IFunc + +primEnv :: Prim +primEnv = [ + ("+" , mkF $ binopFold (numOp (+)) (Numb 0) ) + , ("*" , mkF $ binopFold (numOp (*)) (Numb 1) ) + , ("string-append", mkF $ binopFold (strOp (<>)) (Tape "") ) + , ("-" , mkF $ binop $ numOp (-)) + , ("<" , mkF $ binop $ numCmp (<)) + , ("<=" , mkF $ binop $ numCmp (<=)) + , (">" , mkF $ binop $ numCmp (>)) + , (">=" , mkF $ binop $ numCmp (>=)) + , ("==" , mkF $ binop $ numCmp (==)) + , ("even?" , mkF $ unop $ numBool even) + , ("odd?" , mkF $ unop $ numBool odd) + , ("neg?" , mkF $ unop $ numBool (< 0)) + , ("pos?" , mkF $ unop $ numBool (> 0)) + , ("eq?" , mkF $ binop eqCmd ) + , ("null?" , mkF $ unop (eqCmd Nil) ) + , ("bl-eq?" , mkF $ binop $ eqOp (==)) + , ("and" , mkF $ binopFold (eqOp (&&)) (Bool True)) + , ("or" , mkF $ binopFold (eqOp (||)) (Bool False)) + , ("not" , mkF $ unop $ notOp) + , ("cons" , mkF $ Language.Bs.Primitives.cons) + , ("cdr" , mkF $ Language.Bs.Primitives.cdr) + , ("car" , mkF $ Language.Bs.Primitives.car) + , ("quote" , mkF $ quote) + , ("file?" , mkF $ unop fileExists) + , ("slurp" , mkF $ unop slurp) + , ("wslurp" , mkF $ unop wSlurp) + , ("put" , mkF $ binop put_) + ] + +unop :: Unary -> [Expr] -> Eval Expr +unop op [x] = op x +unop _ args = throw $ NumArgs 1 args + +binop :: Binary -> [Expr] -> Eval Expr +binop op [x,y] = op x y +binop _ args = throw $ NumArgs 2 args + +fileExists :: Expr -> Eval Expr +fileExists (Tape txt) = Bool <$> liftIO (doesFileExist $ T.unpack txt) +fileExists val = throw $ TypeMismatch "read expects string, instead got: " val + +slurp :: Expr -> Eval Expr +slurp (Tape txt) = liftIO $ wFileSlurp txt +slurp val = throw $ TypeMismatch "read expects string, instead got: " val + +wFileSlurp :: T.Text -> IO Expr +wFileSlurp fileName = withFile (T.unpack fileName) ReadMode go + where go = readTextFile fileName + +openURL :: T.Text -> IO Expr +openURL x = do + req <- simpleHTTP (getRequest $ T.unpack x) + body <- getResponseBody req + return $ Tape $ T.pack body + +wSlurp :: Expr -> Eval Expr +wSlurp (Tape txt) = liftIO $ openURL txt +wSlurp val = throw $ TypeMismatch "wSlurp expects a string, instead got: " val + +readTextFile :: T.Text -> Handle -> IO Expr +readTextFile fileName h = do + exists <- doesFileExist $ T.unpack fileName + if exists + then (TIO.hGetContents h) >>= (return . Tape) + else throw $ ReadFileError $ T.concat [" file does not exist: ", fileName] + +put_ :: Expr -> Expr -> Eval Expr +put_ (Tape file) (Tape msg) = liftIO $ wFilePut file msg +put_ (Tape _) val = throw $ TypeMismatch "put expects string in the second argument (try using show), instead got: " val +put_ val _ = throw $ TypeMismatch "put expects string, instead got: " val + +wFilePut :: T.Text -> T.Text -> IO Expr +wFilePut fileName msg = withFile (T.unpack fileName) WriteMode go + where go = putTextFile fileName msg + +putTextFile :: T.Text -> T.Text -> Handle -> IO Expr +putTextFile fileName msg h = do + canWrite <- hIsWritable h + if canWrite + then (TIO.hPutStr h msg) >> (return $ Tape msg) + else throw $ ReadFileError $ T.concat [" file does not exist: ", fileName] + +binopFold :: Binary -> Expr -> [Expr] -> Eval Expr +binopFold op farg args = case args of + []-> throw $ NumArgs 2 args + [a,b] -> op a b + _ -> foldM op farg args + +numBool :: (Integer -> Bool) -> Expr -> Eval Expr +numBool op (Numb x) = return $ Bool $ op x +numBool _ x = throw $ TypeMismatch "numeric op " x + +numOp :: (Integer -> Integer -> Integer) -> Expr -> Expr -> Eval Expr +numOp op (Numb x) (Numb y) = return $ Numb $ op x y +numOp _ Nil (Numb y) = return $ Numb y +numOp _ (Numb x) Nil = return $ Numb x +numOp _ x (Numb _) = throw $ TypeMismatch "numeric op" x +numOp _ (Numb _) y = throw $ TypeMismatch "numeric op" y +numOp _ x _ = throw $ TypeMismatch "numeric op" x + +strOp :: (T.Text -> T.Text -> T.Text) -> Expr -> Expr -> Eval Expr +strOp op (Tape x) (Tape y) = return $ Tape $ op x y +strOp _ Nil (Tape y) = return $ Tape y +strOp _ (Tape x) Nil = return $ Tape x +strOp _ x (Tape _) = throw $ TypeMismatch "string op" x +strOp _ (Tape _) y = throw $ TypeMismatch "string op" y +strOp _ x _ = throw $ TypeMismatch "string op" x + +eqOp :: (Bool -> Bool -> Bool) -> Expr -> Expr -> Eval Expr +eqOp op (Bool x) (Bool y) = return $ Bool $ op x y +eqOp _ x (Bool _) = throw $ TypeMismatch "bool op" x +eqOp _ (Bool _) y = throw $ TypeMismatch "bool op" y +eqOp _ x _ = throw $ TypeMismatch "bool op" x + +numCmp :: (Integer -> Integer -> Bool) -> Expr -> Expr -> Eval Expr +numCmp op (Numb x) (Numb y) = return . Bool $ op x y +numCmp _ x (Numb _) = throw $ TypeMismatch "numeric op" x +numCmp _ (Numb _) y = throw $ TypeMismatch "numeric op" y +numCmp _ x _ = throw $ TypeMismatch "numeric op" x + +notOp :: Expr -> Eval Expr +notOp (Bool True) = return $ Bool False +notOp (Bool False) = return $ Bool True +notOp x = throw $ TypeMismatch " not expects Bool" x + +eqCmd :: Expr -> Expr -> Eval Expr +eqCmd (Atom x) (Atom y) = return . Bool $ x == y +eqCmd (Numb x) (Numb y) = return . Bool $ x == y +eqCmd (Tape x) (Tape y) = return . Bool $ x == y +eqCmd (Bool x) (Bool y) = return . Bool $ x == y +eqCmd Nil Nil = return $ Bool True +eqCmd _ _ = return $ Bool False + +cons :: [Expr] -> Eval Expr +cons [x,(List ys)] = return $ List $ x:ys +cons [x,y] = return $ List [x,y] +cons _ = throw $ ExpectedList "cons, in second argument" + +car :: [Expr] -> Eval Expr +car [List [] ] = return Nil +car [List (x:_)] = return x +car [] = return Nil +car _ = throw $ ExpectedList "car" + +cdr :: [Expr] -> Eval Expr +cdr [List (_:xs)] = return $ List xs +cdr [List []] = return Nil +cdr [] = return Nil +cdr _ = throw $ ExpectedList "cdr" + +quote :: [Expr] -> Eval Expr +quote [List xs] = return $ List $ Atom "quote" : xs +quote [expr] = return $ List $ Atom "quote" : [expr] +quote args = throw $ NumArgs 1 args diff --git a/com/simatime/language/bs/repl.hs b/com/simatime/language/bs/repl.hs new file mode 100644 index 0000000..64ffaa2 --- /dev/null +++ b/com/simatime/language/bs/repl.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NoImplicitPrelude #-} +module Language.Bs.Repl ( +mainLoop +) where + +import Control.Monad.Trans +import Data.String +import Data.Text as T +import Language.Bs.Eval +import Protolude +import System.Console.Haskeline + +type Repl a = InputT IO a + +mainLoop :: IO () +mainLoop = runInputT defaultSettings repl + +repl :: Repl () +repl = do + minput <- getInputLine "bs> " + case minput of + Nothing -> outputStrLn "bye." + Just input -> (liftIO $ process input) >> repl + --Just input -> (liftIO $ processToAST input) >> repl + +process :: String -> IO () +process str = do + res <- safeExec $ evalText $ T.pack str + either putStrLn return res + +processToAST :: String -> IO () +processToAST str = print $ runParseTest $ T.pack str diff --git a/com/simatime/language/bs/test.hs b/com/simatime/language/bs/test.hs new file mode 100644 index 0000000..4a40036 --- /dev/null +++ b/com/simatime/language/bs/test.hs @@ -0,0 +1,2 @@ +-- TODO +module Language.Bs.Test where diff --git a/com/simatime/mail.nix b/com/simatime/mail.nix new file mode 100644 index 0000000..81bddc2 --- /dev/null +++ b/com/simatime/mail.nix @@ -0,0 +1,43 @@ +{ ... }: + +{ + mailserver = { + enable = true; + monitoring = { + enable = false; + alertAddress = "bsima@me.com"; + }; + fqdn = "simatime.com"; + domains = [ "simatime.com" "bsima.me" ]; + certificateScheme = 3; # let's encrypt + enableImap = true; + enablePop3 = true; + enableImapSsl = true; + enablePop3Ssl = true; + enableManageSieve = true; + virusScanning = false; # ur on ur own + localDnsResolver = true; + + loginAccounts = { + "ben@simatime.com" = { + hashedPassword = "$6$Xr180W0PqprtaFB0$9S/Ug1Yz11CaWO7UdVJxQLZWfRUE3/rarB0driXkXALugEeQDLIjG2STGQBLU23//JtK3Mz8Kwsvg1/Zo0vD2/"; + aliases = [ + # my default email + "ben@bsima.me" + # admin stuff + "postmaster@simatime.com" + "abuse@simatime.com" + ]; + catchAll = [ "simatime.com" "bsima.me" ]; + quota = "5G"; + }; + "nick@simatime.com" = { + hashedPassword = "$6$31P/Mg8k8Pezy1e$Fn1tDyssf.1EgxmLYFsQpSq6RP4wbEvP/UlBlXQhyKA9FnmFtJteXsbJM1naa8Kyylo8vZM9zmeoSthHS1slA1"; + aliases = [ + "nicolai@simatime.com" + ]; + quota = "1G"; + }; + }; + }; +} diff --git a/com/simatime/network.hs b/com/simatime/network.hs new file mode 100644 index 0000000..e47e891 --- /dev/null +++ b/com/simatime/network.hs @@ -0,0 +1,31 @@ +-- | A port of Kris Jenkins' RemoteData Elm module +-- <https://github.com/krisajenkins/remotedata>. +-- +module Com.Simatime.Network where + +data RemoteData a b + = NotAsked + | Loading + | Failure a + | Success b + deriving (Eq, Show) + +-- TODO figure out Http.Error +-- type WebData a = RemoteData Http.Error a + +instance Functor (RemoteData a) where + fmap _ NotAsked = NotAsked + fmap _ Loading = Loading + fmap _ (Failure a) = Failure a + fmap f (Success a) = Success (f a) + +instance Applicative (RemoteData e) where + pure = Success + NotAsked <*> _ = NotAsked + Loading <*> _ = Loading + Failure a <*> _ = Failure a + Success a <*> b = fmap a b + +fromEither :: Either a b -> RemoteData a b +fromEither (Left a) = Failure a +fromEither (Right a) = Success a diff --git a/com/simatime/networking.nix b/com/simatime/networking.nix new file mode 100644 index 0000000..4cfd73d --- /dev/null +++ b/com/simatime/networking.nix @@ -0,0 +1,38 @@ +{ lib, ... }: { + networking = { + + hostName = "simatime"; + + firewall = { + allowedTCPPorts = [ 22 80 443 ]; + allowPing = true; + }; + + # This following was populated at runtime with the networking details + # gathered from the active system. + nameservers = [ + "67.207.67.2" + "67.207.67.3" + ]; + defaultGateway = "159.89.128.1"; + defaultGateway6 = ""; + dhcpcd.enable = false; + usePredictableInterfaceNames = lib.mkForce true; + interfaces = { + eth0 = { + ipv4.addresses = [ + { address="159.89.128.69"; prefixLength=20; } +{ address="10.46.0.6"; prefixLength=16; } + ]; + ipv6.addresses = [ + { address="fe80::e899:c0ff:fe9c:e194"; prefixLength=64; } + ]; + }; + + }; + }; + services.udev.extraRules = '' + ATTR{address}=="ea:99:c0:9c:e1:94", NAME="eth0" + + ''; +} diff --git a/com/simatime/nixpkgs.nix b/com/simatime/nixpkgs.nix new file mode 100644 index 0000000..5d8dc56 --- /dev/null +++ b/com/simatime/nixpkgs.nix @@ -0,0 +1,5 @@ +# generated with ~/bin/nix-pin +{ + url = "https://github.com/NixOS/nixpkgs/archive/0715f2f1a9b3a1c15ddf3f7386a6d58c9a1bbe2d.tar.gz"; + sha256 = "0awm087hnsx0x5phxna5a0cm9ir6m7vha94b0q0zq5lb24clgr6s"; +} diff --git a/com/simatime/packages.nix b/com/simatime/packages.nix new file mode 100644 index 0000000..2c522f6 --- /dev/null +++ b/com/simatime/packages.nix @@ -0,0 +1,11 @@ +{ pkgs, ... }: + +{ + environment.systemPackages = [ + pkgs.wget + pkgs.ranger + pkgs.vnstat + pkgs.gitAndTools.gitFull + pkgs.python3 + ]; +} diff --git a/com/simatime/repl.scm b/com/simatime/repl.scm new file mode 100644 index 0000000..3d2f6d9 --- /dev/null +++ b/com/simatime/repl.scm @@ -0,0 +1,34 @@ +(define-module (com simatime repl) + #:use-module ((ice-9 ftw) #:prefix ftw:) + #:export (pr prn pwd ls cd)) + + +;; +;; shell-like stuff +;; +(use-modules ((ice-9 ftw) #:prefix ftw:)) + +(define (pwd) + (regexp-substitute/global + #f "/home/ben" (getcwd) 'pre "~" 'post)) + +(define (ls) + (ftw:scandir (getcwd))) + +(define (cd path) + (chdir path) + (ls)) + + +;; +;; repl customization +;; + +;; (use-modules (system repl common)) +;; (repl-default-option-set! +;; 'prompt +;; (lambda (repl) +;; (format #f "\n[~a@~a:~a]\nλ> " +;; (getenv "USER") +;; (vector-ref (uname) 1) +;; (pwd)))) diff --git a/com/simatime/sema.hs b/com/simatime/sema.hs new file mode 100644 index 0000000..f0f75da --- /dev/null +++ b/com/simatime/sema.hs @@ -0,0 +1,12 @@ +module Com.Simatime.Sema + ( mapPool + ) +where + +import qualified Control.Concurrent.MSem as Sem + +-- | Simaphore-based throttled 'mapConcurrently'. +mapPool :: Traversable t => Int -> (a -> IO b) -> t a -> IO (t b) +mapPool n f xs = do + sima <- Sem.new n + mapConcurrently (Sem.with sima . f) xs diff --git a/com/simatime/shuffle.hs b/com/simatime/shuffle.hs new file mode 100644 index 0000000..02cd3e0 --- /dev/null +++ b/com/simatime/shuffle.hs @@ -0,0 +1,122 @@ +{- | +Module : System.Random.Shuffle +Copyright : (c) 2009 Oleg Kiselyov, Manlio Perillo +License : BSD3 (see LICENSE file) + +<http://okmij.org/ftp/Haskell/perfect-shuffle.txt> + + +Example: + + import System.Random (newStdGen) + import System.Random.Shuffle (shuffle') + + main = do + rng <- newStdGen + let xs = [1,2,3,4,5] + print $ shuffle' xs (length xs) rng +-} +{-# OPTIONS_GHC -funbox-strict-fields #-} + +module System.Random.Shuffle + ( shuffle + , shuffle' + , shuffleM + ) +where + +import Data.Function ( fix ) +import System.Random ( RandomGen + , randomR + ) +import Control.Monad ( liftM + , liftM2 + ) +import Control.Monad.Random ( MonadRandom + , getRandomR + ) + + +-- | A complete binary tree, of leaves and internal nodes. +-- Internal node: Node card l r +-- where card is the number of leaves under the node. +-- Invariant: card >=2. All internal tree nodes are always full. +data Tree a = Leaf !a + | Node !Int !(Tree a) !(Tree a) + deriving Show + + +-- | Convert a sequence (e1...en) to a complete binary tree +buildTree :: [a] -> Tree a +buildTree = (fix growLevel) . (map Leaf) + where + growLevel _ [node] = node + growLevel self l = self $ inner l + + inner [] = [] + inner [e ] = [e] + inner (e1 : e2 : es) = e1 `seq` e2 `seq` (join e1 e2) : inner es + + join l@(Leaf _ ) r@(Leaf _ ) = Node 2 l r + join l@(Node ct _ _ ) r@(Leaf _ ) = Node (ct + 1) l r + join l@(Leaf _ ) r@(Node ct _ _) = Node (ct + 1) l r + join l@(Node ctl _ _) r@(Node ctr _ _) = Node (ctl + ctr) l r + + +-- |Given a sequence (e1,...en) to shuffle, and a sequence +-- (r1,...r[n-1]) of numbers such that r[i] is an independent sample +-- from a uniform random distribution [0..n-i], compute the +-- corresponding permutation of the input sequence. +shuffle :: [a] -> [Int] -> [a] +shuffle elements = shuffleTree (buildTree elements) + where + shuffleTree (Leaf e) [] = [e] + shuffleTree tree (r : rs) = + let (b, rest) = extractTree r tree in b : (shuffleTree rest rs) + shuffleTree _ _ = error "[shuffle] called with lists of different lengths" + + -- Extracts the n-th element from the tree and returns + -- that element, paired with a tree with the element + -- deleted. + -- The function maintains the invariant of the completeness + -- of the tree: all internal nodes are always full. + extractTree 0 (Node _ (Leaf e) r ) = (e, r) + extractTree 1 (Node 2 (Leaf l) (Leaf r)) = (r, Leaf l) + extractTree n (Node c (Leaf l) r) = + let (e, r') = extractTree (n - 1) r in (e, Node (c - 1) (Leaf l) r') + + extractTree n (Node n' l (Leaf e)) | n + 1 == n' = (e, l) + + extractTree n (Node c l@(Node cl _ _) r) + | n < cl + = let (e, l') = extractTree n l in (e, Node (c - 1) l' r) + | otherwise + = let (e, r') = extractTree (n - cl) r in (e, Node (c - 1) l r') + extractTree _ _ = error "[extractTree] impossible" + +-- |Given a sequence (e1,...en) to shuffle, its length, and a random +-- generator, compute the corresponding permutation of the input +-- sequence. +shuffle' :: RandomGen gen => [a] -> Int -> gen -> [a] +shuffle' elements len = shuffle elements . rseq len + where + -- The sequence (r1,...r[n-1]) of numbers such that r[i] is an + -- independent sample from a uniform random distribution + -- [0..n-i] + rseq :: RandomGen gen => Int -> gen -> [Int] + rseq n = fst . unzip . rseq' (n - 1) + where + rseq' :: RandomGen gen => Int -> gen -> [(Int, gen)] + rseq' 0 _ = [] + rseq' i gen = (j, gen) : rseq' (i - 1) gen' + where (j, gen') = randomR (0, i) gen + +-- |shuffle' wrapped in a random monad +shuffleM :: (MonadRandom m) => [a] -> m [a] +shuffleM elements + | null elements = return [] + | otherwise = liftM (shuffle elements) (rseqM (length elements - 1)) + where + rseqM :: (MonadRandom m) => Int -> m [Int] + rseqM 0 = return [] + rseqM i = liftM2 (:) (getRandomR (0, i)) (rseqM (i - 1)) diff --git a/com/simatime/users.nix b/com/simatime/users.nix new file mode 100644 index 0000000..daac9d6 --- /dev/null +++ b/com/simatime/users.nix @@ -0,0 +1,33 @@ +{ ... }: + +let + key = f: builtins.readFile (./keys/. + ("/" + f)); +in +{ + users = { + users = { + # bots + deploy = { + isNormalUser = true; + home = "/home/deploy"; + openssh.authorizedKeys.keys = [ (key "deploy.pub") ]; + extraGroups = [ "wheel" ]; + }; + + # humans + root.openssh.authorizedKeys.keys = [ (key "ben.pub") ]; + ben = { + isNormalUser = true; + home = "/home/ben"; + openssh.authorizedKeys.keys = [ (key "ben.pub") ]; + extraGroups = [ "wheel" "networkmanager" "docker" ]; + }; + nick = { + isNormalUser = true; + home = "/home/nick"; + openssh.authorizedKeys.keys = [ (key "nick.pub") ]; + extraGroups = [ "docker" ]; + }; + }; + }; +} diff --git a/com/simatime/web.nix b/com/simatime/web.nix new file mode 100644 index 0000000..d6be348 --- /dev/null +++ b/com/simatime/web.nix @@ -0,0 +1,41 @@ +{ ... }: + +let + bensIp = "69.181.254.154"; # hikuj-zupip +in +{ + services = { + nginx = { + enable = true; + recommendedGzipSettings = true; + recommendedOptimisation = true; + recommendedProxySettings = true; + recommendedTlsSettings = true; + virtualHosts = { + "bsima.me".root = "/home/ben/public_html/"; + "www.bsima.me".root = "/home/ben/public_html/"; + "simatime.com".locations."/".root = "/srv/www/"; + "firefoxsync.simatime.com".locations."/".proxyPass = "http://localhost:5001"; + "hero.simatime.com".locations."/".proxyPass = "http://${bensIp}:3001"; + "tv.simatime.com".locations."/".proxyPass = "http://${bensIp}:8096"; # emby runs on port 8096 + "deluge.simatime.com".locations."/".proxyPass = "http://${bensIp}:8112"; + + "notebook.simatime.com".locations = { + "/" = { + proxyPass = "http://${bensIp}:3099"; + proxyWebsockets = true; + extraConfig = '' + proxy_buffering off; + proxy_read_timeout 86400; + + ''; + }; + "/(api/kernels/[^/]+/channels|terminals/websocket)/" = { + proxyPass = "http://${bensIp}:3099"; + proxyWebsockets = true; + }; + }; + }; + }; + }; +} diff --git a/com/simatime/znc.nix b/com/simatime/znc.nix new file mode 100644 index 0000000..bdbe3af --- /dev/null +++ b/com/simatime/znc.nix @@ -0,0 +1,70 @@ +/* + +N.B.: generate znc passwords with 'nix-shell -p znc --command "znc --makepass"' + +- https://wiki.znc.in/Configuration + +*/ + +{ ... }: + +{ + services = { + znc = { + enable = true; + mutable = false; + useLegacyConfig = false; + openFirewall = true; + config = { + LoadModule = [ "adminlog" ]; + User.bsima = { + Admin = true; + Nick = "bsima"; + AltNick = "bsima1"; + LoadModule = [ "chansaver" "controlpanel" "log" ]; + Network.freenode = { + Server = "chat.freenode.net +6697"; + LoadModule = [ "simple_away" "nickserv" "sasl" ]; + Chan = { + "#ai" = {}; + "#biz" = { Modes = "+Sp"; }; + "#bsima" = { Modes = "+Sp"; }; + "##categorytheory" = { Detached = true; }; + "#clojure" = { Detached = true; }; + "#coq" = { Detached = true; }; + "#emacs" = { Detached = true; }; + "#guile" = { Detached = true; }; + "#guix" = { Detached = true; }; + "#haskell" = {}; + "#haskell-miso" = { Detached = true; }; + "#hledger" = {}; + "#hnix" = { Detached = true; }; + "#home-manager" = { Detached = true; }; + "#ledger" = {}; + "#nix-darwin" = { Detached = true; }; + "#nixos" = {}; + "#org-mode" = {}; + "#scheme" = { Detached = true; }; + "#servant" = { Detached = true; }; + "#sr.ht" = { Detached = true; }; + "#xmonad" = { Detached = true; }; + }; + }; + Network.efnet = { + Server = "irc.efnet.info +6697"; + LoadModule = [ "simple_away" ]; + }; + Network.sorcery = { + Server = "irc.sorcery.net +6697"; + LoadModule = [ "simple_away" ]; + }; + Pass.password = { + Method = "sha256"; + Hash = "bead16d806e7bf5cbbc31d572b20f01e2b253eb60e2497ce465df56306becd02"; + Salt = "/GhmBMc+E6b7qd8muFEe"; + }; + }; + }; + }; + }; +} |