{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}

-- |
-- Module: Censor.Runner.Manifest
-- Copyright: (c) 2026 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- A declarative battery for the @censor@ CLI: run-wide defaults and
-- a list of cases, each naming a target symbol and the workspace
-- layout to drive it with. One invocation opens the library once and
-- emits one @censor\/report-v3@ object covering every case.
--
-- The format is line-oriented. Blank lines and @#@ comments are
-- ignored; every other line is either a run-wide directive
-- (@key value@) or a case (@case NAME key=value...@):
--
-- > # ppad-secp256k1 scalar surfaces
-- > meter          wall
-- > alpha          1e-6
-- > budget         20000
-- > warmup         500
-- > target-prefix  censor_target_
-- > workspace      128
-- >
-- > case mul       secret=0:32
-- > case sign      workspace=96 secret=0:32 public=32:32
-- > case ecdh      secret=0:32 context=32:32
-- > case inv       secret=0:32 replicates=3
--
-- A case's target symbol is @target-prefix@ ++ its name unless
-- @target=@ overrides it outright.

module Censor.Runner.Manifest (
    -- * Types
    Manifest(..)
  , Defaults(..)
  , ManifestCase(..)
  , Range(..)
  , BatchSpec(..)

    -- * Parsing
  , parseManifest
  , emptyDefaults
  , readRange
  , readSeed

    -- * Layout validation
  , checkLayout
  ) where

import Data.Char (isSpace)
import Data.Word (Word64)
import Numeric (readHex)

