{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE GADTs #-}

module Dormouse.Client.Types
  ( HttpRequest(..)
  , HttpResponse(..)
  ) where

import Dormouse.Client.Headers
import Dormouse.Client.Methods
import qualified Data.ByteString as SB
import qualified Data.Map.Strict as Map

-- | Model of an HTTP request with type parameters: @scheme@ describing the uri scheme, @body@ describing the type of the content body, @contentTag@ describing the type, @method@
-- describing the HTTP verb associated with the request, @contentTag@ describing the type of content being sen and @acceptTag@ describing the type of content desired
data HttpRequest url method body contentTag acceptTag = HttpRequest 
  { HttpRequest url method body contentTag acceptTag
-> HttpMethod method
requestMethod :: !(HttpMethod method)
  , HttpRequest url method body contentTag acceptTag -> url
requestUrl :: !url
  , HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
requestHeaders :: Map.Map HeaderName SB.ByteString
  , HttpRequest url method body contentTag acceptTag -> body
requestBody :: body
  }

instance (Eq body, Eq url) => Eq (HttpRequest url method body contentTag acceptTag) where
  == :: HttpRequest url method body contentTag acceptTag
-> HttpRequest url method body contentTag acceptTag -> Bool
(==) (HttpRequest { requestMethod :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag
-> HttpMethod method
requestMethod = HttpMethod method
rm1, requestUrl :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag -> url
requestUrl = url
ru1, requestHeaders :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
requestHeaders = Map HeaderName ByteString
rh1, requestBody :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag -> body
requestBody = body
rb1 }) (HttpRequest { requestMethod :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag
-> HttpMethod method
requestMethod = HttpMethod method
rm2, requestUrl :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag -> url
requestUrl = url
ru2, requestHeaders :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
requestHeaders = Map HeaderName ByteString
rh2, requestBody :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag -> body
requestBody = body
rb2 }) =
    HttpMethod method
rm1 HttpMethod method -> HttpMethod method -> Bool
forall a. Eq a => a -> a -> Bool
== HttpMethod method
rm2 Bool -> Bool -> Bool
&& url
ru1 url -> url -> Bool
forall a. Eq a => a -> a -> Bool
== url
ru2 Bool -> Bool -> Bool
&& Map HeaderName ByteString
rh1 Map HeaderName ByteString -> Map HeaderName ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Map HeaderName ByteString
rh2 Bool -> Bool -> Bool
&& body
rb1 body -> body -> Bool
forall a. Eq a => a -> a -> Bool
== body
rb2

instance (Show body, Show url) => Show (HttpRequest url method body contentTag acceptTag) where
  show :: HttpRequest url method body contentTag acceptTag -> String
show (HttpRequest { requestMethod :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag
-> HttpMethod method
requestMethod = HttpMethod method
rm, requestUrl :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag -> url
requestUrl = url
ru, requestHeaders :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
requestHeaders = Map HeaderName ByteString
rh, requestBody :: forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag -> body
requestBody = body
rb }) = 
    [String] -> String
unlines
        [ String
"HttpRequest"
        , String
"{ requestMethod  = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HttpMethod method -> String
forall a. Show a => a -> String
show HttpMethod method
rm
        , String
", requestUri     = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ url -> String
forall a. Show a => a -> String
show url
ru
        , String
", requestHeaders = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map HeaderName ByteString -> String
forall a. Show a => a -> String
show Map HeaderName ByteString
rh
        , String
", requestBody    = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ body -> String
forall a. Show a => a -> String
show body
rb
        , String
"}"
        ]

instance HasHeaders (HttpRequest url method body contentTag acceptTag) where
  getHeaders :: HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
getHeaders = HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
requestHeaders
  getHeaderValue :: HeaderName
-> HttpRequest url method body contentTag acceptTag
-> Maybe ByteString
getHeaderValue HeaderName
key = HeaderName -> Map HeaderName ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup HeaderName
key (Map HeaderName ByteString -> Maybe ByteString)
-> (HttpRequest url method body contentTag acceptTag
    -> Map HeaderName ByteString)
-> HttpRequest url method body contentTag acceptTag
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
forall url (method :: Symbol) body contentTag acceptTag.
HttpRequest url method body contentTag acceptTag
-> Map HeaderName ByteString
requestHeaders

-- | Model of an HTTP response with the type parameter @body@ describing the type of the content body.
data HttpResponse body = HttpResponse
  { HttpResponse body -> Int
responseStatusCode :: !Int
  , HttpResponse body -> Map HeaderName ByteString
responseHeaders :: Map.Map HeaderName SB.ByteString
  , HttpResponse body -> body
responseBody :: body
  } deriving (HttpResponse body -> HttpResponse body -> Bool
(HttpResponse body -> HttpResponse body -> Bool)
-> (HttpResponse body -> HttpResponse body -> Bool)
-> Eq (HttpResponse body)
forall body.
Eq body =>
HttpResponse body -> HttpResponse body -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HttpResponse body -> HttpResponse body -> Bool
$c/= :: forall body.
Eq body =>
HttpResponse body -> HttpResponse body -> Bool
== :: HttpResponse body -> HttpResponse body -> Bool
$c== :: forall body.
Eq body =>
HttpResponse body -> HttpResponse body -> Bool
Eq)

instance Show body => Show (HttpResponse body) where
  show :: HttpResponse body -> String
show (HttpResponse { responseStatusCode :: forall body. HttpResponse body -> Int
responseStatusCode = Int
rsc, responseHeaders :: forall body. HttpResponse body -> Map HeaderName ByteString
responseHeaders = Map HeaderName ByteString
rh, responseBody :: forall body. HttpResponse body -> body
responseBody = body
rb }) = 
    [String] -> String
unlines
        [ String
"HttpResponse"
        , String
"{ responseStatusCode = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
rsc
        , String
", responseHeaders    = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Map HeaderName ByteString -> String
forall a. Show a => a -> String
show Map HeaderName ByteString
rh
        , String
", responseBody       = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ body -> String
forall a. Show a => a -> String
show body
rb
        , String
"}"
        ]

instance HasHeaders (HttpResponse b) where
  getHeaders :: HttpResponse b -> Map HeaderName ByteString
getHeaders = HttpResponse b -> Map HeaderName ByteString
forall body. HttpResponse body -> Map HeaderName ByteString
responseHeaders
  getHeaderValue :: HeaderName -> HttpResponse b -> Maybe ByteString
getHeaderValue HeaderName
key = HeaderName -> Map HeaderName ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup HeaderName
key (Map HeaderName ByteString -> Maybe ByteString)
-> (HttpResponse b -> Map HeaderName ByteString)
-> HttpResponse b
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpResponse b -> Map HeaderName ByteString
forall body. HttpResponse body -> Map HeaderName ByteString
responseHeaders