diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,32 @@ +This module is under this "3 clause" BSD license: + +Copyright (c) 2025-2025, Daniil Iaitskov +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * The names of the contributors may not be used to endorse or + promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/app/EncodeInputUrl.hs b/app/EncodeInputUrl.hs new file mode 100644 --- /dev/null +++ b/app/EncodeInputUrl.hs @@ -0,0 +1,7 @@ +module Main where + +import LiteralFlakeInput.Prelude +import LiteralFlakeInput.UrlEncoder + +main :: IO () +main = runUrlEncoder diff --git a/app/LiteralFlakeInput.hs b/app/LiteralFlakeInput.hs new file mode 100644 --- /dev/null +++ b/app/LiteralFlakeInput.hs @@ -0,0 +1,8 @@ +module Main where + +import LiteralFlakeInput.CmdArgs +import LiteralFlakeInput.CmdRun +import LiteralFlakeInput.Prelude + +main :: IO () +main = execWithArgs runCmd diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,12 @@ +# vpn-router changelog + +## Version 0.0.4 2026-02-13 + * EKG monitoring + * SSL certificates + * **e** tool + +## Version 0.0.3 2026-02-02 + * untarred output + +## Version 0.0.1 2026-02-02 + * init diff --git a/literal-flake-input.cabal b/literal-flake-input.cabal new file mode 100644 --- /dev/null +++ b/literal-flake-input.cabal @@ -0,0 +1,253 @@ +cabal-version: 3.0 +name: literal-flake-input +version: 0.0.4 + +synopsis: Web service converting URLs into archived nix attrsets +description: + Service translates an HTTP GET path into a nix derivation that can be + used as a flake input. Such a workaround provides the ability to emulate + command line arguments in nix flakes. + + In addtition to the web service there is a command line tool __e__ + (stands for escape\/encode). The e helps with URL encoding. + + == Installation + #installation# + + === Service + #service# + + The service is already deployed at + + === NixOS module + #nixos-module# + + ==== NixOS with flakes + #nixos-with-flakes# + + Modify @\/etc\/nixos\/flake.nix@ as follows: + + > # ... + > inputs = { + > # ... + > literal-flake-input.url = "github:yaitskov/literal-flake-input"; + > }; + + > # ... + > modules = [ + > literal-flake-input.nixosModules.${system}.default + > ({ ... }: { + > programs.literal-flake-input { + > enable = true; + > port = 3000; + > }) + > ./configuration.nix + > ]; + + ==== NixOS without flakes + #nixos-without-flakes# + + > let + > lfi = builtins.fetchGit "htts://github.com/yaitskov/literal-flake-input.git?ref=master"; + > in { + > imports = + > [ # ... ./hardware-configuration.nix + > "${lfi}/nixos/non-flake-lfi.nix" + > ]; + + > programs = { + > literal-flake-input = { + > port = 3000; + > enable = true; + > }; + > }; + + == How to use + #how-to-use# + + The project flake is using + . + Another project using lfi is + . + + === Flake template + #flake-template# + + > # ... + > inputs = { + > nixpkgs.url = "github:NixOS/nixpkgs"; + > utils.url = "github:numtide/flake-utils"; + > c = { + > url = "https://lficom.me/name/Bill/"; + > flake = false; + > }; + > }; + > outputs = { self, nixpkgs, utils, c }: + > utils.lib.eachDefaultSystem (sys: + > let + > pkgs = nixpkgs.legacyPackages.${sys}; + > cnf = import c { inherit pkgs; }; + > in + > { + > packages.hello = + > pkgs.writeShellScriptBin + > "hello" + > "echo Hello ${cnf.name}"; + > }); + > # ... + + === Overriding default values + #overriding-default-values# + + > nix build --override-input c \ + > https://lficom.me/name/Bob/.tar + + There is a commant line tool __e__, that helps with boilerplates and + input validation: + + > nix build $(e -name Bob) + + The tool supports literal keyword values (e.g. @true@ and @null@), + strings, numbers, arrays and attribute sets. String quotation is + optional. All values are parsed and evaluated by __e__ with nix to catch + typos as soon as possible. + + > nix build $(e -an1 true \ + > -an2 null \ + > -an3 12 \ + > -an4 hello world \ + > -an5 [ 1 2 ] \ + > -an6 "{x = 1; y = 2; }" \ + > -an7 x: x + 1) + + The above command generates an input link which is going to be resolved + by the service into: + + > {...}: { + > an1 = true; + > an2 = null; + > an3 = 12; + > an4 = "hello wolrd"; + > an5 = [1 2]; + > an6 = {x = 1; y = 2; }; + > an7 = x: x + 1; + > } + + If you copy an URL generated by __e__ into a flake for default values, + then drop @.tar@ suffix. + + Alternative URL prefix can be set via environment variable @LFI_SITE@. + + == Development environment + #development-environment# + + > $ nix develop + > $ emacs & + > $ cabal build + > $ cabal test + + > $ nix build + > $ ./result/bin/literal-flake-input run + > $ nix build $(./result/bin/e -static true) +homepage: http://github.com/yaitskov/literal-flake-input +license: BSD-3-Clause +license-file: LICENSE +author: Daniil Iaitskov +maintainer: dyaitskov@gmail.com +copyright: Daniil Iaitkov 2026 +category: System +build-type: Simple +bug-reports: https://github.com/yaitskov/literal-flake-input/issues +extra-doc-files: + changelog.md +tested-with: + GHC == 9.12.2 + +source-repository head + type: + git + location: + https://github.com/yaitskov/literal-flake-input.git + +common base + default-language: GHC2024 + ghc-options: -Wall + default-extensions: + DefaultSignatures + NoImplicitPrelude + OverloadedStrings + TemplateHaskell + build-depends: + base >=4.7 && < 5 + , optparse-applicative < 1 + , relude >= 1.2.2 && < 2 + , tagged < 1 + , unliftio < 1 + , yesod-core < 1.8 + +library + import: base + hs-source-dirs: src + exposed-modules: + LiteralFlakeInput.App + LiteralFlakeInput.CmdArgs + LiteralFlakeInput.CmdRun + LiteralFlakeInput.Nix + LiteralFlakeInput.Page + LiteralFlakeInput.Prelude + LiteralFlakeInput.UrlEncoder + other-modules: + Paths_literal_flake_input + autogen-modules: + Paths_literal_flake_input + build-depends: + , binary < 1 + , ekg-core < 1 + , ekg-wai < 1 + , file-embed < 1 + , hnix < 1 + , http-types < 1 + , monad-logger < 1 + , ref-tf < 1 + , regex-tdfa < 2 + , tar < 1 + , template-haskell < 3 + , time < 2 + , trace-embrace < 2 + , warp < 4 + , warp-tls < 4 + , wl-pprint-text < 2 + +test-suite test + import: base + type: exitcode-stdio-1.0 + main-is: Driver.hs + other-modules: + LiteralFlakeInput.Test.Nix + Discovery + hs-source-dirs: + test + ghc-options: -Wall -rtsopts -threaded -main-is Driver + build-depends: + , literal-flake-input + , QuickCheck + , tasty + , tasty-discover + , tasty-hunit + , tasty-quickcheck + +executable literal-flake-input + import: base + ghc-options: -Wall -threaded "-with-rtsopts=-T -N" + main-is: LiteralFlakeInput.hs + hs-source-dirs: app + build-depends: + , literal-flake-input + +executable e + import: base + ghc-options: -Wall -threaded "-with-rtsopts=-N" + main-is: EncodeInputUrl.hs + hs-source-dirs: app + build-depends: + , literal-flake-input diff --git a/src/LiteralFlakeInput/App.hs b/src/LiteralFlakeInput/App.hs new file mode 100644 --- /dev/null +++ b/src/LiteralFlakeInput/App.hs @@ -0,0 +1,10 @@ +module LiteralFlakeInput.App where + +import LiteralFlakeInput.Prelude + ( ($), String, MonadIO, HasCallStack ) +import UnliftIO.Exception ( stringException, throwIO ) + +type NetM m = (HasCallStack, MonadIO m) + +ex :: NetM m => String -> m a +ex em = throwIO $ stringException em diff --git a/src/LiteralFlakeInput/CmdArgs.hs b/src/LiteralFlakeInput/CmdArgs.hs new file mode 100644 --- /dev/null +++ b/src/LiteralFlakeInput/CmdArgs.hs @@ -0,0 +1,85 @@ +module LiteralFlakeInput.CmdArgs where + +import Options.Applicative +import LiteralFlakeInput.Prelude + + +data HttpPort +data EkgPort +data Cert +data CertKey + +data CmdArgs + = RunService + { httpPortToListen :: Tagged HttpPort Int + , certFile :: Maybe (Tagged Cert FilePath) + , keyFile :: Maybe (Tagged CertKey FilePath) + , ekgPort :: Maybe (Tagged EkgPort Int) + } + | LiteralFlakeInputVersion + deriving (Eq, Show) + +execWithArgs :: MonadIO m => (CmdArgs -> m a) -> m a +execWithArgs a = a =<< liftIO (execParser $ info (cmdp <**> helper) phelp) + where + serviceP = RunService <$> portOption <*> certO <*> certKeyO <*> ekgPortOption + cmdp = + hsubparser + ( command "run" (infoP serviceP "launch the service exposed over HTTP") + <> command "version" (infoP (pure LiteralFlakeInputVersion) "print program version")) + + infoP p h = info p (progDesc h <> fullDesc) + phelp = + progDesc + "Translates HTTP GET params into Nix attrset" + +portOption :: Parser (Tagged HttpPort Int) +portOption = Tagged <$> + option auto + ( long "port" + <> short 'p' + <> showDefault + <> value 3042 + <> help "HTTP port to listen" + <> metavar "PORT" + ) + +ekgPortOption :: Parser (Maybe (Tagged EkgPort Int)) +ekgPortOption = pured . zeroToNothing <$> + option auto + ( long "ekg-port" + <> short 'e' + <> value 0 + <> help "HTTP port for EKG monitoring. Zero to disable." + <> metavar "EKG" + ) + +emptyToNothing :: FilePath -> Maybe FilePath +emptyToNothing "" = Nothing +emptyToNothing s = Just s + +zeroToNothing :: Int -> Maybe Int +zeroToNothing s | s <= 0 = Nothing + | otherwise = Just s + +pured :: (Applicative g, Applicative f) => g a -> g (f a) +pured = fmap pure + +certO :: Parser (Maybe (Tagged Cert FilePath)) +certO = pured . emptyToNothing <$> + strOption + ( long "certificate" + <> short 'c' + <> value "" + <> help "path to SSL certificate file (./certificate.pem)" + <> metavar "CERT" + ) +certKeyO :: Parser (Maybe (Tagged CertKey FilePath)) +certKeyO = pured . emptyToNothing <$> + strOption + ( long "key" + <> short 'k' + <> value "" + <> help "path to key file of SSL certificate (./key.pem)" + <> metavar "KEY" + ) diff --git a/src/LiteralFlakeInput/CmdRun.hs b/src/LiteralFlakeInput/CmdRun.hs new file mode 100644 --- /dev/null +++ b/src/LiteralFlakeInput/CmdRun.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedRecordDot #-} +module LiteralFlakeInput.CmdRun where + +import Control.Monad.Logger ( liftLoc, ToLogStr(toLogStr) ) +import Data.Version (showVersion) +import Language.Haskell.TH.Syntax (qLocation) +import LiteralFlakeInput.Page ( Ypp(Ypp), YppMetrics (YppMetrics) ) +import LiteralFlakeInput.CmdArgs ( CmdArgs(..), CertKey, Cert ) +import LiteralFlakeInput.Prelude +import Network.Wai.Handler.WarpTLS ( runTLS, tlsSettings, TLSSettings ) +import Network.Wai.Handler.Warp + ( Settings, + setBeforeMainLoop, + setMaxTotalHeaderLength, + setOnException, + setPort, + setServerName, + setSlowlorisSize, + setTimeout, + runSettings, + defaultSettings, + defaultShouldDisplayException ) +import Paths_literal_flake_input ( version ) +import System.Metrics ( createCounter, newStore, registerGcMetrics ) +import System.Remote.Monitoring.Wai ( forkServerWith ) +import Yesod.Core + ( toWaiApp, + LogLevel(LevelError), + Application, + Yesod(makeLogger, messageLoggerSource) ) +import Yesod.Core.Types ( Logger ) + +mkSettings :: Ypp -> CmdArgs -> Logger -> Settings +mkSettings yp ca logger = + setPort port $ + setServerName "LiteralFlakeInput" $ + setOnException onEx $ + setSlowlorisSize 1024 $ + setMaxTotalHeaderLength 1024 $ + setBeforeMainLoop + (putStrLn $ "Go http://localhost:" <> show port <> "/hello/42/prod/true/plugin/null/name/Alice") $ + setTimeout 9 + defaultSettings + + where + port = untag ca.httpPortToListen + shouldLog' = defaultShouldDisplayException + onEx _ e = + when (shouldLog' e) $ + messageLoggerSource + yp + logger + $(qLocation >>= liftLoc) + "yesod-core" + LevelError + (toLogStr $ "Exception from Warp: " ++ show e) + +mkTlsSettings :: Tagged Cert FilePath -> Tagged CertKey FilePath -> TLSSettings +mkTlsSettings cert key = tlsSettings (untag cert) (untag key) + +runPlain :: Settings -> Application -> IO () +runPlain = runSettings + +runCmd :: CmdArgs -> IO () +runCmd = \case + rs@RunService {} -> do + st <- newStore + registerGcMetrics st + myMetrics <- YppMetrics <$> createCounter "landing.requests" st <*> createCounter "api.requests" st + forM_ rs.ekgPort $ \(Tagged ep) -> do + putStrLn $ "Launch EKG on port " <> show ep + forkServerWith st "0.0.0.0" ep + + $(trIo "start/rs") + let y = Ypp st myMetrics + logger <- makeLogger y + case liftA2 mkTlsSettings rs.certFile rs.keyFile of + Nothing -> runPlain (mkSettings y rs logger) =<< toWaiApp y + Just tlsSngs -> runTLS tlsSngs (mkSettings y rs logger) =<< toWaiApp y + LiteralFlakeInputVersion -> + putStrLn $ "Version " <> showVersion version diff --git a/src/LiteralFlakeInput/Nix.hs b/src/LiteralFlakeInput/Nix.hs new file mode 100644 --- /dev/null +++ b/src/LiteralFlakeInput/Nix.hs @@ -0,0 +1,92 @@ +module LiteralFlakeInput.Nix where + +import Data.Text.Lazy ( concat ) +import Codec.Archive.Tar ( write ) +import Codec.Archive.Tar.Entry ( fileEntry, toTarPath, TarPath ) +import LiteralFlakeInput.Prelude + ( otherwise, + show, + ($), + (<$>), + Eq, + Show, + Semigroup((<>)), + Bool(False), + Either(Left, Right), + Text, + LazyStrict(toLazy), + uncurry, + (.), + LText, + error, + ConvertUtf8(encodeUtf8), + LByteString, + Bool(True), + ToText(toText) ) +import Text.Regex.TDFA ( (=~) ) +import Yesod.Core + ( ToTypedContent(..), + TypedContent(TypedContent), + ToContent(..), + ContentType ) + +data OutFormat = TaredNix | PlainNix deriving (Show, Eq) +newtype NixDer (o :: OutFormat) = NixDer [(Text, Text)] deriving (Show, Eq) + +instance ToContent (NixDer PlainNix) where + toContent = toContent . renderNixDer + +instance ToContent (NixDer TaredNix) where + toContent = toContent . mkTar . renderNixDer + +instance ToTypedContent (NixDer PlainNix) where + toTypedContent = TypedContent xPlainNix . toContent + +instance ToTypedContent (NixDer TaredNix) where + toTypedContent = TypedContent xTarMime . toContent + +pairs :: [a] -> [(a, a)] +pairs (a:b:t) = (a, b) : pairs t +pairs [_] = [] +pairs [] = [] + +xTarMime :: ContentType +xTarMime = "application/x-tar" + +xPlainNix :: ContentType +xPlainNix = "text/x-nix" + +defaultNixName :: TarPath +defaultNixName = + case toTarPath False "default.nix" of + Right v -> v + Left e -> error $ toText e + +mkTar :: LText -> LByteString +mkTar txt = write [e] + where + e = fileEntry defaultNixName $ encodeUtf8 txt + +{- HLINT ignore "Use concatMap" -} +renderNixDer :: NixDer o -> LText +renderNixDer (NixDer m) = + "{...}:{" <> concat (uncurry renderEntry <$> m) <> "}" + +isUnquotedString :: Text -> Bool +isUnquotedString s + | s =~ ("^(true|false|null|-?[0-9]+([.][0-9]+)?|\".*\"|[[].*|[{].*|[a-zA-Z_][a-zA-Z0-9_-]*[a-zA-Z0-9_]*:.*)$" :: Text) = False + | otherwise = True + +quoteString :: Text -> Text +quoteString = show + +quoteUnquotedString :: Text -> Text +quoteUnquotedString s + | isUnquotedString s = quoteString s + | otherwise = s + +renderEntry :: Text -> Text -> LText +renderEntry k v = toLazy k <> "=" <> toLazy (quoteUnquotedString v) <> ";" + +translate :: [Text] -> NixDer o +translate = NixDer . pairs diff --git a/src/LiteralFlakeInput/Page.hs b/src/LiteralFlakeInput/Page.hs new file mode 100644 --- /dev/null +++ b/src/LiteralFlakeInput/Page.hs @@ -0,0 +1,290 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE MultilineStrings #-} +module LiteralFlakeInput.Page where + +import Data.Binary.Builder (fromByteString) +import Data.ByteString qualified as BS +import Data.FileEmbed ( embedFile, makeRelativeToProject ) +import Data.Text (isSuffixOf) +import Data.Version (showVersion) +import LiteralFlakeInput.Nix + ( translate, OutFormat(PlainNix, TaredNix), NixDer(..)) +import LiteralFlakeInput.Prelude +import Paths_literal_flake_input ( version ) +import System.Metrics ( Store ) +import Yesod.Core + ( Yesod(defaultLayout, makeSessionBackend), + notFound, + getYesod, + RenderRoute(renderRoute), + ToTypedContent(..), + TypedContent(TypedContent), + Html, + Content(ContentBuilder), + ToContent(..), + ToWidgetHead(toWidgetHead), + preEscapedToMarkup, + Texts, + mkYesod, + parseRoutes, + logInfo, + addContentDispositionFileName, + setTitle, + hamlet, + lucius, + whamlet, + typeXml, + typePlain, + typeSvg, notFound ) + +import System.Metrics.Counter ( Counter, inc ) + +data YppMetrics + = YppMetrics + { landingPage :: Counter + , apiCall :: Counter + } + +data Ypp + = Ypp + { metricsStore :: Store + , yppMetrics :: YppMetrics + } + +mkYesod "Ypp" [parseRoutes| +/*{Texts} HomeR GET +|] + +instance Yesod Ypp where + makeSessionBackend _ = pure Nothing + +data Contentable = forall x. (ToContent x, ToTypedContent x) => Contentable x +instance ToContent Contentable where + toContent (Contentable x) = toContent x + +instance ToTypedContent Contentable where + toTypedContent (Contentable x) = toTypedContent x + +newtype FavIcon = FavIcon ByteString + +instance ToContent FavIcon where + toContent (FavIcon bs) = + ContentBuilder (fromByteString bs) (Just . fromIntegral $ BS.length bs) +instance ToTypedContent FavIcon where + toTypedContent = TypedContent typeSvg . toContent + +getFavIcon :: Handler FavIcon +getFavIcon = pure $ FavIcon $(makeRelativeToProject "assets/favicon.svg" >>= embedFile) + +getGithubIcon :: Handler FavIcon +getGithubIcon = pure $ FavIcon $(makeRelativeToProject "assets/github.svg" >>= embedFile) + +getSiteMap :: Handler TypedContent +getSiteMap = pure . TypedContent typeXml $ toContent $(makeRelativeToProject "assets/sitemap.xml" >>= embedFile) + +getRobots :: Handler TypedContent +getRobots = pure . TypedContent typePlain $ toContent $(makeRelativeToProject "assets/robots.txt" >>= embedFile) + +-- getRobots :: Handler TypedContent +-- getRobots = pure . TypedContent typePlain $ toContent "" $(makeRelativeToProject "assets/robots.txt" >>= embedFile) + +getHomeR :: Texts -> Handler Contentable +getHomeR params = + case nonEmpty params of + Nothing -> Contentable <$> landing + Just (p :| []) -> + case p of + "favicon.svg" -> Contentable <$> getFavIcon + "github.svg" -> Contentable <$> getGithubIcon + "robots.txt" -> Contentable <$> getRobots + "sitemap.xml" -> Contentable <$> getSiteMap + "version" -> + pure . Contentable . TypedContent typePlain . toContent $ + "Literal Flake Input " <> showVersion version + "index.html" -> Contentable <$> landing + _ -> notFound + Just p | ".tar" `isSuffixOf` last p -> + trans (Proxy @TaredNix) "file.tar" + | otherwise -> + trans (Proxy @PlainNix) "default.nix" + where + trans :: forall tw. ToTypedContent (NixDer tw) => Proxy tw -> Text -> Handler Contentable + trans _ fileName = do + yp <- getYesod + liftIO (inc $ apiCall $ yppMetrics yp) + $(logInfo) $ "Translate " <> show params + addContentDispositionFileName fileName $> Contentable (translate params :: NixDer tw) + +generatedNixExpr :: Text +generatedNixExpr = + """ + { ... }: + { + name = "Alice Wonder"; + age = 18; + alive = true; + job = null; + } + """ + +nixAndE :: Text +nixAndE = """nix build $(e -name Bob)""" + +fullTypeRangeOfE :: Text +fullTypeRangeOfE = + """ + nix build $(e -an1 true \\ + -an2 null \\ + -an3 12 \\ + -an4 hello world \\ + -an5 [ 1 2 ] \\ + -an6 "{x = 1; y = 2; }" \\ + -an7 x: x + 1) + """ + +fullTypeRangeInputBody :: Text +fullTypeRangeInputBody = + """ + {...}: { + an1 = true; + an2 = null; + an3 = 12; + an4 = "hello wolrd"; + an5 = [1 2]; + an6 = {x = 1; y = 2; }; + an7 = x: x + 1; + } + """ + +nixFlakeTemplate :: Text +nixFlakeTemplate = + """ + # ... + inputs = { + nixpkgs.url = "github:NixOS/nixpkgs"; + utils.url = "github:numtide/flake-utils"; + c = { + url = "https://lficom.me/static/false/"; + flake = false; + }; + }; + outputs = { self, nixpkgs, utils, c }: + utils.lib.eachDefaultSystem (sys: + let + pkgs = nixpkgs.legacyPackages.${sys}; + cnf = import c { inherit pkgs; }; + in + { + packages.hello = + pkgs.writeShellScriptBin + "hello" + "echo Hello ${cnf.name}"; + }); + # ... + """ + +nixBuildWithOverride :: Text +nixBuildWithOverride = + """ + nix build --override-input c \\ + https://lficom.me/name/Bob/.tar + """ + +landing :: Handler Html +landing = do + yp <- getYesod + liftIO (inc $ landingPage $ yppMetrics yp) + defaultLayout $ do + setTitle "Literal Flake Input" + toWidgetHead + [hamlet| + + + + + + + |] + toWidgetHead + [lucius| + body { + background: #7CED53; + background: radial-gradient(circle, rgb(182 213 217) 0%, rgb(205 255 253) 80%, rgb(206 214 255) 100%); + padding: 0px 4%; + color: #171717; + } + img.github { + width: 8vh; + opacity: 0.8; + padding-top: 5vh; + } + h1 a { + font-size: x-large; + text-decoration: none; + color: #e64d4d; + } + pre { + font-size: small; + } + .wrap { + white-space: pre-wrap; + text-indent: -2em; + padding-left: 2em; + } + |] + [whamlet| +