-- | A byte range within the workspace: @off:len@.
data Range = Range
  { Range -> Int
rangeOff :: {-# UNPACK #-} !Int
  , Range -> Int
rangeLen :: {-# UNPACK #-} !Int
  } deriving (Range -> Range -> Bool
(Range -> Range -> Bool) -> (Range -> Range -> Bool) -> Eq Range
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Range -> Range -> Bool
== :: Range -> Range -> Bool
$c/= :: Range -> Range -> Bool
/= :: Range -> Range -> Bool
Eq, Int -> Range -> ShowS
[Range] -> ShowS
Range -> String
(Int -> Range -> ShowS)
-> (Range -> String) -> ([Range] -> ShowS) -> Show Range
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Range -> ShowS
showsPrec :: Int -> Range -> ShowS
$cshow :: Range -> String
show :: Range -> String
$cshowList :: [Range] -> ShowS
showList :: [Range] -> ShowS
Show)

-- | How a case picks its @cfgBatch@. Foreign targets genuinely
--   recompute on every repetition, so 'BatchAuto' is meaningful
--   here in a way it is not for a pure Haskell target.
data BatchSpec
  = BatchFixed !Int
    -- ^ pin the batch.
  | BatchAuto
    -- ^ calibrate it per case.
  deriving (BatchSpec -> BatchSpec -> Bool
(BatchSpec -> BatchSpec -> Bool)
-> (BatchSpec -> BatchSpec -> Bool) -> Eq BatchSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BatchSpec -> BatchSpec -> Bool
== :: BatchSpec -> BatchSpec -> Bool
$c/= :: BatchSpec -> BatchSpec -> Bool
/= :: BatchSpec -> BatchSpec -> Bool
Eq, Int -> BatchSpec -> ShowS
[BatchSpec] -> ShowS
BatchSpec -> String
(Int -> BatchSpec -> ShowS)
-> (BatchSpec -> String)
-> ([BatchSpec] -> ShowS)
-> Show BatchSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BatchSpec -> ShowS
showsPrec :: Int -> BatchSpec -> ShowS
$cshow :: BatchSpec -> String
show :: BatchSpec -> String
$cshowList :: [BatchSpec] -> ShowS
showList :: [BatchSpec] -> ShowS
Show)

-- | Run-wide directives. Every field is optional; 'Nothing' defers
--   to the runner's own default (or a command-line override).
data Defaults = Defaults
  { Defaults -> Maybe String
dfMeter     :: !(Maybe String)
  , Defaults -> Maybe Double
dfAlpha     :: !(Maybe Double)
  , Defaults -> Maybe Int
dfBudget    :: !(Maybe Int)
  , Defaults -> Maybe Int
dfWarmup    :: !(Maybe Int)
  , Defaults -> Maybe BatchSpec
dfBatch     :: !(Maybe BatchSpec)
  , Defaults -> Maybe Double
dfMargin    :: !(Maybe Double)
    -- ^ relative interval-null margin (see 'Censor.cfgMargin').
  , Defaults -> Maybe Word64
dfSeed      :: !(Maybe Word64)
    -- ^ seeds the input samplers.
  , Defaults -> Maybe Word64
dfOrderSeed :: !(Maybe Word64)
    -- ^ seeds the A\/B order bit. Left unset in a checked-in
    --   manifest: the default is fresh OS entropy per run, and the
    --   resolved value is reported for replay.
  , Defaults -> Maybe String
dfPrefix    :: !(Maybe String)
  , Defaults -> Maybe Int
dfWorkspace :: !(Maybe Int)
  , Defaults -> Maybe Bool
dfFamilyAlpha :: !(Maybe Bool)
    -- ^ when set, run every expanded cell at @alpha \/ M@ (M being
    --   the number of cells) so the /battery/ tests at @alpha@
    --   family-wise, rather than merely reporting the union bound.
  } deriving (Defaults -> Defaults -> Bool
(Defaults -> Defaults -> Bool)
-> (Defaults -> Defaults -> Bool) -> Eq Defaults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Defaults -> Defaults -> Bool
== :: Defaults -> Defaults -> Bool
$c/= :: Defaults -> Defaults -> Bool
/= :: Defaults -> Defaults -> Bool
Eq, Int -> Defaults -> ShowS
[Defaults] -> ShowS
Defaults -> String
(Int -> Defaults -> ShowS)
-> (Defaults -> String) -> ([Defaults] -> ShowS) -> Show Defaults
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Defaults -> ShowS
showsPrec :: Int -> Defaults -> ShowS
$cshow :: Defaults -> String
show :: Defaults -> String
$cshowList :: [Defaults] -> ShowS
showList :: [Defaults] -> ShowS
Show)

-- | All directives unset.
emptyDefaults :: Defaults
emptyDefaults :: Defaults
emptyDefaults = Defaults
  { dfMeter :: Maybe String
dfMeter     = Maybe String
forall a. Maybe a
Nothing
  , dfAlpha :: Maybe Double
dfAlpha     = Maybe Double
forall a. Maybe a
Nothing
  , dfBudget :: Maybe Int
dfBudget    = Maybe Int
forall a. Maybe a
Nothing
  , dfWarmup :: Maybe Int
dfWarmup    = Maybe Int
forall a. Maybe a
Nothing
  , dfBatch :: Maybe BatchSpec
dfBatch     = Maybe BatchSpec
forall a. Maybe a
Nothing
  , dfMargin :: Maybe Double
dfMargin    = Maybe Double
forall a. Maybe a
Nothing
  , dfSeed :: Maybe Word64
dfSeed      = Maybe Word64
forall a. Maybe a
Nothing
  , dfOrderSeed :: Maybe Word64
dfOrderSeed = Maybe Word64
forall a. Maybe a
Nothing
  , dfPrefix :: Maybe String
dfPrefix    = Maybe String
forall a. Maybe a
Nothing
  , dfWorkspace :: Maybe Int
dfWorkspace = Maybe Int
forall a. Maybe a
Nothing
  , dfFamilyAlpha :: Maybe Bool
dfFamilyAlpha = Maybe Bool
forall a. Maybe a
Nothing
  }

-- | One case: a display name, the symbol to resolve, the workspace
--   layout, and how many times to replicate it.
data ManifestCase = ManifestCase
  { ManifestCase -> String
mcId         :: !String
    -- ^ the case token as written in the manifest, before any
    --   @label=@ override. This is the case's /identity/: the
    --   runner mixes it into the run-wide seed to give each case
    --   its own fixed secret.
    --
    --   Kept apart from 'mcName' so that renaming a case for
    --   presentation does not change the experiment it runs.
  , ManifestCase -> String
mcName       :: !String
    -- ^ the display name: 'mcId', or whatever @label=@ set. Used
    --   for rendering only.
  , ManifestCase -> String
mcTarget     :: !String
  , ManifestCase -> Int
mcWorkspace  :: !Int
  , ManifestCase -> [Range]
mcSecret     :: ![Range]
  , ManifestCase -> [Range]
mcPublic     :: ![Range]
  , ManifestCase -> [Range]
mcContext    :: ![Range]
    -- ^ ranges redrawn once per /pair/ and written identically into
    --   both classes: a fresh public input shared by the pair (see
    --   'Censor.fixVsRandomCtx').
  , ManifestCase -> Maybe BatchSpec
mcBatch      :: !(Maybe BatchSpec)
  , ManifestCase -> Int
mcReplicates :: {-# UNPACK #-} !Int
    -- ^ how many independent fixed secrets to run this case
    --   against, each its own case row. One pinned secret only asks
    --   whether /that/ secret times differently from random;
    --   replicating guards against an unlucky draw.
  } deriving (ManifestCase -> ManifestCase -> Bool
(ManifestCase -> ManifestCase -> Bool)
-> (ManifestCase -> ManifestCase -> Bool) -> Eq ManifestCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ManifestCase -> ManifestCase -> Bool
== :: ManifestCase -> ManifestCase -> Bool
$c/= :: ManifestCase -> ManifestCase -> Bool
/= :: ManifestCase -> ManifestCase -> Bool
Eq, Int -> ManifestCase -> ShowS
[ManifestCase] -> ShowS
ManifestCase -> String
(Int -> ManifestCase -> ShowS)
-> (ManifestCase -> String)
-> ([ManifestCase] -> ShowS)
-> Show ManifestCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ManifestCase -> ShowS
showsPrec :: Int -> ManifestCase -> ShowS
$cshow :: ManifestCase -> String
show :: ManifestCase -> String
$cshowList :: [ManifestCase] -> ShowS
showList :: [ManifestCase] -> ShowS
Show)

-- | A parsed manifest.
data Manifest = Manifest
  { Manifest -> Defaults
mfDefaults :: !Defaults
  , Manifest -> [ManifestCase]
mfCases    :: ![ManifestCase]
  } deriving (Manifest -> Manifest -> Bool
(Manifest -> Manifest -> Bool)
-> (Manifest -> Manifest -> Bool) -> Eq Manifest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Manifest -> Manifest -> Bool
== :: Manifest -> Manifest -> Bool
$c/= :: Manifest -> Manifest -> Bool
/= :: Manifest -> Manifest -> Bool
Eq, Int -> Manifest -> ShowS
[Manifest] -> ShowS
Manifest -> String
(Int -> Manifest -> ShowS)
-> (Manifest -> String) -> ([Manifest] -> ShowS) -> Show Manifest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Manifest -> ShowS
showsPrec :: Int -> Manifest -> ShowS
$cshow :: Manifest -> String
show :: Manifest -> String
$cshowList :: [Manifest] -> ShowS
showList :: [Manifest] -> ShowS
Show)

-- | Parse a manifest. Returns a message naming the offending line
--   on failure.
--
--   Case order is preserved. A manifest with no cases is an error:
--   it is far more likely a typo than an intent.
parseManifest :: String -> Either String Manifest
parseManifest :: String -> Either String Manifest
parseManifest String
src = do
  mf <- (Either String Manifest -> (Int, String) -> Either String Manifest)
-> Either String Manifest
-> [(Int, String)]
-> Either String Manifest
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Either String Manifest -> (Int, String) -> Either String Manifest
step (Manifest -> Either String Manifest
forall a b. b -> Either a b
Right (Defaults -> [ManifestCase] -> Manifest
Manifest Defaults
emptyDefaults [])) [(Int, String)]
numbered
  case mfCases mf of
    [] -> String -> Either String Manifest
forall a b. a -> Either a b
Left String
"manifest: no cases declared"
    [ManifestCase]
cs -> Manifest -> Either String Manifest
forall a b. b -> Either a b
Right Manifest
mf { mfCases = reverse cs }
  where
    numbered :: [(Int, String)]
numbered = [Int] -> [String] -> [(Int, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1 :: Int ..] (String -> [String]
lines String
src)
    step :: Either String Manifest -> (Int, String) -> Either String Manifest
step Either String Manifest
acc (Int
n, String
raw) = do
      mf <- Either String Manifest
acc
      case words (strip raw) of
        []           -> Manifest -> Either String Manifest
forall a b. b -> Either a b
Right Manifest
mf
        (String
"case" : [String]
r) -> (ManifestCase -> Manifest)
-> Either String ManifestCase -> Either String Manifest
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ManifestCase
c -> Manifest
mf { mfCases = c : mfCases mf })
                             (Int -> Defaults -> [String] -> Either String ManifestCase
parseCase Int
n (Manifest -> Defaults
mfDefaults Manifest
mf) [String]
r)
        [String
k, String
v]       -> (Defaults -> Manifest)
-> Either String Defaults -> Either String Manifest
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Defaults
d -> Manifest
mf { mfDefaults = d })
                             (Int -> Defaults -> String -> String -> Either String Defaults
parseDirective Int
n (Manifest -> Defaults
mfDefaults Manifest
mf) String
k String
v)
        [String]
ws           -> String -> Either String Manifest
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"expected 'key value' or "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'case NAME ...', got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show ([String] -> String
unwords [String]
ws)))

