initial commit

.envrc

@@ -0,0 +1 @@
+use flake . --builders ""

.gitignore

@@ -21,3 +21,6 @@ cabal.project.local
 cabal.project.local~
 .HTF/
 .ghc.environment.*
+
+# Nix
+result/

README.md

@@ -0,0 +1,12 @@
+# rafmonad
+
+An annoyingly simple webserver written in Haskell. Serves a `.txt` file as plaintext on
+`http://localhost:3000`. Not configurable, has no logging or error handling. Written
+because I can.
+
+
+## Using
+
+Don't.
+
+

contents.txt

@@ -0,0 +1 @@
+Hello, world!

flake.lock

@@ -0,0 +1,24 @@
+{
+  "nodes": {
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1708118438,
+        "narHash": "sha256-kk9/0nuVgA220FcqH/D2xaN6uGyHp/zoxPNUmPCMmEE=",
+        "path": "/nix/store/bg5fbkfa5x53clcjf4p5p92k1l3w8x38-source",
+        "rev": "5863c27340ba4de8f83e7e3c023b9599c3cb3c80",
+        "type": "path"
+      },
+      "original": {
+        "id": "nixpkgs",
+        "type": "indirect"
+      }
+    },
+    "root": {
+      "inputs": {
+        "nixpkgs": "nixpkgs"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

flake.nix

@@ -0,0 +1,46 @@
+{
+  description = "rafmonad: a annoyingly simple webserver";
+  inputs.nixpkgs.url = "github:NixOS/nixpkgs/nixpkgs-unstable";
+
+  outputs = {
+    self,
+    nixpkgs,
+  }: let
+    supportedSystems = ["x86_64-linux"];
+    forAllSystems = f: nixpkgs.lib.genAttrs supportedSystems (system: f system);
+    nixpkgsFor = forAllSystems (system:
+      import nixpkgs {
+        inherit system;
+        overlays = [self.overlays.default];
+      });
+  in {
+    overlays = final: _prev: {
+      rafmonad = final.haskellPackages.callCabal2nix "rafmonad" ./. {};
+      default = self.overlays.rafmonad;
+    };
+
+    packages = forAllSystems (system: {
+      inherit (nixpkgsFor.${system}) rafmonad;
+      default = nixpkgsFor.${system}.rafmonad;
+    });
+
+    checks = self.packages;
+
+    devShell = forAllSystems (system: let
+      inherit (nixpkgsFor.${system}) haskellPackages;
+    in
+      haskellPackages.shellFor {
+        withHoogle = true;
+
+        packages = _: [self.packages.${system}.rafmonad];
+        buildInputs = with haskellPackages; [
+          haskell-language-server
+          ghcid
+          cabal-install
+        ];
+
+        # Change the prompt to show that you are in a devShell
+        shellHook = "export PS1='\\e[1;34mDEV ~ > \\e[0m'";
+      });
+  };
+}

package.yaml

@@ -0,0 +1,9 @@
+dependencies:
+  - base >= 4.6
+  - bytestring
+  - http2
+  - network
+  - async
+executables:
+  rafmonad:
+    main: src/net.hs

src/net.hs

@@ -0,0 +1,48 @@
+module Main where
+
+import Network.Socket
+import Network.Socket.ByteString (sendAll)
+import Control.Monad (forever)
+import qualified System.IO as IO (Handle, hGetLine, hPutStr, hFlush, hClose)
+import System.IO (readFile)
+import Data.ByteString.Char8 as B (pack)
+
+main :: IO ()
+main = withSocketsDo $ do
+    addr <- resolve "127.0.0.1" "3000" -- listen on port 3000
+    open addr
+
+resolve :: HostName -> ServiceName -> IO AddrInfo
+resolve host port = do
+    let hints = defaultHints { addrFlags = [AI_PASSIVE]
+                              , addrSocketType = Stream
+                              }
+    head <$> getAddrInfo (Just hints) (Just host) (Just port)
+
+open :: AddrInfo -> IO ()
+open addr = do
+    sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+    setSocketOption sock ReuseAddr   1
+    bind sock $ addrAddress addr
+    listen sock   10
+    -- putting the log header manually is funny
+    -- but I don't want to define anything to proramatically
+    -- prepend the log header to the log message
+    -- since I do not log anything else *yet*
+    putStrLn "[LOG] Listening on port: 3000" -- maybe the port needs to be configurable
+    forever $ do
+        (conn, _) <- accept sock
+        handleRequest conn
+
+drainHeaders :: IO.Handle -> IO ()
+drainHeaders h = do
+  line <- IO.hGetLine h
+  if line == "\r" then return () else drainHeaders h
+
+handleRequest :: Socket -> IO ()
+handleRequest conn = do
+    content <- readFile "contents.txt"
+    let response = "HTTP/2.1   200 OK\r\nContent-Type: text/plain\r\n\r\n" ++ content
+    sendAll conn $ B.pack response
+    close conn
+