module Freckle.App.HttpSpec
  ( spec
  ) where

import Prelude

import Control.Lens (to, (^?), _Left, _Right)
import Data.Aeson
import Data.Aeson.Lens
import Data.List.NonEmpty qualified as NE
import Freckle.App.Http
import Freckle.App.Test.Http
import Network.HTTP.Types.Status (status200)
import Test.Hspec

spec :: Spec
spec :: Spec
spec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"httpJson" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [HttpStub]
stubs <- IO [HttpStub] -> SpecM () [HttpStub]
forall r a. IO r -> SpecM a r
runIO (IO [HttpStub] -> SpecM () [HttpStub])
-> IO [HttpStub] -> SpecM () [HttpStub]
forall a b. (a -> b) -> a -> b
$ String -> IO [HttpStub]
loadHttpStubsDirectory String
"tests/files"

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"fetches JSON via HTTP" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
      Response (Either HttpDecodeError Value)
resp <-
        (HttpStubsT IO (Response (Either HttpDecodeError Value))
 -> [HttpStub] -> IO (Response (Either HttpDecodeError Value)))
-> [HttpStub]
-> HttpStubsT IO (Response (Either HttpDecodeError Value))
-> IO (Response (Either HttpDecodeError Value))
forall a b c. (a -> b -> c) -> b -> a -> c
flip HttpStubsT IO (Response (Either HttpDecodeError Value))
-> [HttpStub] -> IO (Response (Either HttpDecodeError Value))
forall (m :: * -> *) a. HttpStubsT m a -> [HttpStub] -> m a
runHttpStubsT [HttpStub]
stubs
          (HttpStubsT IO (Response (Either HttpDecodeError Value))
 -> IO (Response (Either HttpDecodeError Value)))
-> (Request
    -> HttpStubsT IO (Response (Either HttpDecodeError Value)))
-> Request
-> IO (Response (Either HttpDecodeError Value))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadHttp m, FromJSON a) =>
Request -> m (Response (Either HttpDecodeError a))
httpJson @_ @Value
          (Request -> IO (Response (Either HttpDecodeError Value)))
-> Request -> IO (Response (Either HttpDecodeError Value))
forall a b. (a -> b) -> a -> b
$ String -> Request
parseRequest_ String
"https://www.stackage.org/lts-17.10"

      Response (Either HttpDecodeError Value) -> Status
forall a. Response a -> Status
getResponseStatus Response (Either HttpDecodeError Value)
resp Status -> Status -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Status
status200
      Response (Either HttpDecodeError Value)
-> Either HttpDecodeError Value
forall a. Response a -> a
getResponseBody Response (Either HttpDecodeError Value)
resp
        Either HttpDecodeError Value
-> Getting (First Text) (Either HttpDecodeError Value) Text
-> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Value -> Const (First Text) Value)
-> Either HttpDecodeError Value
-> Const (First Text) (Either HttpDecodeError Value)
forall c a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either c a) (f (Either c b))
_Right
          ((Value -> Const (First Text) Value)
 -> Either HttpDecodeError Value
 -> Const (First Text) (Either HttpDecodeError Value))
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) (Either HttpDecodeError Value) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"snapshot"
          ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> (Text -> Const (First Text) Text)
-> Value
-> Const (First Text) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"ghc"
          ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> (Text -> Const (First Text) Text)
-> Value
-> Const (First Text) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
Prism' Value Text
_String
        Maybe Text -> Maybe Text -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"8.10.4"

    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"places JSON parse errors in a Left body" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
      Response (Either HttpDecodeError [()])
resp <-
        (HttpStubsT IO (Response (Either HttpDecodeError [()]))
 -> [HttpStub] -> IO (Response (Either HttpDecodeError [()])))
-> [HttpStub]
-> HttpStubsT IO (Response (Either HttpDecodeError [()]))
-> IO (Response (Either HttpDecodeError [()]))
forall a b c. (a -> b -> c) -> b -> a -> c
flip HttpStubsT IO (Response (Either HttpDecodeError [()]))
-> [HttpStub] -> IO (Response (Either HttpDecodeError [()]))
forall (m :: * -> *) a. HttpStubsT m a -> [HttpStub] -> m a
runHttpStubsT [HttpStub]
stubs
          (HttpStubsT IO (Response (Either HttpDecodeError [()]))
 -> IO (Response (Either HttpDecodeError [()])))
-> (Request
    -> HttpStubsT IO (Response (Either HttpDecodeError [()])))
-> Request
-> IO (Response (Either HttpDecodeError [()]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadHttp m, FromJSON a) =>
Request -> m (Response (Either HttpDecodeError a))
httpJson @_ @[()]
          (Request -> IO (Response (Either HttpDecodeError [()])))
-> Request -> IO (Response (Either HttpDecodeError [()]))
forall a b. (a -> b) -> a -> b
$ String -> Request
parseRequest_ String
"https://www.stackage.org/lts-17.10"

      let expectedErrorMessages :: [a]
expectedErrorMessages =
            [ a
"Error in $: expected [a], encountered Object"
            , a
"Error in $: parsing [] failed, expected Array, but encountered Object"
            ]

      Response (Either HttpDecodeError [()]) -> Status
forall a. Response a -> Status
getResponseStatus Response (Either HttpDecodeError [()])
resp Status -> Status -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Status
status200
      Response (Either HttpDecodeError [()])
-> Either HttpDecodeError [()]
forall a. Response a -> a
getResponseBody Response (Either HttpDecodeError [()])
resp
        Either HttpDecodeError [()]
-> Getting (First String) (Either HttpDecodeError [()]) String
-> Maybe String
forall s a. s -> Getting (First a) s a -> Maybe a
^? (HttpDecodeError -> Const (First String) HttpDecodeError)
-> Either HttpDecodeError [()]
-> Const (First String) (Either HttpDecodeError [()])
forall a c b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Either a c) (f (Either b c))
_Left
          ((HttpDecodeError -> Const (First String) HttpDecodeError)
 -> Either HttpDecodeError [()]
 -> Const (First String) (Either HttpDecodeError [()]))
-> ((String -> Const (First String) String)
    -> HttpDecodeError -> Const (First String) HttpDecodeError)
-> Getting (First String) (Either HttpDecodeError [()]) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HttpDecodeError -> NonEmpty String)
-> Optic'
     (->) (Const (First String)) HttpDecodeError (NonEmpty String)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to HttpDecodeError -> NonEmpty String
hdeErrors
          Optic'
  (->) (Const (First String)) HttpDecodeError (NonEmpty String)
-> ((String -> Const (First String) String)
    -> NonEmpty String -> Const (First String) (NonEmpty String))
-> (String -> Const (First String) String)
-> HttpDecodeError
-> Const (First String) HttpDecodeError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty String -> String)
-> (String -> Const (First String) String)
-> NonEmpty String
-> Const (First String) (NonEmpty String)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NonEmpty String -> String
forall a. NonEmpty a -> a
NE.head
        Maybe String -> (Maybe String -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Bool -> (String -> Bool) -> Maybe String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
forall {a}. IsString a => [a]
expectedErrorMessages)