ry
/
datarekisteri
6
0
Fork 0
Code Issues 10 Pull Requests Packages Projects Releases Wiki Activity

Update dependencies

This commit is contained in:
Saku Laesvuori 2023-08-15 10:06:54 +03:00
parent 3c51fb5dda
commit fd2bf119b6
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32
6 changed files with 31 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Client/Auth.hs
View File

@ -6,6 +6,7 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
@ -17,7 +18,7 @@ import Server.Types
import Data.Morpheus.Client import Data.Morpheus.Client
import Yesod import Yesod
import Yesod.Auth import Yesod.Auth
import qualified Data.ByteString.Base64 as B64 (encode) import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64)
import qualified Yesod.Auth.Message as Msg import qualified Yesod.Auth.Message as Msg
pluginName = "externalBasic" pluginName = "externalBasic"
@ -34,7 +35,7 @@ postLoginR authReq = do
<$> ireq textField "email" <*> ireq textField "password" <$> ireq textField "email" <*> ireq textField "password"
case res of case res of
FormSuccess auth -> do FormSuccess auth -> do
maybeAuth <- liftHandler $ authReq $ ("Basic " <> ) $ decodeUtf8 $ B64.encode $ encodeUtf8 auth maybeAuth <- liftHandler $ authReq $ ("Basic " <> ) $ B64.encodeBase64 $ encodeUtf8 auth
case maybeAuth of case maybeAuth of
Nothing -> loginErrorMessageI LoginR Msg.NoIdentifierProvided -- invalid creds Nothing -> loginErrorMessageI LoginR Msg.NoIdentifierProvided -- invalid creds
Just txt -> do Just txt -> do

4
Server.hs
View File

@ -26,7 +26,7 @@ import Server.DB.Queries (getUserByEmail, getPermissions, getToken)
import Server.Types import Server.Types
import Server.Utils (checkPassword) import Server.Utils (checkPassword)
import Web.Scotty.Trans hiding (readEither) import Web.Scotty.Trans hiding (readEither)
import qualified Data.ByteString.Base64 as B64 (decode) import qualified "base64" Data.ByteString.Base64 as B64 (decodeBase64)
main :: IO () main :: IO ()
main = run 3100 =<< serverApp main = run 3100 =<< serverApp
@ -80,7 +80,7 @@ parseBasic txt = do
[authType, authData] <- words <$> txt [authType, authData] <- words <$> txt
guard $ toLower authType == "basic" guard $ toLower authType == "basic"
(email, password) <- rightToMaybe $ (email, password) <- rightToMaybe $
breakOn' ":" . decodeUtf8 <$> B64.decode (encodeUtf8 authData) breakOn' ":" . decodeUtf8 <$> B64.decodeBase64 (encodeUtf8 authData)
emailAddress <- toEmail email emailAddress <- toEmail email
pure $ BasicAuth {..} pure $ BasicAuth {..}
where breakOn' x xs = let (fst, snd) = breakOn x xs where breakOn' x xs = let (fst, snd) = breakOn x xs

4
Server/API.hs
View File

@ -33,7 +33,7 @@ import Server.DB.Queries
import Server.Email (sendVerificationEmail) import Server.Email (sendVerificationEmail)
import Server.Types import Server.Types
import Server.Utils import Server.Utils
import qualified Data.ByteString.Base64 as B64 (encode) import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64)
import qualified Data.Text as T (null, chunksOf, intercalate) import qualified Data.Text as T (null, chunksOf, intercalate)
-- General functions, maybe migrate to Utils or API.Utils -- General functions, maybe migrate to Utils or API.Utils
@ -161,7 +161,7 @@ updateUser user (UpdateData {..}) = do
makeNewToken :: (MonadError GQLError m, MonadDB m, MonadTime m, MonadRandom m, MonadPermissions m) => makeNewToken :: (MonadError GQLError m, MonadDB m, MonadTime m, MonadRandom m, MonadPermissions m) =>
NewTokenArgs -> UserID -> m TokenID NewTokenArgs -> UserID -> m TokenID
makeNewToken (NewTokenArgs {..}) user = do makeNewToken (NewTokenArgs {..}) user = do
tokenData <- decodeUtf8 . B64.encode <$> getRandomBytes 128 tokenData <- B64.encodeBase64 <$> getRandomBytes 128
time <- currentTime time <- currentTime
permissions <- maybe currentPermissions pure =<< maybe (pure Nothing) toPermissions permissions permissions <- maybe currentPermissions pure =<< maybe (pure Nothing) toPermissions permissions
addToken $ DBToken addToken $ DBToken

6
Server/Types.hs
View File