+ + Literal Flake Input +

+ Service translates an HTTP GET path into a nix derivation + that can be used as a flake input. Such a workaround provides + the ability to emulate command line arguments in nix flakes. + 

+              wget -q -O - 'https://lficom.me/name/Alice Wonder/age/18/alive/true/job/null/'
+            

+              Response body
+            
+              #{preEscapedToMarkup generatedNixExpr}
+
+            

+              nixpkgs derivations can accept command line arguments but nix flakes don't.
+            

+              Flake template
+            
+              #{preEscapedToMarkup nixFlakeTemplate}
+            

+              Override
+            
+              #{preEscapedToMarkup nixBuildWithOverride}
+            

+              There is a commant line tool e, that helps with boilerplates and
+              input validation:
+            
+              #{preEscapedToMarkup nixAndE}
+            

+              The tool supports literal keyword values (e.g. true and null),
+              strings, numbers, arrays and attribute sets.  String quotation is
+              optional. All values are parsed and evaluated by e with nix to catch typos
+              as soon as possible.
+            
+              #{preEscapedToMarkup fullTypeRangeOfE}
+            

+              The above command generates an input link which is going to be resolved
+              by the service into:
+            
+              #{preEscapedToMarkup fullTypeRangeInputBody}
+            

+              If you copy an URL generated by e into a flake for default
+              values, then drop .tar suffix.
+            

