module Control.Monad.Apiary.Filter (
method
, Control.Monad.Apiary.Filter.httpVersion
, http09, http10, http11
, root
, capture
, Capture.path
, Capture.endPath
, Capture.fetch
, QueryKey(..), (??)
, query
, (=:), (=!:), (=?:), (=?!:), (?:), (=*:), (=+:)
, hasQuery
, switchQuery
, hasHeader
, eqHeader
, headers
, header
, header'
, accept
, ssl
, stdMethod
, anyPath
) where
import Network.Wai as Wai
import Network.Wai.Parse
import qualified Network.HTTP.Types as HT
import Control.Applicative
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Apiary.Action.Internal
import Control.Monad.Apiary.Filter.Internal
import Control.Monad.Apiary.Filter.Internal.Capture.TH
import Control.Monad.Apiary.Internal
import qualified Control.Monad.Apiary.Filter.Internal.Strategy as Strategy
import qualified Control.Monad.Apiary.Filter.Internal.Capture as Capture
import Text.Blaze.Html
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as SC
import qualified Data.Text.Encoding as T
import Data.Monoid
import Data.Proxy
import Data.Apiary.SList
import Data.String
import Data.Apiary.Param
import Data.Apiary.Document
import Data.Apiary.Method
method :: Monad actM => Method -> ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
method m = focus' (DocMethod m) (Just m) id return
stdMethod :: Monad actM => Method -> ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
stdMethod = method
ssl :: Monad actM => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
ssl = function_ (DocPrecondition "SSL required") isSecure
httpVersion :: Monad actM => HT.HttpVersion -> Html -> ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
httpVersion v h = function_ (DocPrecondition h) $ (v ==) . Wai.httpVersion
http09 :: Monad actM => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
http09 = Control.Monad.Apiary.Filter.httpVersion HT.http09 "HTTP/0.9 only"
http10 :: Monad actM => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
http10 = Control.Monad.Apiary.Filter.httpVersion HT.http10 "HTTP/1.0 only"
http11 :: Monad actM => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
http11 = Control.Monad.Apiary.Filter.httpVersion HT.http11 "HTTP/1.1 only"
root :: (Monad m, Monad actM) => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
root = focus' DocRoot Nothing (RootPath:) return
anyPath :: (Monad m, Monad actM) => ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
anyPath = focus' id Nothing (RestPath:) return
data QueryKey = QueryKey
{ queryKey :: S.ByteString
, queryDesc :: Maybe Html
}
instance IsString QueryKey where
fromString s = QueryKey (SC.pack s) Nothing
(??) :: QueryKey -> Html -> QueryKey
QueryKey k _ ?? d = QueryKey k (Just d)
query :: forall exts prms actM a w m.
(ReqParam a, Strategy.Strategy w, MonadIO actM)
=> QueryKey
-> w a
-> ApiaryT exts (Strategy.SNext w prms a) actM m ()
-> ApiaryT exts prms actM m ()
query QueryKey{..} p =
focus doc $ \l -> do
r <- getRequest
(q,f) <- getRequestBody
maybe mzero return $
Strategy.readStrategy id ((queryKey ==) . fst) p
(reqParams p r q f) l
where
doc = DocQuery queryKey (Strategy.strategyRep p) (reqParamRep (Proxy :: Proxy a)) queryDesc
(=:) :: (MonadIO actM, ReqParam p) => QueryKey -> proxy p
-> ApiaryT exts (p ': prms) actM m () -> ApiaryT exts prms actM m ()
k =: t = query k (Strategy.pFirst t)
(=!:) :: (MonadIO actM, ReqParam p) => QueryKey -> proxy p
-> ApiaryT exts (p ': prms) actM m () -> ApiaryT exts prms actM m ()
k =!: t = query k (Strategy.pOne t)
(=?:) :: (MonadIO actM, ReqParam p) => QueryKey -> proxy p
-> ApiaryT exts (Maybe p ': prms) actM m () -> ApiaryT exts prms actM m ()
k =?: t = query k (Strategy.pOption t)
(=?!:) :: (MonadIO actM, ReqParam p, Show p) => QueryKey -> p
-> ApiaryT exts (p ': prms) actM m () -> ApiaryT exts prms actM m ()
k =?!: v = query k (Strategy.pOptional v)
(?:) :: (MonadIO actM, ReqParam p) => QueryKey -> proxy p
-> ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
k ?: t = query k (Strategy.pCheck t)
(=*:) :: (MonadIO actM, ReqParam p) => QueryKey -> proxy p
-> ApiaryT exts ([p] ': prms) actM m () -> ApiaryT exts prms actM m ()
k =*: t = query k (Strategy.pMany t)
(=+:) :: (MonadIO actM, ReqParam p) => QueryKey -> proxy p
-> ApiaryT exts ([p] ': prms) actM m () -> ApiaryT exts prms actM m ()
k =+: t = query k (Strategy.pSome t)
hasQuery :: MonadIO actM => QueryKey -> ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
hasQuery q = query q (Strategy.Check :: Strategy.Check ())
switchQuery :: Monad actM => QueryKey -> ApiaryT exts (Bool ': prms) actM m () -> ApiaryT exts prms actM m ()
switchQuery QueryKey{..} = focus doc $ \l -> do
r <- getRequest
return $ (not . null $ filter (\(k,v) -> queryKey == k && checkValue v) (queryString r)) ::: l
where
doc = DocQuery queryKey (StrategyRep "Switch") NoValue queryDesc
checkValue Nothing = True
checkValue v = case readQuery v :: Maybe Bool of
Just True -> True
_ -> False
hasHeader :: Monad actM => HT.HeaderName -> ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
hasHeader n = header' Strategy.pCheck ((n ==) . fst) . Just $
toHtml (show n) <> " header requred"
eqHeader :: Monad actM
=> HT.HeaderName
-> S.ByteString
-> ApiaryT exts prms actM m ()
-> ApiaryT exts prms actM m ()
eqHeader k v = header' Strategy.pCheck (\(k',v') -> k == k' && v == v') . Just $
mconcat [toHtml $ show k, " header == ", toHtml $ show v]
header :: Monad actM => HT.HeaderName
-> ApiaryT exts (S.ByteString ': prms) actM m () -> ApiaryT exts prms actM m ()
header n = header' Strategy.pFirst ((n ==) . fst) . Just $
toHtml (show n) <> " header requred"
headers :: Monad actM => HT.HeaderName
-> ApiaryT exts ([S.ByteString] ': prms) actM m () -> ApiaryT exts prms actM m ()
headers n = header' (Strategy.pLimitSome 100) ((n ==) . fst) . Just $
toHtml (show n) <> " header requred"
header' :: (Strategy.Strategy w, Monad actM)
=> (forall x. Proxy x -> w x)
-> (HT.Header -> Bool)
-> Maybe Html
-> ApiaryT exts (Strategy.SNext w prms S.ByteString) actM m ()
-> ApiaryT exts prms actM m ()
header' pf kf d = function pc $ \l r ->
Strategy.readStrategy Just kf (pf pByteString) (requestHeaders r) l
where
pc = maybe id DocPrecondition d
accept :: Monad actM => ContentType -> ApiaryT exts prms actM m () -> ApiaryT exts prms actM m ()
accept ect = focus (DocPrecondition $ "Accept: " <> toHtml (T.decodeUtf8 ect)) $ \c ->
(lookup "Accept" . requestHeaders <$> getRequest) >>= \case
Nothing -> mzero
Just ac -> if parseContentType ect `elem` map (parseContentType . SC.dropWhile (== ' ')) (SC.split ',' ac)
then contentType ect >> return c
else mzero