at :: Int -> String -> String
at :: Int -> ShowS
at Int
n String
msg = String
"manifest line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg

-- Drop a comment and leading whitespace. '#' starts a comment
-- anywhere on the line: no field here (symbol, range, number) has
-- any use for one, so there is nothing to escape.
strip :: String -> String
strip :: ShowS
strip = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#')

parseDirective :: Int -> Defaults -> String -> String -> Either String Defaults
parseDirective :: Int -> Defaults -> String -> String -> Either String Defaults
parseDirective Int
n Defaults
d String
k String
v = case String
k of
  String
"meter"         -> Defaults -> Either String Defaults
forall a b. b -> Either a b
Right Defaults
d { dfMeter     = Just v }
  String
"target-prefix" -> Defaults -> Either String Defaults
forall a b. b -> Either a b
Right Defaults
d { dfPrefix    = Just v }
  String
"alpha"         -> (Double -> Defaults)
-> Either String Double -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Defaults
d { dfAlpha     = Just x }) (String -> Either String Double
num String
"alpha")
  String
"budget"        -> (Int -> Defaults) -> Either String Int -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> Defaults
d { dfBudget    = Just x }) (String -> Either String Int
nat String
"budget")
  String
"warmup"        -> (Int -> Defaults) -> Either String Int -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> Defaults
d { dfWarmup    = Just x }) (String -> Either String Int
nat String
"warmup")
  String
