
  0 | module HTTP.API.Server.Path
  1 | 
  2 | import HTTP.API.Server.Interface
  3 | 
  4 | %default total
  5 | 
  6 | canHandlePath :
  7 |      (ps : List Part)
  8 |   -> All DecodeMany (PartsTypes ps)
  9 |   -> List ByteString
 10 |   -> Bool
 11 | canHandlePath [] [] [] = True
 12 | canHandlePath (PStr s :: ys) xs (p :: ps) =
 13 |   s == toString p && canHandlePath ys xs ps
 14 | canHandlePath (PTill s :: ys) xs (p :: ps) =
 15 |   if s == toString p
 16 |      then canHandlePath ys xs ps
 17 |      else canHandlePath (PTill s :: ys) xs ps
 18 | canHandlePath (Capture t :: ys) (x::xs) ps =
 19 |   case simulateDecode @{x} ps of
 20 |     Just ps2 => canHandlePath ys xs ps2
 21 |     Nothing  => False
 22 | canHandlePath _ _ _ = False
 23 | 
 24 | convertRequest :
 25 |      (ps : List Part)
 26 |   -> All DecodeMany (PartsTypes ps)
 27 |   -> List ByteString
 28 |   -> Either DecodeErr (HList $ PartsTypes ps)
 29 | convertRequest [] []  [] = Right []
 30 | convertRequest (PStr s    :: ys) as (b::bs) = convertRequest ys as bs
 31 | convertRequest (PTill s   :: ys) as (b::bs) =
 32 |   if s == toString b
 33 |      then convertRequest ys as bs
 34 |      else convertRequest (PTill s :: ys) as bs
 35 | convertRequest (Capture t :: ys) (a::as) bs = Prelude.do
 36 |   (bs2,v) <- decodeMany @{a} bs
 37 |   vs      <- convertRequest ys as bs2
 38 |   pure $ v::vs
 39 | convertRequest _ _ _ = Left (Msg "Unexpected end of URI path")
 40 | 
 41 | public export
 42 | Serve ReqPath where
 43 |   InTypes    m = PartsTypes m.parts
 44 |   OutTypes   m = []
 45 |   Constraint m = All DecodeMany (PartsTypes m.parts)
 46 |   outs       _ = %search
 47 |   canHandle m r = canHandlePath m.parts con r.uri.path
 48 |   adjResponse m _ _ = pure
 49 |   fromRequest m r =
 50 |     either
 51 |       (throw . decodeErr badRequest400)
 52 |       pure
 53 |       (convertRequest m.parts con r.uri.path)
 54 | 
 55 |