Psst.. new poll here.
Psst.. new forums here.
Microsoft is blocking us again (TY IP Reputation!) so just use oauth login instead. :)
Paste
Pasted as Haskell by lleksah15 ( 11 years ago )
type a :|- b = a :> Header "Auth-Token" Text :> b
infixr 8 :|-
type API =
"users" :> (ReqBody '[JSON] User) :|- (Post '[JSON] Int64)
:<|> "user" :> (Capture "id" UserId) :|- (Get '[JSON] FrontEndUser)
type AppM = ReaderT Config (EitherT ServantErr IO)
userAPI :: Proxy API
userAPI = Proxy
app :: Config -> Application
app cfg = serve userAPI (readerServer cfg)
readerServer :: Config -> Server API
readerServer cfg = enter (readerToEither cfg) server
readerToEither :: Config -> AppM :~> EitherT ServantErr IO
readerToEither cfg = Nat $ \x -> runReaderT x cfg
server :: ServerT API AppM
server = createPerson :<|> singlePerson
data Fr User
instance ToJSON FrontEndUser where
toJSON (FrontEndUser User{..}) = object ["name" .= userName]
instance FromText (Key User) where
fromText = fmap toSqlKey . fromText
singlePerson :: Maybe Text -> UserId -> AppM FrontEndUser
singlePerson uid = do
muser <- runDb $ get $ toSqlKey 1
case muser of
Just u -> return (FrontEndUser u)
Nothing -> lift $ left err404 { errBody = "User not found" }
createPerson :: Maybe Text -> User -> AppM Int64
createPerson mauth u = do
newPerson <- runDb $ insert u
return $ fromSqlKey newPerson
Revise this Paste
Parent: 78988