@ -31,14 +31,14 @@ import Database.Persist.PersistValue (PersistValue(..))
import Database.Persist.Sql (PersistFieldSql(..), SqlBackend) import Database.Persist.Sql (PersistFieldSql(..), SqlBackend)
import Network.Mail.Mime (Mail, Address(..)) import Network.Mail.Mime (Mail, Address(..))
import Text.Email.Validate (EmailAddress, toByteString, validate, emailAddress) import Text.Email.Validate (EmailAddress, toByteString, validate, emailAddress)
import qualified Data.ByteString.Base64 as B64 (encode, decode) import qualified "base64" Data.ByteString.Base64 as B64 (encodeBase64, decodeBase64)
import "cryptonite" Crypto.Random (MonadRandom(..)) import "cryptonite" Crypto.Random (MonadRandom(..))
base64Encode :: ByteString -> Base64 base64Encode :: ByteString -> Base64
base64Encode = Base64 . decodeUtf8 . B64.encode base64Encode = Base64 . B64.encodeBase64
base64Decode :: Base64 -> Maybe ByteString base64Decode :: Base64 -> Maybe ByteString
base64Decode (Base64 x) = either (const Nothing) Just $ B64.decode $ encodeUtf8 x base64Decode (Base64 x) = either (const Nothing) Just $ B64.decodeBase64 $ encodeUtf8 x
toEmail :: Text -> Maybe Email toEmail :: Text -> Maybe Email
toEmail = fmap Email . emailAddress . encodeUtf8 toEmail = fmap Email . emailAddress . encodeUtf8

4
datarekisteri.cabal
View File

@ -1,4 +1,4 @@
cabal-version: 2.4 cabal-version: 3.6
name: datarekisteri name: datarekisteri
version: 0.0.1 version: 0.0.1
author: Saku Laesvuori author: Saku Laesvuori
@ -11,7 +11,7 @@ executable datarekisteri
build-depends: build-depends:
aeson, aeson,
base, base,
base64-bytestring, base64,
cryptonite, cryptonite,
email-validate, email-validate,
esqueleto, esqueleto,

38
guix.scm
View File

