-- Author: Viacheslav Lotsmanov
-- License: AGPLv3

{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Lib
  ( someFunc
  ) where

import Servant
import GHC.Generics
import Data.Aeson
import Network.Wai.Handler.Warp

-- import Servant.API (BasicAuth)
import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))

data User = User { name  ∷ String
                 , age   ∷ Int
                 , email ∷ String
                 } deriving (Eq, Show, Generic)

instance ToJSON User

data PrivateStuff = PrivateStuff { foo ∷ Int
                                 , bar ∷ Int
                                 } deriving (Eq, Show, Generic)

instance ToJSON PrivateStuff

isaac ∷ User
isaac = User "Isaac Newton" 372 "isaac@newton.co.uk"

albert ∷ User
albert = User "Albert Einstein" 136 "ae@mc2.org"

users1 ∷ [User]
users1 = [isaac, albert]


-- type UserAPI1 = "users"  :> Get '[JSON] [User]
--            :<|> "albert" :> Get '[JSON]  User
--            :<|> "isaac"  :> Get '[JSON]  User

type (‣) = (:>)
infixr 9 ‣

type (‡) = (:<|>)
(‡) ∷ a → b → a :<|> b
(‡) = (:<|>)
infixr 8 ‡

(∵) = (:.)
infixr 5 ∵

type UserAPI1 = "users"  ‣ Get '[JSON] [User]
              ‡ "albert" ‣ Get '[JSON]  User
              ‡ "isaac"  ‣ Get '[JSON]  User
              ‡ "admin"  ‣ BasicAuth "test-realm" User ‣ Get '[JSON] PrivateStuff

server1 ∷ Server UserAPI1
server1 = return users1
        ‡ return albert
        ‡ return isaac
        ‡ privateHandler
  where privateHandler (user ∷ User) = return $ PrivateStuff 222 333


authCheck ∷ BasicAuthCheck User
authCheck = BasicAuthCheck check
  where check (BasicAuthData user pass)
          | user == "ae" && pass == "ea" = return $ Authorized albert
          | otherwise                    = return Unauthorized

basicAuthServerContext ∷ Context (BasicAuthCheck User ': '[])
basicAuthServerContext = authCheck ∵ EmptyContext


userAPI ∷ Proxy UserAPI1
userAPI = Proxy

-- app1 ∷ Application
-- app1 = serve userAPI server1

someFunc ∷ IO ()
-- someFunc = run 8081 app1
someFunc = run 8081 $ serveWithContext userAPI
                                       basicAuthServerContext
                                       server1