"workspace"     -> (Int -> Defaults) -> Either String Int -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
x -> Defaults
d { dfWorkspace = Just x }) (String -> Either String Int
pos String
"workspace")
  String
"batch"         -> (BatchSpec -> Defaults)
-> Either String BatchSpec -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\BatchSpec
x -> Defaults
d { dfBatch     = Just x }) (Int -> String -> Either String BatchSpec
batch Int
n String
v)
  String
"margin"        -> (Double -> Defaults)
-> Either String Double -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Double
x -> Defaults
d { dfMargin    = Just x }) Either String Double
posnum
  String
"seed"          -> (Word64 -> Defaults)
-> Either String Word64 -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
x -> Defaults
d { dfSeed      = Just x }) (Int -> String -> String -> Either String Word64
hex Int
n String
"seed" String
v)
  String
"order-seed"    -> (Word64 -> Defaults)
-> Either String Word64 -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Word64
x -> Defaults
d { dfOrderSeed = Just x })
                          (Int -> String -> String -> Either String Word64
hex Int
n String
"order-seed" String
v)
  String
"family-alpha"  -> (Bool -> Defaults) -> Either String Bool -> Either String Defaults
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
x -> Defaults
d { dfFamilyAlpha = Just x })
                          (Int -> String -> String -> Either String Bool
flag Int
n String
"family-alpha" String
v)
  String
_ -> String -> Either String Defaults
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"unknown directive " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
k))
  where
    num :: String -> Either String Double
num String
nm = case ReadS Double
forall a. Read a => ReadS a
reads String
v of
      [(Double
x, String
"")] -> Double -> Either String Double
forall a b. b -> Either a b
Right (Double
x :: Double)
      [(Double, String)]
_ -> String -> Either String Double
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expects a number, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))
    posnum :: Either String Double
posnum = case ReadS Double
forall a. Read a => ReadS a
reads String
v of
      [(Double
x, String
"")] | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 -> Double -> Either String Double
forall a b. b -> Either a b
Right (Double
x :: Double)
      [(Double, String)]
_ -> String -> Either String Double
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"margin expects a positive number, got "
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))
    nat :: String -> Either String Int
nat String
nm = case ReadS Int
forall a. Read a => ReadS a
reads String
v of
      [(Int
x, String
"")] | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 -> Int -> Either String Int
forall a b. b -> Either a b
Right (Int
x :: Int)
      [(Int, String)]
_ -> String -> Either String Int
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expects a non-negative integer, got "
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))
    pos :: String -> Either String Int
