git.iko.soy/servant
on master help sign in
Remove servant-examples (again)
7902908Julian K. Arni
servant-examples/auth-combinator/auth-combinator.hsdeleted−124
compare with master
unifiedsplit
@@ -1,124 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE TypeOperators #-}
10−{-# LANGUAGE UndecidableInstances #-}
11−
12−import Control.Monad.Trans.Except (ExceptT, throwE)
13−import Data.Aeson hiding ((.:))
14−import Data.ByteString (ByteString)
15−import Data.Monoid ((<>))
16−import Data.Map (Map, fromList)
17−import qualified Data.Map as Map
18−import Data.Text (Text)
19−import GHC.Generics
20−import Network.Wai
21−import Network.Wai.Handler.Warp
22−import Servant
23−import Servant.Server.Experimental.Auth
24−
25−-- | This file contains an authenticated server using servant's generalized
26−-- authentication support. Our basic authentication scheme is trivial: we
27−-- look for a cookie named "servant-auth-cookie" and its value will contain
28−-- a key, which we use to lookup a User. Obviously this is an absurd example,
29−-- but we pick something simple and non-standard to show you how to extend
30−-- servant's support for authentication.
31−
32−-- | A user type that we "fetch from the database" after
33−-- performing authentication
34−newtype User = User { unUser :: Text }
35−
36−-- | A (pure) database mapping keys to users.
37−database :: Map ByteString User
38−database = fromList [ ("key1", User "Anne Briggs")
39− , ("key2", User "Bruce Cockburn")
40− , ("key3", User "Ghédalia Tazartès")
41− ]
42−
43−-- | A method that, when given a password, will return a User.
44−-- This is our bespoke (and bad) authentication logic.
45−lookupUser :: ByteString -> ExceptT ServantErr IO User
46−lookupUser key = case Map.lookup key database of
47− Nothing -> throwE (err403 { errBody = "Invalid Cookie" })
48− Just usr -> return usr
49−
50−-- | The auth handler wraps a function from Request -> ExceptT ServantErr IO User
51−-- we look for a Cookie and pass the value of the cookie to `lookupUser`.
52−authHandler :: AuthHandler Request User
53−authHandler =
54− let handler req = case lookup "servant-auth-cookie" (requestHeaders req) of
55− Nothing -> throwE (err401 { errBody = "Missing auth header" })
56− Just authCookieKey -> lookupUser authCookieKey
57− in mkAuthHandler handler
58−
59−-- | Data types that will be returned from various api endpoints
60−newtype PrivateData = PrivateData { ssshhh :: Text }
61− deriving (Eq, Show, Generic)
62−
63−instance ToJSON PrivateData
64−
65−newtype PublicData = PublicData { somedata :: Text }
66− deriving (Eq, Show, Generic)
67−
68−instance ToJSON PublicData
69−
70−-- | Our private API that we want to be auth-protected.
71−type PrivateAPI = Get '[JSON] [PrivateData]
72−
73−-- | Our public API that doesn't have any protection
74−type PublicAPI = Get '[JSON] [PublicData]
75−
76−-- | Our API, with auth-protection
77−type API = "private" :> AuthProtect "cookie-auth" :> PrivateAPI
78− :<|> "public" :> PublicAPI
79−
80−-- | A value holding our type-level API
81−api :: Proxy API
82−api = Proxy
83−
84−-- | We need to specify the data returned after authentication
85−type instance AuthServerData (AuthProtect "cookie-auth") = User
86−
87−-- | The context that will be made available to request handlers. We supply the
88−-- "cookie-auth"-tagged request handler defined above, so that the 'HasServer' instance
89−-- of 'AuthProtect' can extract the handler and run it on the request.
90−serverContext :: Context (AuthHandler Request User ': '[])
91−serverContext = authHandler :. EmptyContext
92−
93−-- | Our API, where we provide all the author-supplied handlers for each end
94−-- point. Note that 'privateDataFunc' is a function that takes 'User' as an
95−-- argument. We dont' worry about the authentication instrumentation here,
96−-- that is taken care of by supplying context
97−server :: Server API
98−server = privateDataFunc :<|> return publicData
99−
100− where privateDataFunc (User name) =
101− return [PrivateData ("this is a secret: " <> name)]
102− publicData = [PublicData "this is a public piece of data"]
103−
104−-- | run our server
105−main :: IO ()
106−main = run 8080 (serveWithContext api serverContext server)
107−
108−{- Sample Session:
109−
110−$ curl -XGET localhost:8080/private
111−Missing auth header
112−>>>>>>> modify auth-combinator example for gen auth
113−>>>>>>> 8246c1f... modify auth-combinator example for gen auth
114−
115−$ curl -XGET localhost:8080/private -H "servant-auth-cookie: key3"
116−[{"ssshhh":"this is a secret: Ghédalia Tazartès"}]
117−
118−$ curl -XGET localhost:8080/private -H "servant-auth-cookie: bad-key"
119−Invalid Cookie
120−
121−$ curl -XGET localhost:8080/public
122−[{"somedata":"this is a public piece of data"}]
123−-}
124−
servant-examples/basic-auth/basic-auth.hsdeleted−105
@@ -1,105 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−{-# LANGUAGE TypeOperators #-}
6−
7−module Main where
8−
9−import Data.Aeson (ToJSON)
10−import Data.Proxy (Proxy (Proxy))
11−import Data.Text (Text)
12−import GHC.Generics (Generic)
13−import Network.Wai.Handler.Warp (run)
14−import Servant.API ((:<|>) ((:<|>)), (:>), BasicAuth,
15− Get, JSON)
16−import Servant.API.BasicAuth (BasicAuthData (BasicAuthData))
17−import Servant.Server (BasicAuthCheck (BasicAuthCheck),
18− BasicAuthResult( Authorized
19− , Unauthorized
20− ),
21− Context ((:.), EmptyContext), Server,
22− serveWithContext)
23−
24−-- | let's define some types that our API returns.
25−
26−-- | private data that needs protection
27−newtype PrivateData = PrivateData { ssshhh :: Text }
28− deriving (Eq, Show, Generic)
29−
30−instance ToJSON PrivateData
31−
32−-- | public data that anyone can use.
33−newtype PublicData = PublicData { somedata :: Text }
34− deriving (Eq, Show, Generic)
35−
36−instance ToJSON PublicData
37−
38−-- | A user we'll grab from the database when we authenticate someone
39−newtype User = User { userName :: Text }
40− deriving (Eq, Show)
41−
42−-- | a type to wrap our public api
43−type PublicAPI = Get '[JSON] [PublicData]
44−
45−-- | a type to wrap our private api
46−type PrivateAPI = Get '[JSON] PrivateData
47−
48−-- | our API
49−type API = "public" :> PublicAPI
50− :<|> "private" :> BasicAuth "foo-realm" User :> PrivateAPI
51−
52−-- | a value holding a proxy of our API type
53−api :: Proxy API
54−api = Proxy
55−
56−-- | 'BasicAuthCheck' holds the handler we'll use to verify a username and password.
57−authCheck :: BasicAuthCheck User
58−authCheck =
59− let check (BasicAuthData username password) =
60− if username == "servant" && password == "server"
61− then return (Authorized (User "servant"))
62− else return Unauthorized
63− in BasicAuthCheck check
64−
65−-- | We need to supply our handlers with the right Context. In this case,
66−-- Basic Authentication requires a Context Entry with the 'BasicAuthCheck' value
67−-- tagged with "foo-tag" This context is then supplied to 'server' and threaded
68−-- to the BasicAuth HasServer handlers.
69−serverContext :: Context (BasicAuthCheck User ': '[])
70−serverContext = authCheck :. EmptyContext
71−
72−-- | an implementation of our server. Here is where we pass all the handlers to our endpoints.
73−-- In particular, for the BasicAuth protected handler, we need to supply a function
74−-- that takes 'User' as an argument.
75−server :: Server API
76−server =
77− let publicAPIHandler = return [PublicData "foo", PublicData "bar"]
78− privateAPIHandler (user :: User) = return (PrivateData (userName user))
79− in publicAPIHandler :<|> privateAPIHandler
80−
81−-- | hello, server!
82−main :: IO ()
83−main = run 8080 (serveWithContext api serverContext server)
84−
85−{- Sample session
86−
87−$ curl -XGET localhost:8080/public
88−[{"somedata":"foo"},{"somedata":"bar"}
89−
90−$ curl -iXGET localhost:8080/private
91−HTTP/1.1 401 Unauthorized
92−transfer-encoding: chunked
93−Date: Thu, 07 Jan 2016 22:36:38 GMT
94−Server: Warp/3.1.8
95−WWW-Authenticate: Basic realm="foo-realm"
96−
97−$ curl -iXGET localhost:8080/private -H "Authorization: Basic c2VydmFudDpzZXJ2ZXI="
98−HTTP/1.1 200 OK
99−transfer-encoding: chunked
100−Date: Thu, 07 Jan 2016 22:37:58 GMT
101−Server: Warp/3.1.8
102−Content-Type: application/json
103−
104−{"ssshhh":"servant"}
105−-}
servant-examples/servant-examples.cabaldeleted−148
@@ -1,148 +0,0 @@
1−name: servant-examples
2−version: 0.5
3−synopsis: Example programs for servant
4−description: Example programs for servant,
5− showcasing solutions to common needs.
6−homepage: http://haskell-servant.github.io/
7−license: BSD3
8−license-file: LICENSE
9−author: Servant Contributors
10−maintainer: haskell-servant-maintainers@googlegroups.com
11−copyright: 2015-2016 Servant Contributors
12−category: Web
13−build-type: Simple
14−cabal-version: >=1.10
15−bug-reports: http://github.com/haskell-servant/servant/issues
16−source-repository head
17− type: git
18− location: http://github.com/haskell-servant/servant.git
19−
20−executable tutorial
21− main-is: tutorial.hs
22− other-modules: T1, T2, T3, T4, T5, T6, T7, T8, T9, T10
23− ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-unused-imports
24− build-depends:
25− aeson >= 0.8
26− , base >= 4.7 && < 5
27− , bytestring
28− , directory
29− , http-types
30− , js-jquery
31− , lucid
32− , random
33− , servant == 0.5.*
34− , servant-docs == 0.5.*
35− , servant-js == 0.5.*
36− , servant-lucid == 0.5.*
37− , servant-server == 0.5.*
38− , text
39− , time
40− , transformers
41− , transformers-compat
42− , wai
43− , warp
44− hs-source-dirs: tutorial
45− default-language: Haskell2010
46−
47−executable t8-main
48− main-is: t8-main.hs
49− other-modules: T3, T8
50− hs-source-dirs: tutorial
51− default-language: Haskell2010
52− ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
53− build-depends:
54− aeson
55− , base >= 4.7 && < 5
56− , http-client > 0.4 && < 0.5
57− , servant == 0.5.*
58− , servant-client == 0.5.*
59− , servant-server == 0.5.*
60− , transformers
61− , transformers-compat
62− , wai
63−
64−executable hackage
65− main-is: hackage.hs
66− build-depends:
67− aeson >= 0.8
68− , base >=4.7 && < 5
69− , http-client > 0.4 && < 0.5
70− , servant == 0.5.*
71− , servant-client == 0.5.*
72− , text
73− , transformers
74− , transformers-compat
75− hs-source-dirs: hackage
76− default-language: Haskell2010
77−
78−executable wai-middleware
79− main-is: wai-middleware.hs
80− build-depends:
81− aeson >= 0.8
82− , base >= 4.7 && < 5
83− , servant == 0.5.*
84− , servant-server == 0.5.*
85− , text
86− , wai
87− , wai-extra
88− , warp
89− hs-source-dirs: wai-middleware
90− default-language: Haskell2010
91−
92−executable basic-auth
93− main-is: basic-auth.hs
94− ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
95− build-depends:
96− aeson >= 0.8
97− , base >= 4.7 && < 5
98− , bytestring
99− , http-types
100− , servant == 0.5.*
101− , servant-server == 0.5.*
102− , text
103− , wai
104− , warp
105− hs-source-dirs: basic-auth
106− default-language: Haskell2010
107−
108−executable auth-combinator
109− main-is: auth-combinator.hs
110− ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
111− build-depends:
112− aeson >= 0.8
113− , base >= 4.7 && < 5
114− , bytestring
115− , containers
116− , http-types
117− , servant == 0.5.*
118− , servant-server == 0.5.*
119− , text
120− , transformers
121− , wai
122− , warp
123− hs-source-dirs: auth-combinator
124− default-language: Haskell2010
125−
126−executable socket-io-chat
127− main-is: socket-io-chat.hs
128− ghc-options: -Wall -fno-warn-unused-binds -fno-warn-name-shadowing
129− other-modules: Chat
130− build-depends:
131− aeson >= 0.8
132− , base >= 4.7 && < 5
133− , bytestring
134− , http-types
135− , servant == 0.5.*
136− , servant-server == 0.5.*
137− , socket-io
138− , engine-io
139− , engine-io-wai
140− , text
141− , wai
142− , warp
143− , transformers
144− , stm
145− , mtl
146− ghc-options: -Wall -O2 -threaded
147− hs-source-dirs: socket-io-chat
148− default-language: Haskell2010
servant-examples/socket-io-chat/socket-io-chat.hsdeleted−54
@@ -1,54 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TypeOperators #-}
5−
6−
7−import Data.Monoid ((<>))
8−#if !MIN_VERSION_base(4,8,0)
9−import Control.Applicative ((<$>))
10−#endif
11−import Network.EngineIO.Wai
12−import Network.Wai
13−import Network.Wai.Handler.Warp (run)
14−import Servant
15−
16−
17−import qualified Control.Concurrent.STM as STM
18−import qualified Network.SocketIO as SocketIO
19−
20−
21−import Chat (ServerState (..), eioServer)
22−
23−
24−type API = "socket.io" :> Raw
25− :<|> Raw
26−
27−
28−api :: Proxy API
29−api = Proxy
30−
31−
32−server :: WaiMonad () -> Server API
33−server sHandler = socketIOHandler
34− :<|> serveDirectory "socket-io-chat/resources"
35−
36− where
37− socketIOHandler req respond = toWaiApplication sHandler req respond
38−
39−
40−app :: WaiMonad () -> Application
41−app sHandler = serve api $ server sHandler
42−
43−port :: Int
44−port = 3001
45−
46−
47−main :: IO ()
48−main = do
49− state <- ServerState <$> STM.newTVarIO 0
50− sHandler <- SocketIO.initialize waiAPI (eioServer state)
51− putStrLn $ "Running on " <> show port
52− run port $ app sHandler
53−
54−
servant-examples/tutorial/T1.hsdeleted−45
@@ -1,45 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE TypeFamilies #-}
5−{-# LANGUAGE TypeOperators #-}
6−module T1 where
7−
8−import Data.Aeson
9−import Data.Time.Calendar
10−import GHC.Generics
11−import Network.Wai
12−import Servant
13−
14−data User = User
15− { name :: String
16− , age :: Int
17− , email :: String
18− , registration_date :: Day
19− } deriving (Eq, Show, Generic)
20−
21−#if !MIN_VERSION_aeson(0,10,0)
22−-- orphan ToJSON instance for Day. necessary to derive one for User
23−instance ToJSON Day where
24− -- display a day in YYYY-mm-dd format
25− toJSON d = toJSON (showGregorian d)
26−#endif
27−
28−instance ToJSON User
29−
30−type UserAPI = "users" :> Get '[JSON] [User]
31−
32−users :: [User]
33−users =
34− [ User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1)
35− , User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1)
36− ]
37−
38−userAPI :: Proxy UserAPI
39−userAPI = Proxy
40−
41−server :: Server UserAPI
42−server = return users
43−
44−app :: Application
45−app = serve userAPI server
servant-examples/tutorial/T10.hsdeleted−71
@@ -1,71 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE TypeFamilies #-}
6−{-# LANGUAGE TypeOperators #-}
7−module T10 where
8−
9−import Data.ByteString.Lazy (ByteString)
10−import Data.Text.Lazy (pack)
11−import Data.Text.Lazy.Encoding (encodeUtf8)
12−import Network.HTTP.Types
13−import Network.Wai
14−import Servant
15−import Servant.Docs
16−import qualified T3
17−
18−type DocsAPI = T3.API :<|> Raw
19−
20−instance ToCapture (Capture "x" Int) where
21− toCapture _ = DocCapture "x" "(integer) position on the x axis"
22−
23−instance ToCapture (Capture "y" Int) where
24− toCapture _ = DocCapture "y" "(integer) position on the y axis"
25−
26−instance ToSample T3.Position where
27− toSamples _ = singleSample (T3.Position 3 14)
28−
29−instance ToParam (QueryParam "name" String) where
30− toParam _ =
31− DocQueryParam "name"
32− ["Alp", "John Doe", "..."]
33− "Name of the person to say hello to."
34− Normal
35−
36−instance ToSample T3.HelloMessage where
37− toSamples _ =
38− [ ("When a value is provided for 'name'", T3.HelloMessage "Hello, Alp")
39− , ("When 'name' is not specified", T3.HelloMessage "Hello, anonymous coward")
40− ]
41−
42−ci :: T3.ClientInfo
43−ci = T3.ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]
44−
45−instance ToSample T3.ClientInfo where
46− toSamples _ = singleSample ci
47−
48−instance ToSample T3.Email where
49− toSamples _ = singleSample (T3.emailForClient ci)
50−
51−api :: Proxy DocsAPI
52−api = Proxy
53−
54−docsBS :: ByteString
55−docsBS = encodeUtf8
56− . pack
57− . markdown
58− $ docsWithIntros [intro] T3.api
59−
60− where intro = DocIntro "Welcome" ["This is our super webservice's API.", "Enjoy!"]
61−
62−server :: Server DocsAPI
63−server = T3.server :<|> serveDocs
64−
65− where serveDocs _ respond =
66− respond $ responseLBS ok200 [plain] docsBS
67−
68− plain = ("Content-Type", "text/plain")
69−
70−app :: Application
71−app = serve api server
servant-examples/tutorial/T2.hsdeleted−52
@@ -1,52 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveGeneric #-}
4−{-# LANGUAGE TypeFamilies #-}
5−{-# LANGUAGE TypeOperators #-}
6−module T2 where
7−
8−import Data.Aeson
9−import Data.Time.Calendar
10−import GHC.Generics
11−import Network.Wai
12−import Servant
13−
14−data User = User
15− { name :: String
16− , age :: Int
17− , email :: String
18− , registration_date :: Day
19− } deriving (Eq, Show, Generic)
20−
21−#if !MIN_VERSION_aeson(0,10,0)
22−-- orphan ToJSON instance for Day. necessary to derive one for User
23−instance ToJSON Day where
24− -- display a day in YYYY-mm-dd format
25− toJSON d = toJSON (showGregorian d)
26−#endif
27−
28−instance ToJSON User
29−
30−type UserAPI = "users" :> Get '[JSON] [User]
31− :<|> "albert" :> Get '[JSON] User
32− :<|> "isaac" :> Get '[JSON] User
33−
34−isaac :: User
35−isaac = User "Isaac Newton" 372 "isaac@newton.co.uk" (fromGregorian 1683 3 1)
36−
37−albert :: User
38−albert = User "Albert Einstein" 136 "ae@mc2.org" (fromGregorian 1905 12 1)
39−
40−users :: [User]
41−users = [isaac, albert]
42−
43−userAPI :: Proxy UserAPI
44−userAPI = Proxy
45−
46−server :: Server UserAPI
47−server = return users
48− :<|> return albert
49− :<|> return isaac
50−
51−app :: Application
52−app = serve userAPI server
servant-examples/tutorial/T3.hsdeleted−84
@@ -1,84 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE TypeFamilies #-}
4−{-# LANGUAGE TypeOperators #-}
5−module T3 where
6−
7−import Control.Monad.Trans.Except
8−import Data.Aeson
9−import Data.List
10−import GHC.Generics
11−import Network.Wai
12−import Servant
13−
14−data Position = Position
15− { x :: Int
16− , y :: Int
17− } deriving (Show, Generic)
18−
19−instance FromJSON Position
20−instance ToJSON Position
21−
22−newtype HelloMessage = HelloMessage { msg :: String }
23− deriving (Show, Generic)
24−
25−instance FromJSON HelloMessage
26−instance ToJSON HelloMessage
27−
28−data ClientInfo = ClientInfo
29− { name :: String
30− , email :: String
31− , age :: Int
32− , interested_in :: [String]
33− } deriving (Show, Generic)
34−
35−instance FromJSON ClientInfo
36−instance ToJSON ClientInfo
37−
38−data Email = Email
39− { from :: String
40− , to :: String
41− , subject :: String
42− , body :: String
43− } deriving (Show, Generic)
44−
45−instance FromJSON Email
46−instance ToJSON Email
47−
48−emailForClient :: ClientInfo -> Email
49−emailForClient c = Email from' to' subject' body'
50−
51− where from' = "great@company.com"
52− to' = email c
53− subject' = "Hey " ++ name c ++ ", we miss you!"
54− body' = "Hi " ++ name c ++ ",\n\n"
55− ++ "Since you've recently turned " ++ show (age c)
56− ++ ", have you checked out our latest "
57− ++ intercalate ", " (interested_in c)
58− ++ " products? Give us a visit!"
59−
60−type API = "position" :> Capture "x" Int :> Capture "y" Int :> Get '[JSON] Position
61− :<|> "hello" :> QueryParam "name" String :> Get '[JSON] HelloMessage
62− :<|> "marketing" :> ReqBody '[JSON] ClientInfo :> Post '[JSON] Email
63−
64−api :: Proxy API
65−api = Proxy
66−
67−server :: Server API
68−server = position
69− :<|> hello
70− :<|> marketing
71−
72− where position :: Int -> Int -> ExceptT ServantErr IO Position
73− position x y = return (Position x y)
74−
75− hello :: Maybe String -> ExceptT ServantErr IO HelloMessage
76− hello mname = return . HelloMessage $ case mname of
77− Nothing -> "Hello, anonymous coward"
78− Just n -> "Hello, " ++ n
79−
80− marketing :: ClientInfo -> ExceptT ServantErr IO Email
81− marketing clientinfo = return (emailForClient clientinfo)
82−
83−app :: Application
84−app = serve api server
servant-examples/tutorial/T4.hsdeleted−63
@@ -1,63 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE OverloadedStrings #-}
5−{-# LANGUAGE TypeFamilies #-}
6−{-# LANGUAGE TypeOperators #-}
7−module T4 where
8−
9−import Data.Aeson
10−import Data.Foldable (foldMap)
11−import GHC.Generics
12−import Lucid
13−import Network.Wai
14−import Servant
15−import Servant.HTML.Lucid
16−
17−data Person = Person
18− { firstName :: String
19− , lastName :: String
20− , age :: Int
21− } deriving Generic -- for the JSON instance
22−
23−-- JSON serialization
24−instance ToJSON Person
25−
26−-- HTML serialization of a single person
27−instance ToHtml Person where
28− toHtml person =
29− tr_ $ do
30− td_ (toHtml $ firstName person)
31− td_ (toHtml $ lastName person)
32− td_ (toHtml . show $ age person)
33−
34− toHtmlRaw = toHtml
35−
36−-- HTML serialization of a list of persons
37−instance ToHtml [Person] where
38− toHtml persons = table_ $ do
39− tr_ $ do
40− th_ "first name"
41− th_ "last name"
42− th_ "age"
43−
44− foldMap toHtml persons
45−
46− toHtmlRaw = toHtml
47−
48−persons :: [Person]
49−persons =
50− [ Person "Isaac" "Newton" 372
51− , Person "Albert" "Einstein" 136
52− ]
53−
54−type PersonAPI = "persons" :> Get '[JSON, HTML] [Person]
55−
56−personAPI :: Proxy PersonAPI
57−personAPI = Proxy
58−
59−server :: Server PersonAPI
60−server = return persons
61−
62−app :: Application
63−app = serve personAPI server
servant-examples/tutorial/T5.hsdeleted−37
@@ -1,37 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TypeFamilies #-}
5−{-# LANGUAGE TypeOperators #-}
6−module T5 where
7−
8−import Control.Monad.IO.Class
9−import Control.Monad.Trans.Except
10−import Data.Aeson
11−import GHC.Generics
12−import Network.Wai
13−import Servant
14−import System.Directory
15−
16−type IOAPI = "myfile.txt" :> Get '[JSON] FileContent
17−
18−ioAPI :: Proxy IOAPI
19−ioAPI = Proxy
20−
21−newtype FileContent = FileContent
22− { content :: String }
23− deriving Generic
24−
25−instance ToJSON FileContent
26−
27−server :: Server IOAPI
28−server = do
29− exists <- liftIO (doesFileExist "myfile.txt")
30− if exists
31− then liftIO (readFile "myfile.txt") >>= return . FileContent
32− else throwE custom404Err
33−
34− where custom404Err = err404 { errBody = "myfile.txt just isn't there, please leave this server alone." }
35−
36−app :: Application
37−app = serve ioAPI server
servant-examples/tutorial/T6.hsdeleted−18
@@ -1,18 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE TypeOperators #-}
4−module T6 where
5−
6−import Network.Wai
7−import Servant
8−
9−type API = "code" :> Raw
10−
11−api :: Proxy API
12−api = Proxy
13−
14−server :: Server API
15−server = serveDirectory "tutorial"
16−
17−app :: Application
18−app = serve api server
servant-examples/tutorial/T7.hsdeleted−33
@@ -1,33 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE TypeFamilies #-}
3−{-# LANGUAGE TypeOperators #-}
4−module T7 where
5−
6−import Control.Monad.Trans.Except
7−import Control.Monad.Trans.Reader
8−import Network.Wai
9−import Servant
10−
11−type ReaderAPI = "a" :> Get '[JSON] Int
12− :<|> "b" :> Get '[JSON] String
13−
14−readerAPI :: Proxy ReaderAPI
15−readerAPI = Proxy
16−
17−readerServerT :: ServerT ReaderAPI (Reader String)
18−readerServerT = a :<|> b
19−
20− where a :: Reader String Int
21− a = return 1797
22−
23− b :: Reader String String
24− b = ask
25−
26−readerServer :: Server ReaderAPI
27−readerServer = enter readerToEither readerServerT
28−
29− where readerToEither :: Reader String :~> ExceptT ServantErr IO
30− readerToEither = Nat $ \r -> return (runReader r "hi")
31−
32−app :: Application
33−app = serve readerAPI readerServer
servant-examples/tutorial/T9.hsdeleted−105
@@ -1,105 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE TypeFamilies #-}
5−{-# LANGUAGE TypeOperators #-}
6−module T9 where
7−
8−import Control.Applicative
9−import Control.Monad.IO.Class
10−import Data.Aeson
11−import Data.Text (Text)
12−import GHC.Generics
13−import Network.Wai
14−import Servant
15−import Servant.JS
16−import System.Random
17−
18−import qualified Data.Text as T
19−import qualified Data.Text.IO as TIO
20−import qualified Language.Javascript.JQuery as JQ
21−
22−data Point = Point
23− { x :: Double
24− , y :: Double
25− } deriving Generic
26−
27−instance ToJSON Point
28−
29−randomPoint :: MonadIO m => m Point
30−randomPoint = liftIO . getStdRandom $ \g ->
31− let (rx, g') = randomR (-1, 1) g
32− (ry, g'') = randomR (-1, 1) g'
33− in (Point rx ry, g'')
34−
35−data Search a = Search
36− { query :: Text
37− , results :: [a]
38− } deriving Generic
39−
40−mkSearch :: Text -> [a] -> Search a
41−mkSearch = Search
42−
43−instance ToJSON a => ToJSON (Search a)
44−
45−data Book = Book
46− { author :: Text
47− , title :: Text
48− , year :: Int
49− } deriving Generic
50−
51−instance ToJSON Book
52−
53−book :: Text -> Text -> Int -> Book
54−book = Book
55−
56−books :: [Book]
57−books =
58− [ book "Paul Hudak" "The Haskell School of Expression: Learning Functional Programming through Multimedia" 2000
59− , book "Bryan O'Sullivan, Don Stewart, and John Goerzen" "Real World Haskell" 2008
60− , book "Miran Lipovača" "Learn You a Haskell for Great Good!" 2011
61− , book "Graham Hutton" "Programming in Haskell" 2007
62− , book "Simon Marlow" "Parallel and Concurrent Programming in Haskell" 2013
63− , book "Richard Bird" "Introduction to Functional Programming using Haskell" 1998
64− ]
65−
66−searchBook :: Monad m => Maybe Text -> m (Search Book)
67−searchBook Nothing = return (mkSearch "" books)
68−searchBook (Just q) = return (mkSearch q books')
69−
70− where books' = filter (\b -> q' `T.isInfixOf` T.toLower (author b)
71− || q' `T.isInfixOf` T.toLower (title b)
72− )
73− books
74− q' = T.toLower q
75−
76−type API = "point" :> Get '[JSON] Point
77− :<|> "books" :> QueryParam "q" Text :> Get '[JSON] (Search Book)
78−
79−type API' = API :<|> Raw
80−
81−api :: Proxy API
82−api = Proxy
83−
84−api' :: Proxy API'
85−api' = Proxy
86−
87−server :: Server API
88−server = randomPoint
89− :<|> searchBook
90−
91−server' :: Server API'
92−server' = server
93− :<|> serveDirectory "tutorial/t9"
94−
95−apiJS :: Text
96−apiJS = jsForAPI api jquery
97−
98−writeJSFiles :: IO ()
99−writeJSFiles = do
100− TIO.writeFile "tutorial/t9/api.js" apiJS
101− jq <- TIO.readFile =<< JQ.file
102− TIO.writeFile "tutorial/t9/jq.js" jq
103−
104−app :: Application
105−app = serve api' server'
servant-examples/wai-middleware/wai-middleware.hsdeleted−51
@@ -1,51 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−import Data.Aeson
5−import Data.Text
6−import GHC.Generics
7−import Network.Wai
8−import Network.Wai.Handler.Warp
9−import Network.Wai.Middleware.RequestLogger
10−import Servant
11−
12−data Product = Product
13− { name :: Text
14− , brand :: Text
15− , current_price_eur :: Double
16− , available :: Bool
17− } deriving (Eq, Show, Generic)
18−
19−instance ToJSON Product
20−
21−products :: [Product]
22−products = [p1, p2]
23−
24− where p1 = Product "Haskell laptop sticker"
25− "GHC Industries"
26− 2.50
27− True
28−
29− p2 = Product "Foldable USB drive"
30− "Well-Typed"
31− 13.99
32− False
33−
34−type SimpleAPI = Get '[JSON] [Product]
35−
36−simpleAPI :: Proxy SimpleAPI
37−simpleAPI = Proxy
38−
39−server :: Server SimpleAPI
40−server = return products
41−
42−-- logStdout :: Middleware
43−-- i.e, logStdout :: Application -> Application
44−-- serve :: Proxy api -> Context context -> Server api -> Application
45−-- so applying a middleware is really as simple as
46−-- applying a function to the result of 'serve'
47−app :: Application
48−app = logStdout (serve simpleAPI server)
49−
50−main :: IO ()
51−main = run 8080 app