2023-04-15 22:19:47 +03:00
|
|
|
{-# LANGUAGE ApplicativeDo #-}
|
2023-04-16 03:23:05 +03:00
|
|
|
{-# LANGUAGE BlockArguments #-}
|
2023-04-16 12:03:37 +03:00
|
|
|
{-# LANGUAGE DeriveAnyClass #-}
|
2023-04-17 20:17:52 +03:00
|
|
|
{-# LANGUAGE DerivingStrategies #-}
|
2023-04-15 22:19:47 +03:00
|
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
2023-04-16 12:03:37 +03:00
|
|
|
{-# LANGUAGE ImportQualifiedPost #-}
|
2023-04-16 03:23:05 +03:00
|
|
|
{-# LANGUAGE LinearTypes #-}
|
2022-07-03 09:46:12 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2023-04-16 12:03:37 +03:00
|
|
|
{-# LANGUAGE PatternSynonyms #-}
|
2023-04-17 20:17:52 +03:00
|
|
|
{-# LANGUAGE QualifiedDo #-}
|
2023-04-15 23:39:54 +03:00
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
2022-07-31 08:50:12 +03:00
|
|
|
{-# LANGUAGE TypeApplications #-}
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
import Control.Exception (evaluate)
|
2023-04-16 12:03:37 +03:00
|
|
|
import Data.Aeson qualified as Aeson
|
2023-04-18 11:20:35 +03:00
|
|
|
import Data.OpenApi qualified as OAPI
|
2023-04-16 12:03:37 +03:00
|
|
|
import Data.Text qualified as Text
|
|
|
|
import Network.HTTP.Types qualified as HTTP
|
2023-04-20 09:33:20 +03:00
|
|
|
import Okapi.Endpoint
|
|
|
|
import Okapi.Script
|
2023-04-21 08:13:34 +03:00
|
|
|
import Okapi.Script.AddHeader (Response)
|
2023-04-21 11:21:39 +03:00
|
|
|
import Okapi.Script.AddHeader qualified as AddHeaders
|
2023-04-20 09:33:20 +03:00
|
|
|
import Okapi.Script.Body qualified as Body
|
|
|
|
import Okapi.Script.Headers qualified as Headers
|
|
|
|
import Okapi.Script.Path qualified as Path
|
|
|
|
import Okapi.Script.Query qualified as Query
|
|
|
|
import Okapi.Script.Responder qualified as Responder
|
2023-04-16 12:03:37 +03:00
|
|
|
import Prelude.Linear qualified as L
|
2023-04-15 22:19:47 +03:00
|
|
|
import Test.Hspec
|
2023-04-16 12:03:37 +03:00
|
|
|
import Web.HttpApiData qualified as Web
|
2022-08-04 03:22:25 +03:00
|
|
|
|
2022-03-30 03:07:37 +03:00
|
|
|
main :: IO ()
|
2023-04-15 22:19:47 +03:00
|
|
|
main = hspec $ do
|
2023-04-15 23:39:54 +03:00
|
|
|
describe "Path Operations" $ do
|
2023-04-15 22:19:47 +03:00
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Path.eval path1 ["index"] `shouldBe` (Ok (), [])
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Path.eval path1 ["index", "about"] `shouldBe` (Fail Path.NotEnoughOperations, ["index", "about"])
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Path.eval path2 ["item", "5"] `shouldBe` (Ok 5, [])
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Path.eval path2 ["item"] `shouldBe` (Fail Path.TooManyOperations, ["item"])
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Path.eval path3 ["product", "books", "56708"] `shouldBe` (Ok (Category "books", ProductID 56708), [])
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Path.eval path3 ["product", "books", "56708", "info"] `shouldBe` (Fail Path.NotEnoughOperations, ["product", "books", "56708", "info"])
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Path.eval path3 ["product", "books"] `shouldBe` (Fail Path.TooManyOperations, ["product", "books"])
|
2023-04-15 22:19:47 +03:00
|
|
|
|
2023-04-15 23:39:54 +03:00
|
|
|
describe "Query Operations" $ do
|
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Query.eval query1 [("score", Just "5"), ("user", Just "Joe")] `shouldBe` (Ok $ Filter 5 $ Username "Joe", [])
|
2023-04-15 23:39:54 +03:00
|
|
|
|
2023-04-17 20:17:52 +03:00
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Query.eval query2 [("user", Just "Bob"), ("active", Nothing)] `shouldBe` (Ok $ Username "Bob", [])
|
2023-04-15 23:39:54 +03:00
|
|
|
|
2023-04-17 20:17:52 +03:00
|
|
|
it "returns the first element of a list" $ do
|
2023-04-20 09:33:20 +03:00
|
|
|
Query.eval query3 [("username", Just "Bob")] `shouldBe` (Ok (Username "Anon", Nothing), [("username", Just "Bob")])
|
2023-04-16 03:23:05 +03:00
|
|
|
|
2023-04-21 11:21:39 +03:00
|
|
|
data AddHeaders = AddHeaders
|
2023-04-20 09:33:20 +03:00
|
|
|
{ addCookie :: Username -> Response -> Response,
|
|
|
|
addAnotherHeader :: Username -> Response -> Response,
|
|
|
|
cacheHeader :: Int -> Response -> Response
|
2023-04-16 03:23:05 +03:00
|
|
|
}
|
|
|
|
|
2023-04-18 11:20:35 +03:00
|
|
|
responder1 = do
|
2023-04-16 03:23:05 +03:00
|
|
|
itsOk <- Responder.json
|
|
|
|
@Aeson.Value
|
|
|
|
HTTP.status200
|
2023-04-18 11:20:35 +03:00
|
|
|
do
|
2023-04-21 11:21:39 +03:00
|
|
|
addCookie <- AddHeaders.using @Username "Cookie"
|
2023-04-18 11:20:35 +03:00
|
|
|
pure addCookie
|
2023-04-16 03:23:05 +03:00
|
|
|
itsNotFound <- Responder.json
|
|
|
|
@Aeson.Value
|
|
|
|
HTTP.status404
|
2023-04-18 11:20:35 +03:00
|
|
|
do
|
2023-04-21 11:21:39 +03:00
|
|
|
addCookie <- AddHeaders.using @Username "Blob"
|
|
|
|
addAnotherHeader <- AddHeaders.using @Username "X-Some-Header"
|
|
|
|
cacheHeader <- AddHeaders.using @Int "X-Cache-Time"
|
|
|
|
pure $ AddHeaders {..}
|
2023-04-18 11:20:35 +03:00
|
|
|
pure (itsOk, itsNotFound)
|
2023-04-16 03:23:05 +03:00
|
|
|
|
|
|
|
responder2 = undefined
|
|
|
|
|
2023-04-15 23:39:54 +03:00
|
|
|
newtype Username = Username {unwrap :: Text.Text}
|
2023-04-18 11:20:35 +03:00
|
|
|
deriving newtype (Eq, Show, Web.FromHttpApiData, Web.ToHttpApiData, OAPI.ToSchema, Aeson.ToJSON)
|
2023-04-15 23:39:54 +03:00
|
|
|
|
|
|
|
data Filter = Filter
|
|
|
|
{ score :: Int,
|
|
|
|
byUser :: Username
|
|
|
|
}
|
|
|
|
deriving (Eq, Show)
|
|
|
|
|
2023-04-20 09:33:20 +03:00
|
|
|
query1 :: Query.Script Filter
|
2023-04-18 11:20:35 +03:00
|
|
|
query1 = do
|
2023-04-15 23:39:54 +03:00
|
|
|
score <- Query.param @Int "score"
|
|
|
|
byUser <- Query.param @Username "user"
|
2023-04-18 11:20:35 +03:00
|
|
|
pure Filter {..}
|
2023-04-15 23:39:54 +03:00
|
|
|
|
2023-04-20 09:33:20 +03:00
|
|
|
query2 :: Query.Script Username
|
2023-04-18 11:20:35 +03:00
|
|
|
query2 = do
|
2023-04-15 23:39:54 +03:00
|
|
|
username <- Query.param @Username "user"
|
|
|
|
Query.flag "active"
|
2023-04-18 11:20:35 +03:00
|
|
|
pure username
|
2023-04-15 23:39:54 +03:00
|
|
|
|
2023-04-20 09:33:20 +03:00
|
|
|
query3 :: Query.Script (Username, Maybe ())
|
2023-04-18 11:20:35 +03:00
|
|
|
query3 = do
|
2023-04-15 23:39:54 +03:00
|
|
|
user <- Query.option (Username "Anon") $ Query.param "user"
|
|
|
|
active <- Query.optional $ Query.flag "active"
|
2023-04-18 11:20:35 +03:00
|
|
|
pure (user, active)
|
2023-04-15 23:39:54 +03:00
|
|
|
|
2023-04-20 09:33:20 +03:00
|
|
|
path1 :: Path.Script ()
|
2023-04-15 22:19:47 +03:00
|
|
|
path1 = Path.static "index"
|
|
|
|
|
2023-04-20 09:33:20 +03:00
|
|
|
path2 :: Path.Script Int
|
2023-04-18 11:20:35 +03:00
|
|
|
path2 = do
|
2023-04-15 22:19:47 +03:00
|
|
|
Path.static "item"
|
2023-04-18 11:20:35 +03:00
|
|
|
uuid <- Path.param @Int "uuid"
|
|
|
|
pure uuid
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
newtype Category = Category {unwrap :: Text.Text}
|
2023-04-18 11:20:35 +03:00
|
|
|
deriving newtype (Eq, Show, Web.FromHttpApiData, OAPI.ToSchema, Aeson.ToJSON)
|
2023-04-15 22:19:47 +03:00
|
|
|
|
|
|
|
newtype ProductID = ProductID {unwrap :: Int}
|
2023-04-18 11:20:35 +03:00
|
|
|
deriving newtype (Eq, Show, Web.FromHttpApiData, OAPI.ToSchema, Aeson.ToJSON)
|
2023-04-15 22:19:47 +03:00
|
|
|
|
2023-04-20 09:33:20 +03:00
|
|
|
path3 :: Path.Script (Category, ProductID)
|
2023-04-18 11:20:35 +03:00
|
|
|
path3 = do
|
2023-04-15 22:19:47 +03:00
|
|
|
Path.static "product"
|
2023-04-18 11:20:35 +03:00
|
|
|
category <- Path.param @Category "category"
|
|
|
|
productID <- Path.param @ProductID "productID"
|
|
|
|
pure (category, productID)
|
2023-04-18 10:36:12 +03:00
|
|
|
|
2023-04-16 12:03:37 +03:00
|
|
|
testPlan =
|
2023-04-20 09:33:20 +03:00
|
|
|
Plan
|
2023-04-18 10:36:12 +03:00
|
|
|
id
|
2023-04-20 09:33:20 +03:00
|
|
|
( Endpoint
|
2023-04-18 11:20:35 +03:00
|
|
|
HTTP.GET
|
|
|
|
do
|
2023-04-18 10:36:12 +03:00
|
|
|
Path.static "index"
|
2023-04-18 11:20:35 +03:00
|
|
|
magicNumber <- Path.param @Int "magicNumber"
|
|
|
|
pure magicNumber
|
|
|
|
do
|
2023-04-18 10:36:12 +03:00
|
|
|
x <- Query.param @Int "x"
|
|
|
|
y <- Query.option 10 $ Query.param @Int "y"
|
2023-04-18 11:20:35 +03:00
|
|
|
pure (x, y)
|
|
|
|
do pure ()
|
|
|
|
do pure ()
|
|
|
|
do
|
2023-04-19 04:53:13 +03:00
|
|
|
itsOk <- Responder.json @Int HTTP.status200 do
|
2023-04-21 11:21:39 +03:00
|
|
|
addSecretNumber <- AddHeaders.using @Int "X-SECRET"
|
2023-04-19 04:53:13 +03:00
|
|
|
pure addSecretNumber
|
2023-04-18 11:20:35 +03:00
|
|
|
pure itsOk
|
2023-04-18 10:36:12 +03:00
|
|
|
)
|
|
|
|
\magicNumber (x, y) () () responder ->
|
|
|
|
do
|
2023-04-16 12:03:37 +03:00
|
|
|
let newNumber = magicNumber + x * y
|
|
|
|
print newNumber
|
|
|
|
return $ responder (\addHeader response -> addHeader (newNumber * 100) response) newNumber
|