pos String
nm = case ReadS Int
forall a. Read a => ReadS a
reads String
v of
      [(Int
x, String
"")] | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Int -> Either String Int
forall a b. b -> Either a b
Right (Int
x :: Int)
      [(Int, String)]
_ -> String -> Either String Int
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expects a positive integer, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))

batch :: Int -> String -> Either String BatchSpec
batch :: Int -> String -> Either String BatchSpec
batch Int
_ String
"auto" = BatchSpec -> Either String BatchSpec
forall a b. b -> Either a b
Right BatchSpec
BatchAuto
batch Int
n String
v = case ReadS Int
forall a. Read a => ReadS a
reads String
v of
  [(Int
x, String
"")] | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 -> BatchSpec -> Either String BatchSpec
forall a b. b -> Either a b
Right (Int -> BatchSpec
BatchFixed Int
x)
  [(Int, String)]
_ -> String -> Either String BatchSpec
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"batch expects a positive integer or 'auto', got "
                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))

flag :: Int -> String -> String -> Either String Bool
flag :: Int -> String -> String -> Either String Bool
flag Int
_ String
_ String
"on"  = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True
flag Int
_ String
_ String
"off" = Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
False
flag Int
n String
nm String
v = String -> Either String Bool
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expects 'on' or 'off', got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))

hex :: Int -> String -> String -> Either String Word64
hex :: Int -> String -> String -> Either String Word64
hex Int
n String
nm String
v = case String -> Maybe Word64
readSeed String
v of
  Just Word64
w  -> Word64 -> Either String Word64
forall a b. b -> Either a b
Right Word64
w
  Maybe Word64
Nothing -> String -> Either String Word64
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expects a hex Word64, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))

-- | Read a hex 'Word64', with or without a @0x@ prefix.
readSeed :: String -> Maybe Word64
readSeed :: String -> Maybe Word64
readSeed String
v =
  let s :: String
s = case String
v of
        Char
'0' : Char
'x' : String
r -> String
r
        Char
'0' : Char
'X' : String
r -> String
r
        String
_             -> String
v
  in  case ReadS Word64
forall a. (Eq a, Num a) => ReadS a
readHex String
s of
        [(Word64
w, String
"")] -> Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
w
        [(Word64, String)]
_         -> Maybe Word64
forall a. Maybe a
Nothing

parseCase
  :: Int -> Defaults -> [String] -> Either String ManifestCase
parseCase :: Int -> Defaults -> [String] -> Either String ManifestCase
parseCase Int
n Defaults
d [String]
toks = case [String]
toks of
  [] -> String -> Either String ManifestCase
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n String
"case needs a name")
  (String
name : [String]
kvs) -> do
    let c0 :: ManifestCase
c0 = ManifestCase
          { mcId :: String
mcId         = String
name
          , mcName :: String
mcName       = String
name
          , mcTarget :: String
mcTarget     = String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ShowS
forall a. a -> a
id (Defaults -> Maybe String
dfPrefix Defaults
d) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
          , mcWorkspace :: Int
mcWorkspace  = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 Int -> Int
forall a. a -> a
id (Defaults -> Maybe Int
dfWorkspace Defaults
d)
          , mcSecret :: [Range]
mcSecret     = []
          , mcPublic :: [Range]
mcPublic     = []
          , mcContext :: [Range]
mcContext    = []
          , mcBatch :: Maybe BatchSpec
mcBatch      = Maybe BatchSpec
forall a. Maybe a
Nothing
          , mcReplicates :: Int
mcReplicates = Int
1
          }
    c <- (Either String ManifestCase
 -> String -> Either String ManifestCase)
-> Either String ManifestCase
-> [String]
-> Either String ManifestCase
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Either String ManifestCase
acc String
kv -> Either String ManifestCase
acc Either String ManifestCase
-> (ManifestCase -> Either String ManifestCase)
-> Either String ManifestCase
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ManifestCase
x -> Int -> ManifestCase -> String -> Either String ManifestCase
applyKV Int
n ManifestCase
x String
kv) (ManifestCase -> Either String ManifestCase
forall a b. b -> Either a b
Right ManifestCase
c0) [String]
kvs
    validateCase n c { mcSecret  = reverse (mcSecret c)
                     , mcPublic  = reverse (mcPublic c)
                     , mcContext = reverse (mcContext c) }