@ -21,7 +21,7 @@
(base32 (base32
"1lpggpdzgjk23mq7aa64yylds5dbm4ynhcvbarqihjxabvh7xmz1")))) "1lpggpdzgjk23mq7aa64yylds5dbm4ynhcvbarqihjxabvh7xmz1"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-base64-bytestring (inputs (list ghc-base64
ghc-cryptonite ghc-cryptonite
ghc-email-validate ghc-email-validate
ghc-esqueleto ghc-esqueleto
@ -196,13 +196,13 @@ Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
(define-public ghc-morpheus-graphql (define-public ghc-morpheus-graphql
(package (package
(name "ghc-morpheus-graphql") (name "ghc-morpheus-graphql")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql" version)) (uri (hackage-uri "morpheus-graphql" version))
(sha256 (sha256
(base32 (base32
"1n9qflbgl7f4qd3sxc6rwnv0rmg0dj731rf1b9avc6xw199ydr3w")))) "04qah7565dzq7v4q43zjz8778pdn5jwnway5rvz4kkibcrscfagn"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-aeson (inputs (list ghc-aeson
ghc-morpheus-graphql-app ghc-morpheus-graphql-app
@ -222,13 +222,13 @@ Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
(define-public ghc-morpheus-graphql-code-gen (define-public ghc-morpheus-graphql-code-gen
(package (package
(name "ghc-morpheus-graphql-code-gen") (name "ghc-morpheus-graphql-code-gen")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql-code-gen" version)) (uri (hackage-uri "morpheus-graphql-code-gen" version))
(sha256 (sha256
(base32 (base32
"0qvk2zpqhhjjfha5hfd9nkv30m07qbbnpil9h00w3skdw33mqqqk")))) "1rmxcr17xjx99aam048a4sqlwlnxjk41hx8fnb363ljid74vrcrb"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-file-embed (inputs (list ghc-file-embed
ghc-morpheus-graphql-code-gen-utils ghc-morpheus-graphql-code-gen-utils
@ -250,13 +250,13 @@ Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
(define-public ghc-morpheus-graphql-core (define-public ghc-morpheus-graphql-core
(package (package
(name "ghc-morpheus-graphql-core") (name "ghc-morpheus-graphql-core")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql-core" version)) (uri (hackage-uri "morpheus-graphql-core" version))
(sha256 (sha256
(base32 (base32
"1id4dxi4kpgd25ffhw5qgkl05b2642qpz5dss68nq0n1cs2c021b")))) "0dd8bifn6qwpss06hbb0r730fqfkbd4nhwsr2bsrgxc7hvzv9wi7"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-aeson (inputs (list ghc-aeson
ghc-hashable ghc-hashable
@ -276,13 +276,13 @@ Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
(define-public ghc-morpheus-graphql-app (define-public ghc-morpheus-graphql-app
(package (package
(name "ghc-morpheus-graphql-app") (name "ghc-morpheus-graphql-app")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql-app" version)) (uri (hackage-uri "morpheus-graphql-app" version))
(sha256 (sha256
(base32 (base32
"0qs5gx7k1ix4i0mqkmy681xlg7ckr8fy089rj4c25vgv8rm0p36w")))) "0dicajcqgxpv1jhnywjjs0g4p5ryv0xlrywib1xwxrb04wy9aa3f"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-aeson (inputs (list ghc-aeson
ghc-hashable ghc-hashable
@ -303,13 +303,13 @@ Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
(define-public ghc-morpheus-graphql-subscriptions (define-public ghc-morpheus-graphql-subscriptions
(package (package
(name "ghc-morpheus-graphql-subscriptions") (name "ghc-morpheus-graphql-subscriptions")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql-subscriptions" version)) (uri (hackage-uri "morpheus-graphql-subscriptions" version))
(sha256 (sha256
(base32 (base32
"0nj05ywj460v8kd821w7br44bx8wzqbbil0jb42sv442py69d6lj")))) "0gynrshv858g36jwvmh3q2asc6ppkr7hv9w9lx1qfjqfwm7r0140"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-aeson (inputs (list ghc-aeson
ghc-morpheus-graphql-app ghc-morpheus-graphql-app
@ -328,13 +328,13 @@ Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
(define-public ghc-morpheus-graphql-client (define-public ghc-morpheus-graphql-client
(package (package
(name "ghc-morpheus-graphql-client") (name "ghc-morpheus-graphql-client")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql-client" version)) (uri (hackage-uri "morpheus-graphql-client" version))
(sha256 (sha256
(base32 (base32
"095kyjyv7gyrlqsdbw1aab2l990risr72c2j5gcwskbgqm7p3fip")))) "1j4r6ar6l462aq8qvxikmwyxd2f8i60gd3j0qf5pxsslgjwmjbi9"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-aeson (inputs (list ghc-aeson
ghc-file-embed ghc-file-embed
@ -359,13 +359,13 @@ Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
(define-public ghc-morpheus-graphql-tests (define-public ghc-morpheus-graphql-tests
(package (package
(name "ghc-morpheus-graphql-tests") (name "ghc-morpheus-graphql-tests")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql-tests" version)) (uri (hackage-uri "morpheus-graphql-tests" version))
(sha256 (sha256
(base32 (base32
"1nhpcai8lk3jq676zp6y6jcylm3zjzl4s6hk0f3g7vmg971ycd9w")))) "1s9x4gcqd36gqf5w2wxiqhf7k9y44b7g7zm90y2kbclxqirs9rqf"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-aeson ghc-relude ghc-tasty ghc-tasty-hunit (inputs (list ghc-aeson ghc-relude ghc-tasty ghc-tasty-hunit
ghc-unordered-containers)) ghc-unordered-containers))
@ -378,13 +378,13 @@ Sinatra + Warp = Scotty. . [WAI] <http://hackage.haskell.org/package/wai> .
(define-public ghc-morpheus-graphql-server (define-public ghc-morpheus-graphql-server
(package (package
(name "ghc-morpheus-graphql-server") (name "ghc-morpheus-graphql-server")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql-server" version)) (uri (hackage-uri "morpheus-graphql-server" version))
(sha256 (sha256
(base32 (base32
"0b8hipwp5ddxn92appn2n6s43kmqvqrp2rg055jkb2kcfwh8g828")))) "1hl2c78pnx2rxx869p6ixvnyhzm46f1hzalqz2vbwrflshpmjv91"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-aeson (inputs (list ghc-aeson
ghc-morpheus-graphql-app ghc-morpheus-graphql-app
@ -478,13 +478,13 @@ or not.")
(define-public ghc-morpheus-graphql-code-gen-utils (define-public ghc-morpheus-graphql-code-gen-utils
(package (package
(name "ghc-morpheus-graphql-code-gen-utils") (name "ghc-morpheus-graphql-code-gen-utils")
(version "0.27.1") (version "0.27.3")
(source (origin (source (origin
(method url-fetch) (method url-fetch)
(uri (hackage-uri "morpheus-graphql-code-gen-utils" version)) (uri (hackage-uri "morpheus-graphql-code-gen-utils" version))
(sha256 (sha256
(base32 (base32
"0f8152jzjynfl65k8f4iyyi8akqrcn9dhx8pi20yhf152h5w0clp")))) "11dfnyd9wbrwjfjz1qkc188x6l4b149jsyzjwh1gqji0skzsk3f6"))))
(build-system haskell-build-system) (build-system haskell-build-system)
(inputs (list ghc-morpheus-graphql-core ghc-prettyprinter ghc-relude (inputs (list ghc-morpheus-graphql-core ghc-prettyprinter ghc-relude
ghc-unordered-containers)) ghc-unordered-containers))