2019-05-16 03:00:10 +03:00
|
|
|
-- zuse: +http -----------------------------------------------------------------
|
|
|
|
|
|
|
|
module Vere.Http where
|
|
|
|
|
|
|
|
import ClassyPrelude
|
2019-07-02 05:51:26 +03:00
|
|
|
import Noun
|
2019-08-02 09:56:42 +03:00
|
|
|
import Arvo
|
2019-05-16 03:00:10 +03:00
|
|
|
|
2019-08-02 09:56:42 +03:00
|
|
|
import qualified Data.CaseInsensitive as CI
|
|
|
|
import qualified Network.HTTP.Types as HT
|
2019-05-24 02:58:18 +03:00
|
|
|
|
2019-06-28 00:28:58 +03:00
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
2019-05-16 03:00:10 +03:00
|
|
|
data Request = Request
|
2019-06-26 03:15:49 +03:00
|
|
|
{ method :: Method
|
2019-07-22 21:10:27 +03:00
|
|
|
, url :: Cord
|
2019-06-26 03:15:49 +03:00
|
|
|
, headerList :: [Header]
|
2019-07-22 21:10:27 +03:00
|
|
|
, body :: Maybe Octs
|
2019-06-26 03:15:49 +03:00
|
|
|
}
|
2019-06-28 00:28:58 +03:00
|
|
|
deriving (Eq, Ord, Show)
|
2019-05-16 03:00:10 +03:00
|
|
|
|
2019-07-23 03:46:06 +03:00
|
|
|
data RawEvent
|
|
|
|
= Start ResponseHeader (Maybe Octs) Bool
|
|
|
|
| Continue (Maybe Octs) Bool
|
|
|
|
| Cancel
|
|
|
|
deriving (Eq, Ord, Show)
|
2019-06-26 03:15:49 +03:00
|
|
|
|
2019-07-23 05:35:15 +03:00
|
|
|
deriveNoun ''Request
|
|
|
|
deriveNoun ''RawEvent
|
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
|
2019-06-26 03:15:49 +03:00
|
|
|
data Event
|
|
|
|
= Started ResponseHeader -- [%start hdr (unit octs) ?]
|
2019-07-22 21:10:27 +03:00
|
|
|
| Received Octs -- [%continue [~ octs] %.n]
|
2019-06-26 03:15:49 +03:00
|
|
|
| Done -- [%continue ~ %.y]
|
|
|
|
| Canceled -- %cancel
|
2019-07-22 21:10:27 +03:00
|
|
|
| Failed Cord -- %cancel
|
2019-06-28 00:28:58 +03:00
|
|
|
deriving (Eq, Ord, Show)
|
|
|
|
|
2019-07-23 05:35:15 +03:00
|
|
|
|
2019-06-28 00:28:58 +03:00
|
|
|
--------------------------------------------------------------------------------
|
2019-05-24 02:58:18 +03:00
|
|
|
|
|
|
|
convertHeaders :: [HT.Header] -> [Header]
|
|
|
|
convertHeaders = fmap f
|
|
|
|
where
|
2019-08-02 09:56:42 +03:00
|
|
|
f (k, v) = Header (MkBytes $ CI.original k)
|
2019-07-23 03:46:06 +03:00
|
|
|
(MkBytes v)
|
2019-08-03 03:09:53 +03:00
|
|
|
|
|
|
|
unconvertHeaders :: [Header] -> [HT.Header]
|
|
|
|
unconvertHeaders = fmap f
|
|
|
|
where
|
|
|
|
f (Header (MkBytes k) (MkBytes v)) = (CI.mk k, v)
|