+              Alternative URL prefix can be set via environment variable LFI_SITE.
+
+            

+              

+                
+                  
+
+            |]
diff --git a/src/LiteralFlakeInput/Prelude.hs b/src/LiteralFlakeInput/Prelude.hs
new file mode 100644
--- /dev/null
+++ b/src/LiteralFlakeInput/Prelude.hs
@@ -0,0 +1,5 @@
+module LiteralFlakeInput.Prelude (module X) where
+
+import Data.Tagged as X
+import Relude as X hiding (Handle, intercalate)
+import Debug.TraceEmbrace as X hiding (a)
diff --git a/src/LiteralFlakeInput/UrlEncoder.hs b/src/LiteralFlakeInput/UrlEncoder.hs
new file mode 100644
--- /dev/null
+++ b/src/LiteralFlakeInput/UrlEncoder.hs
@@ -0,0 +1,130 @@
+{-# LANGUAGE MultilineStrings #-}
+module LiteralFlakeInput.UrlEncoder where
+import Data.Binary.Builder (fromByteString, toLazyByteString)
+import Data.List.NonEmpty qualified as NL
+import Data.Map.Strict qualified as M
+import Data.Text qualified as T
+import Data.Time.Clock ( getCurrentTime )
+import Data.Version (showVersion)
+import LiteralFlakeInput.Nix ( quoteUnquotedString )
+import LiteralFlakeInput.Prelude
+import Network.HTTP.Types (encodePathSegments)
+import Nix
+    ( Options,
+      nixEvalExprLoc,
+      normalForm,
+      defaultOptions,
+      parseNixTextLoc )
+import Nix.Standard ( runWithBasicEffectsIO )
+import Paths_literal_flake_input ( version )
+import System.Environment.Blank (getEnvDefault)
+import Text.PrettyPrint.Leijen.Text (linebreak, text, putDoc, vcat, indent)
+import Text.Regex.TDFA ( (=~) )
+
+runUrlEncoder :: IO ()
+runUrlEncoder = runUrlEncoderWith . fmap toText =<< getArgs
+
+runUrlEncoderWith :: [Text] -> IO ()
+runUrlEncoderWith args
+  | args `elem` [["--version"], ["-v"]] = do
+    putStrLn $ "Literal Flake Input " <> showVersion version
+    exitFailure
+  | args `elem` [[], ["-h"], ["-help"], ["--help"], ["-help"], ["help"]] = do
+    putStrLn """Literal Flake Input (LFI) URL encoder
+      Usage: nix build $(e -an1 true \\
+                           -an2 null \\
+                           -an3 12 \\
+                           -an4 hello world \\
+                           -an5 [ 1 2 ] \\
+                           -an6 "{x = 1; y = 2; }" \\
+                           -an7 x: x + 1)
+
+      The result is a non-flake URL input:
+      nix build --override-input c https://lficom.me/an1/true/an2/null/an3/42/an4/%22hello%20world%22/an5/%5B%201%202%20%5D/an6/%7Bx%20=%201%3B%20y%20=%202%3B%20%7D/an7/a:%20a%20+%201/.tar
+
+      LFI translates arbitrary command line arguments into a Nix attribute set.
+      Nix values are verified with hnix interpreter.
+
+      URL prefix can be overriden via environment variable LFI_SITE.
+      If you copy URL into flake file as a default value then drop tar suffix.
+
+      Project home page https://github.com/yaitskov/literal-flake-input"""
+    exitFailure
+  | length args == 1 = do
+    putStrLn """LFI expects "even" number of argument. See help by -h or --help"""
+    exitFailure
+  | otherwise =
+    case fmap (quoteUnquotedString . joinArgValueWords) <$> groupByAttrName args of
+      Left e -> putStrLn (toString e) >> exitFailure
+      Right m -> do
+        time <- getCurrentTime
+        let opts = defaultOptions time
+        (goodAtrs, badAtrs) <- M.partition isRight <$> M.traverseWithKey (go opts) m
+        if null badAtrs then
+          do
+            siteRoot <- toText <$> getEnvDefault "LFI_SITE" siteRootDef
+            putLBSLn . mkLfiUrl siteRoot . M.mapKeys argToAtr $ M.mapMaybe rightToMaybe goodAtrs
+          else
+          do
+            putDoc $ text "Invalid attribute(s):" <> linebreak <>
+              idnt4 (vcat . mapMaybe leftToMaybe $ M.elems badAtrs) <>
+              linebreak
+            exitFailure
+  where
+    idnt4 = indent 4
+    siteRootDef = "https://lficom.me"
+    go opts (ArgName an) av = do
+      validateNixExpr opts av >>= \case
+        Left e -> pure . Left $
+          (text (toLazy an) <> linebreak <> (idnt4 . vcat . fmap (text . toLazy) $ lines e))
+        Right () -> pure $ Right av
+
+newtype ArgName = ArgName Text deriving newtype (Eq, Show, Ord)
+newtype AtrName = AtrName Text deriving newtype (Eq, Show, Ord)
+
+argToAtr :: ArgName -> AtrName
+argToAtr (ArgName s) = AtrName (T.drop 1 s)
+
+isAtrName :: Text -> Bool
+isAtrName = (=~ ("^[-][a-zA-Z_][a-zA-Z0-9_-]*[a-zA-Z0-9_]*$" :: Text))
+
+groupByAttrName :: [Text] -> Either Text (Map ArgName (NonEmpty Text))
+groupByAttrName [] = Right M.empty
+groupByAttrName [a] = Left $ "Attribute [" <> a <> "] has no value"
+groupByAttrName (atrN:argsLeft)
+  | isAtrName atrN =
+      case break isAtrName argsLeft of
+        (atrVs, nextAtr) ->
+          case nonEmpty atrVs of
+            Nothing -> Left $ "Attribute [" <> atrN <> "] has no value"
+            Just neAtrVs ->
+              M.insert (ArgName atrN) neAtrVs <$> groupByAttrName nextAtr
+  | otherwise = Left $ "Attribute name [" <> atrN <> "] is not valid"
+
+joinArgValueWords :: NonEmpty Text -> Text
+joinArgValueWords =  unwords . NL.toList
+
+
+validateNixExpr :: Options -> Text -> IO (Either Text ())
+validateNixExpr o nxe =
+  case parseNixTextLoc nxe of
+    Left e ->
+      pure . Left $ "[" <> nxe <>  "] is bad Nix expression due:" <> show e
+    Right e ->
+      runWithBasicEffectsIO o $ do
+        !_ <- getNormForm e
+        pure $ Right ()
+  where
+    getNormForm = normalForm <=< nixEvalExprLoc mempty
+
+mkLfiUrl :: Text -> Map AtrName Text -> LByteString
+mkLfiUrl siteRoot w =
+  toLazyByteString $
+    "--override-input c " <>
+    fromByteString (encodeUtf8 siteRoot) <>
+    encodePathSegments (flatpairs $ M.toList w)
+    <> "/.tar"
+  where
+   flatpairs :: [(AtrName, Text)] -> [Text]
+   flatpairs [] = []
+   flatpairs ((AtrName an, av):t) = an : av : flatpairs t
diff --git a/test/Discovery.hs b/test/Discovery.hs
new file mode 100644
--- /dev/null
+++ b/test/Discovery.hs
@@ -0,0 +1,1 @@
+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --generated-module=Discovery #-}
diff --git a/test/Driver.hs b/test/Driver.hs
new file mode 100644
--- /dev/null
+++ b/test/Driver.hs
@@ -0,0 +1,13 @@
+module Driver where
+
+import qualified Discovery
+import Relude
+import Test.Tasty
+
+main :: IO ()
+main = defaultMain =<< testTree
+  where
+    testTree :: IO TestTree
+    testTree = do
+      tests <- Discovery.tests
+      pure $ testGroup "literal-flake-input" [ tests ]
diff --git a/test/LiteralFlakeInput/Test/Nix.hs b/test/LiteralFlakeInput/Test/Nix.hs
new file mode 100644
--- /dev/null
+++ b/test/LiteralFlakeInput/Test/Nix.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE MultilineStrings #-}
+module LiteralFlakeInput.Test.Nix where
+
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit
+import LiteralFlakeInput.Prelude
+import LiteralFlakeInput.Nix
+
+test_render :: TestTree
+test_render =
+  testGroup "render"
+  [ testGroup "renderEntry"
+    [ testCase "nat"
+      $ renderEntry "a" "1" @?= "a=1;"
+    , testCase "bool"
+      $ renderEntry "a" "true" @?= "a=true;"
+    , testCase "false"
+      $ renderEntry "a" "false" @?= "a=false;"
+    , testCase "null"
+      $ renderEntry "a" "null" @?= "a=null;"
+    , testCase "string"
+      $ renderEntry "a" "hello world" @?= "a=\"hello world\";"
+    , testCase "esc double quote"
+      $ renderEntry "a" "hello \" world" @?= "a=\"hello \\\" world\";"
+    , testCase "esc left slash"
+      $ renderEntry "a" "hello \\" @?= "a=\"hello \\\\\";"
+    , testCase "quoted"
+      $ renderEntry "a" "\"hello\"" @?= "a=\"hello\";"
+    , testCase "list"
+      $ renderEntry "a" "[1 2]" @?= "a=[1 2];"
+    , testCase "attr-set"
+      $ renderEntry "a" "{x = 1; y = 2}" @?= "a={x = 1; y = 2};"
+    , testCase "lambda"
+      $ renderEntry "a" "x: x + 1" @?= "a=x: x + 1;"
+    , testCase "empty"
+      $ renderEntry "a" "" @?= "a=\"\";"
+    ]
+  , testGroup "renderNixDer"
+    [ testCase "empty"
+      $ renderNixDer (NixDer []) @?= """{...}:{}"""
+    , testCase "one"
+      $ renderNixDer (NixDer [("key", "value")]) @?= """{...}:{key="value";}"""
+    , testCase "two"
+      $ renderNixDer (NixDer [("key", "value"), ("key2", "value2")])
+      @?= """{...}:{key="value";key2="value2";}"""
+    ]
+  ]