diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..fcffbd5 --- /dev/null +++ b/.envrc @@ -0,0 +1 @@ +use flake . --builders "" diff --git a/.gitignore b/.gitignore index 4c9e245..8ac718c 100644 --- a/.gitignore +++ b/.gitignore @@ -21,3 +21,6 @@ cabal.project.local cabal.project.local~ .HTF/ .ghc.environment.* + +# Nix +result/ diff --git a/README.md b/README.md new file mode 100644 index 0000000..5ead585 --- /dev/null +++ b/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. + + diff --git a/contents.txt b/contents.txt new file mode 100644 index 0000000..af5626b --- /dev/null +++ b/contents.txt @@ -0,0 +1 @@ +Hello, world! diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..f0b6f9b --- /dev/null +++ b/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 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..73543f4 --- /dev/null +++ b/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'"; + }); + }; +} diff --git a/package.yaml b/package.yaml new file mode 100644 index 0000000..ec4b480 --- /dev/null +++ b/package.yaml @@ -0,0 +1,9 @@ +dependencies: + - base >= 4.6 + - bytestring + - http2 + - network + - async +executables: + rafmonad: + main: src/net.hs diff --git a/src/net.hs b/src/net.hs new file mode 100644 index 0000000..2a2dbfe --- /dev/null +++ b/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 +