applyKV :: Int -> ManifestCase -> String -> Either String ManifestCase
applyKV :: Int -> ManifestCase -> String -> Either String ManifestCase
applyKV Int
n ManifestCase
c String
kv = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'=') String
kv of
  (String
k, Char
'=' : String
v) -> case String
k of
    String
"target"     -> ManifestCase -> Either String ManifestCase
forall a b. b -> Either a b
Right ManifestCase
c { mcTarget = v }
    String
"label"      -> ManifestCase -> Either String ManifestCase
forall a b. b -> Either a b
Right ManifestCase
c { mcName   = v }
    String
"secret"     -> (Range -> ManifestCase)
-> Either String Range -> Either String ManifestCase
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Range
r -> ManifestCase
c { mcSecret = r : mcSecret c })
                         (Int -> String -> String -> Either String Range
range Int
n String
"secret" String
v)
    String
"public"     -> (Range -> ManifestCase)
-> Either String Range -> Either String ManifestCase
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Range
r -> ManifestCase
c { mcPublic = r : mcPublic c })
                         (Int -> String -> String -> Either String Range
range Int
n String
"public" String
v)
    String
"context"    -> (Range -> ManifestCase)
-> Either String Range -> Either String ManifestCase
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Range
r -> ManifestCase
c { mcContext = r : mcContext c })
                         (Int -> String -> String -> Either String Range
range Int
n String
"context" String
v)
    String
"batch"      -> (BatchSpec -> ManifestCase)
-> Either String BatchSpec -> Either String ManifestCase
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\BatchSpec
b -> ManifestCase
c { mcBatch = Just b }) (Int -> String -> Either String BatchSpec
batch Int
n String
v)
    String
"workspace"  -> case ReadS Int
forall a. Read a => ReadS a
reads String
v of
      [(Int
x, String
"")] | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> ManifestCase -> Either String ManifestCase
forall a b. b -> Either a b
Right ManifestCase
c { mcWorkspace = x }
      [(Int, String)]
_ -> String -> Either String ManifestCase
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"workspace expects a positive integer, got "
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))
    String
"replicates" -> case ReadS Int
forall a. Read a => ReadS a
reads String
v of
      [(Int
x, String
"")] | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1 -> ManifestCase -> Either String ManifestCase
forall a b. b -> Either a b
Right ManifestCase
c { mcReplicates = x }
      [(Int, String)]
_ -> String -> Either String ManifestCase
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"replicates expects a positive integer, got "
                       String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))
    String
_ -> String -> Either String ManifestCase
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"unknown case key " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
k))
  (String, String)
_ -> String -> Either String ManifestCase
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"expected key=value, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
kv))

range :: Int -> String -> String -> Either String Range
range :: Int -> String -> String -> Either String Range
range Int
n String
nm String
v = case String -> Maybe Range
readRange String
v of
  Just Range
r  -> Range -> Either String Range
forall a b. b -> Either a b
Right Range
r
  Maybe Range
Nothing -> String -> Either String Range
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
nm String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" expects off:len with off >= 0, len > 0,"
                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
v))

-- | Read an @off:len@ byte range, with @off >= 0@ and @len > 0@.
readRange :: String -> Maybe Range
readRange :: String -> Maybe Range
readRange String
v = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
v of
  (String
off, Char
':' : String
len) -> case (ReadS Int
forall a. Read a => ReadS a
reads String
off, ReadS Int
forall a. Read a => ReadS a
reads String
len) of
    ([(Int
o, String
"")], [(Int
l, String
"")]) | Int
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Range -> Maybe Range
forall a. a -> Maybe a
Just (Int -> Int -> Range
Range Int
o Int
l)
    ([(Int, String)], [(Int, String)])
_ -> Maybe Range
forall a. Maybe a
Nothing
  (String, String)
_ -> Maybe Range
forall a. Maybe a
Nothing

validateCase :: Int -> ManifestCase -> Either String ManifestCase
validateCase :: Int -> ManifestCase -> Either String ManifestCase
validateCase Int
n ManifestCase
c
  | ManifestCase -> Int
mcWorkspace ManifestCase
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 =
      String -> Either String ManifestCase
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"case " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ManifestCase -> String
mcName ManifestCase
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" has no workspace; set one "
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"on the case or a run-wide 'workspace' default"))
  | [Range] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ManifestCase -> [Range]
mcSecret ManifestCase
c) =
      String -> Either String ManifestCase
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"case " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ManifestCase -> String
mcName ManifestCase
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" declares no secret range; "
                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"there is no fix-vs-random axis without one"))
  | Bool
