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