ImplSpec.hs

{-# LANGUAGE OverloadedLists #-}

module Test.Servant.Sorting.ImplSpec where

import Universum

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.TH as Aeson
import Data.Swagger (ToSchema)
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
import Data.Time.Clock (UTCTime (..))
import Servant.API (Get, JSON, (:>))
import Servant.API.Generic (ToServantApi, (:-))
import Servant.Server.Generic (AsServer)
import Servant.Swagger (toSwagger)

import Test.Hspec (Spec, aroundAll, describe, it)
import Test.Hspec.Expectations (shouldBe)

import Servant.Util
import Servant.Util.Dummy

import Test.Servant.Helpers

-- Data model
---------------------------------------------------------------------------

newtype Isbn = Isbn Word64
  deriving (Show, Eq, Ord, Generic)

instance ToSchema Isbn

Aeson.deriveJSON Aeson.defaultOptions ''Isbn

data Book = Book
  { isbn      :: Isbn
  , name      :: Text
  , rating    :: Word8
  , createdAt :: UTCTime
  } deriving (Show, Eq, Generic)

instance ToSchema Book

Aeson.deriveJSON Aeson.defaultOptions ''Book

-- | Some strictly monotonic function from integers to time.
toUTCTime :: Integer -> UTCTime
toUTCTime idx = UTCTime (fromOrdinalDate idx 0) 0

allBooks :: [Book]
allBooks =
  [ Book
    { isbn = Isbn 111
    , name = "How to cook tofu, the right way"
    , rating = 5
    , createdAt = toUTCTime 1
    }

  , Book
    { isbn = Isbn 100
    , name = "Delving into memes"
    , rating = 5
    , createdAt = toUTCTime 3
    }

  , Book
    { isbn = Isbn 120
    , name = "Book of something"
    , rating = 4
    , createdAt = toUTCTime 8
    }

  ]

-- Server
---------------------------------------------------------------------------

data ApiMethods route = ApiMethods
  { amSimpleSort
      :: route
      :- "simple"
      :> SortingParams
          [ "name" ?: Text
          , "rating" ?: Word8
          , "createdAt" ?: UTCTime
          ]
         '[ "isbn" ?: 'Asc Isbn
          ]
      :> Get '[JSON] [Book]

  , amOverrideableSort
      :: route
      :- "overrideable"
      :> SortingParams
          [ "rating" ?: Word8
          , "createdAt" ?: UTCTime
          , "isbn" ?: Isbn
          ]
          [ "rating" ?: 'Desc Word8
          , "isbn" ?: 'Asc Isbn
          ]
      :> Get '[JSON] [Book]

  , amOverrideableSort2
      :: route
      :- "overrideable2"
      :> SortingParams
          [ "isbn" ?: Isbn
          , "rating" ?: Word8
          ]
          [ "isbn" ?: 'Asc Isbn
          , "rating" ?: 'Asc Word8
          ]
      :> Get '[JSON] [Book]

  } deriving Generic

apiHandlers :: ApiMethods AsServer
apiHandlers = ApiMethods
  { amSimpleSort = \sortingSpec -> do
      let sortingApp Book{..} =
            fieldSort @"name" name .*.
            fieldSort @"rating" rating .*.
            fieldSort @"createdAt" createdAt .*.
            fieldSort @"isbn" isbn .*.
            HNil
      return $ sortBySpec sortingSpec sortingApp allBooks

  , amOverrideableSort = \sortingSpec -> do
      let sortingApp Book{..} =
            fieldSort @"rating" rating .*.
            fieldSort @"createdAt" createdAt .*.
            fieldSort @"isbn" isbn .*.
            fieldSort @"rating" rating .*.
            fieldSort @"isbn" isbn .*.
            HNil
      return $ sortBySpec sortingSpec sortingApp allBooks

  , amOverrideableSort2 = \sortingSpec -> do
      let sortingApp Book{..} =
            fieldSort @"isbn" isbn .*.
            fieldSort @"rating" rating .*.
            fieldSort @"isbn" isbn .*.
            fieldSort @"rating" rating .*.
            HNil
      return $ sortBySpec sortingSpec sortingApp allBooks

  }

-- Swagger
---------------------------------------------------------------------------

-- You can try this with ghci
printSortingSwagger :: IO ()
printSortingSwagger =
  writeFile "sorting-test-swagger.json" $
    decodeUtf8 . Aeson.encode $
    toSwagger $ Proxy @(ToServantApi ApiMethods)

-- Tests
---------------------------------------------------------------------------

spec :: Spec
spec =
  aroundAll (runTestServer apiHandlers) $ do

    describe "Simple sort with base sorting" $ do

      it "No sorting (sole base)" $
        \ApiMethods{..} -> do
          res <- amSimpleSort noSorting
          map isbn res `shouldBe` [Isbn 100, Isbn 111, Isbn 120]

      it "Fully determining sorting (base doesn't matter)" $
        \ApiMethods{..} -> do
          res <- amSimpleSort [asc #createdAt]
          map isbn res `shouldBe` [Isbn 111, Isbn 100, Isbn 120]

      it "Partially determining sorting (base matters)" $
        \ApiMethods{..} -> do
          res <- amSimpleSort [asc #rating]
          map isbn res `shouldBe` [Isbn 120, Isbn 100, Isbn 111]

    describe "Simple sort with overridable base sorting" $ do

      it "No sorting (sole base)" $
        \ApiMethods{..} -> do
          res <- amOverrideableSort noSorting
          map isbn res `shouldBe` [Isbn 100, Isbn 111, Isbn 120]

      it "Base sorting can be overriden" $
        \ApiMethods{..} -> do
          res <- amOverrideableSort [desc #isbn]
          map isbn res `shouldBe` [Isbn 120, Isbn 111, Isbn 100]

      it "Overriden base sorting tolerates the provided sorting order" $
        -- One possible bug is on @rating+,createdAt+@ request ignore @rating+@
        -- since it is part of base sorting. But base sorting matters last, so
        -- that wouldn't be valid.
        \ApiMethods{..} -> do
          res <- amOverrideableSort [asc #rating, asc #createdAt]
          map isbn res `shouldBe` [Isbn 120, Isbn 111, Isbn 100]

      it "Overriden field from base sorting doesn't cancel the remaining base sorting" $
        \ApiMethods{..} -> do
          res <- amOverrideableSort2 [asc #rating]
          map isbn res `shouldBe` [Isbn 120, Isbn 100, Isbn 111]