wip

common/src/API.hs

@@ -0,0 +1 @@
+module API where

common/src/API/Books.hs

@@ -0,0 +1 @@
+module API.Books where

common/src/API/Catalogue.hs

@@ -0,0 +1 @@
+module API.Catalogue where

common/src/API/Channels.hs

@@ -0,0 +1,27 @@
+{-# Language DuplicateRecordFields #-}
+module API.Channels (API) where
+
+import Auth
+import ClassyPrelude
+import Data.Aeson
+import Servant.API
+import Servant.Auth as SA
+
+data JsonChannel = JsonChannel { channel :: Text
+                               , visibility :: Visibility }
+                 deriving (Show, Generic)
+data UpdateChannel = UpdateChannel { identifier :: ChannelID
+                                   , channel :: Text
+                                   , visibility :: Visibility }
+                 deriving (Show, Generic)
+
+instance ToJSON JsonChannel
+instance FromJSON JsonChannel
+instance ToJSON UpdateChannel
+instance FromJSON UpdateChannel
+
+type API = Auth '[SA.BasicAuth, SA.Cookie, SA.JWT] SafeUser :> BaseAPI
+
+type BaseAPI = "channels" :> ReqBody '[JSON] JsonChannel :> Post '[JSON] UpdateChannel
+          :<|> "channels" :> Capture "channel_id" ChannelID :> ReqBody '[JSON] UpdateChannel :> Put '[JSON] UpdateChannel
+          :<|> "channels" :> Get '[JSON] [JsonChannel]

common/src/API/Users.hs

@@ -0,0 +1 @@
+module API.Users where

common/src/Auth.hs

@@ -0,0 +1,26 @@
+{-# Language GeneralizedNewtypeDeriving #-}
+module Auth where
+
+import ClassyPrelude
+import Data.Aeson
+import Servant.Auth.Server (ToJWT, FromJWT)
+import Servant.API
+
+-- generic-lens can convert similar types to this
+-- I'm trying out servant-auth-server which uses a jwt style login. IIRC anyone
+-- can open the jwt token and view what's inside, you just can't modify it.
+--
+-- Is it a problem that a human readable username and email are visible?
+newtype Email = Email { unEmail :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData)
+
+newtype Username = Username { unUsername :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData)
+
+data SafeUser = SafeUser { email :: Email
+                         , username :: Username
+                         }
+              deriving (Show, Generic)
+
+instance ToJSON SafeUser where
+instance FromJSON SafeUser where
+instance ToJWT SafeUser where
+instance FromJWT SafeUser where