otherwise =
      case Int -> [Range] -> [Range] -> [Range] -> Maybe String
checkLayout (ManifestCase -> Int
mcWorkspace ManifestCase
c) (ManifestCase -> [Range]
mcSecret ManifestCase
c) (ManifestCase -> [Range]
mcPublic ManifestCase
c)
             (ManifestCase -> [Range]
mcContext ManifestCase
c) of
        Just String
msg -> String -> Either String ManifestCase
forall a b. a -> Either a b
Left (Int -> ShowS
at Int
n (String
"case " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ManifestCase -> String
mcName ManifestCase
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg))
        Maybe String
Nothing  -> ManifestCase -> Either String ManifestCase
forall a b. b -> Either a b
Right ManifestCase
c

-- | Check a workspace layout: every declared range must fit inside
--   the workspace, and the three roles must be pairwise disjoint.
--   'Nothing' when the layout is sound; otherwise a message naming
--   the first problem, for the caller to place in context.
--
--   Both entry points validate through this — a manifest case and
--   the single-case command line — so the two cannot drift on what
--   they accept.
--
--   Overlapping roles are rejected rather than resolved by
--   precedence. A byte is pinned in class A only ('mcSecret'),
--   pinned in both for the run ('mcPublic'), refreshed per pair in
--   both ('mcContext'), or freshly random in each class; asking for
--   two of those at once has no coherent reading, and whichever
--   overlay happened to land last would silently pick one. That is
--   how a public range could mask the context it overlapped,
--   turning a per-pair refresh into a constant without saying so.
checkLayout
  :: Int      -- ^ workspace bytes
  -> [Range]  -- ^ secret ranges
  -> [Range]  -- ^ public ranges
  -> [Range]  -- ^ context ranges
  -> Maybe String
checkLayout :: Int -> [Range] -> [Range] -> [Range] -> Maybe String
checkLayout Int
ws [Range]
secrets [Range]
publics [Range]
contexts =
  case ((String, Range) -> Bool) -> [(String, Range)] -> [(String, Range)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Range -> Bool
overflows (Range -> Bool)
-> ((String, Range) -> Range) -> (String, Range) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Range) -> Range
forall a b. (a, b) -> b
snd) [(String, Range)]
tagged of
    ((String
role, Range
r) : [(String, Range)]
_) -> String -> Maybe String
forall a. a -> Maybe a
Just
      (String
role String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Range -> String
showRange Range
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" overflows the workspace of "
       String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
ws String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" bytes")
    [] -> case [(String, Range, String)]
clashes of
      ((String
ra, Range
r, String
rb) : [(String, Range, String)]
_) -> String -> Maybe String
forall a. a -> Maybe a
Just
        (String
ra String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Range -> String
showRange Range
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" overlaps a " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rb String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" range")
      [] -> Maybe String
forall a. Maybe a
Nothing
  where
    tagged :: [(String, Range)]
tagged = [[(String, Range)]] -> [(String, Range)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [(String
"secret",  Range
r) | Range
r <- [Range]
secrets]
      , [(String
"public",  Range
r) | Range
r <- [Range]
publics]
      , [(String
"context", Range
r) | Range
r <- [Range]
contexts]
      ]
    clashes :: [(String, Range, String)]
clashes =
      [ (String
ra, Range
a, String
rb)
      | (String
ra, [Range]
as, String
rb, [Range]
bs) <-
          [ (String
"secret",  [Range]
secrets,  String
"public",  [Range]
publics)
          , (String
"secret",  [Range]
secrets,  String
"context", [Range]
contexts)
          , (String
"context", [Range]
contexts, String
"public",  [Range]
publics)
          ]
      , Range
a <- [Range]
as, Range
b <- [Range]
bs, Range -> Range -> Bool
overlaps Range
a Range
b
      ]
    overflows :: Range -> Bool
overflows (Range Int
o Int
l) = Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ws
    overlaps :: Range -> Range -> Bool
overlaps (Range Int
o1 Int
l1) (Range Int
o2 Int
l2) =
      Int
o1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
o2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2 Bool -> Bool -> Bool
&& Int
o2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
o1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l1

showRange :: Range -> String
showRange :: Range -> String
showRange (Range Int
o Int
l) = Int -> String
forall a. Show a => a -> String
show Int
o String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
l