
  0 | module HTTP.API.Server.Header
  1 | 
  2 | import HTTP.API.Server.Interface
  3 | 
  4 | %default total
  5 | 
  6 | parameters {auto loc : HTTPLocal}
  7 |   decodeHeaders :
  8 |        (ps : List HeaderPart)
  9 |     -> {auto all : All Decode (HeaderTypes ps)}
 10 |     -> Request
 11 |     -> Either RequestErr (HList $ HeaderTypes ps)
 12 |   decodeHeaders []             r = Right []
 13 |   decodeHeaders (H n t s::hs) @{_::_} r =
 14 |     case lookupHeader n r.headers of
 15 |       Nothing => Left (requestErrMsg (missingHeader n) s)
 16 |       Just bs => Prelude.do
 17 |         v  <- mapFst (decodeErr s) (decodeAs t bs)
 18 |         vs <- decodeHeaders hs r
 19 |         pure $ v::vs
 20 | 
 21 |   public export
 22 |   Serve ReqHeaders where
 23 |     Constraint h         = All Decode (HeaderTypes h.headers)
 24 |     InTypes  h           = HeaderTypes h.headers
 25 |     OutTypes _           = []
 26 |     outs     _           = []
 27 |     canHandle   _ r      = True
 28 |     fromRequest h r      = injectEither $ decodeHeaders h.headers r
 29 |     adjResponse _ [] req = pure
 30 |