Make a servant server read only by throwing 403 errors for anything that isn't a GET

ReadOnly.hs

class ReadOnly api where
  readOnly :: Proxy api -> ServerT api Handler -> ServerT api Handler

instance (ReadOnly a, ReadOnly b) => ReadOnly (a :<|> b) where
  readOnly (Proxy :: Proxy (a :<|> b)) (a :<|> b) = (readOnly (Proxy :: Proxy a) a :<|> readOnly (Proxy :: Proxy b) b)

instance (ReadOnly api) => ReadOnly (Description desc :> api) where
  readOnly (Proxy :: Proxy (Description desc :> api)) api = readOnly (Proxy :: Proxy api) api

instance (ReadOnly api) => ReadOnly ((path :: Symbol) :> api) where
  readOnly (Proxy :: Proxy (path :> api)) = readOnly (Proxy :: Proxy api)

instance ReadOnly api => ReadOnly (QueryParam' mods sym a :> api) where
  readOnly (Proxy :: Proxy (QueryParam' mods sym a :> api)) srv param = readOnly (Proxy :: Proxy api) (srv param)

instance ReadOnly api => ReadOnly (Capture' mods capture a :> api) where
  readOnly (Proxy :: Proxy (Capture' mods capture a :> api)) srv capt = readOnly (Proxy :: Proxy api) (srv capt)

instance ReadOnly api => ReadOnly (ReqBody contentType a :> api) where
  readOnly (Proxy :: Proxy (ReqBody contentType a :> api)) srv body = readOnly (Proxy :: Proxy api) (srv body)

instance ReadOnly api => ReadOnly (MultipartForm tag a :> api) where
  readOnly (Proxy :: Proxy (MultipartForm tag a :> api)) srv formData = readOnly (Proxy :: Proxy api) (srv formData)

instance {-# OVERLAPPING #-} ReadOnly (Verb 'GET status contentType a) where
  readOnly (Proxy :: Proxy (Verb 'GET status contentType a)) srv = srv

instance {-# OVERLAPPABLE #-} ReadOnly (Verb (method :: StdMethod) status contentType a) where
  readOnly Proxy _ = throwError $ err403