Fix build with current Guix

backend/datarekisteri-backend.cabal

@@ -37,6 +37,7 @@ executable datarekisteri-backend
     smtp-mail,
     text,
     time,
+    unliftio-core,
     containers,
     wai,
     warp,

backend/src/Datarekisteri/Backend.hs

@@ -13,6 +13,7 @@ import "cryptonite" Crypto.Random (MonadRandom(..))
 import qualified "base64" Data.ByteString.Base64 as B64
 
 import Control.Monad.Except (catchError)
+import Control.Monad.IO.Unlift (MonadUnliftIO)
 import Control.Monad.Logger (runStderrLoggingT)
 import Data.Default (def)
 import Data.Map (findWithDefault)
@@ -76,7 +77,7 @@ runMigrations dbUrl = do
     callProcess "dbmate" ["--url", toString dbUrl, "--migrations-dir", migrationsPath, "up"]
 
 serverApp :: Config -> IO Application
-serverApp config = scottyAppT (runAPIM config) $ do
+serverApp config = scottyAppT defaultOptions (runAPIM config) $ do
     middleware $ gzip def
     middleware $ cors $ const $ Just CorsResourcePolicy
         { corsOrigins = Nothing -- all
@@ -109,7 +110,7 @@ parseBearer auth = do
     guard $ toLower authType == "bearer"
     pure $ BearerToken authData
 
-authBearer :: Maybe BearerToken -> ActionT LText APIM a -> ActionT LText APIM a
+authBearer :: Maybe BearerToken -> ActionT APIM a -> ActionT APIM a
 authBearer Nothing m = m
 authBearer (Just (BearerToken bearer)) m = do
     let getUserPermissions = do
@@ -129,14 +130,14 @@ parseBasic txt = do
     [authType, authData] <- words <$> txt
     guard $ toLower authType == "basic"
     (email, password) <- rightToMaybe $
-        breakOn' ":" . decodeUtf8 <$> B64.decodeBase64 (encodeUtf8 authData)
+        breakOn' ":" . decodeUtf8 <$> B64.decodeBase64Untyped (encodeUtf8 authData)
     emailAddress <- toEmail email
     pure $ BasicAuth {..}
         where breakOn' x xs = let (fst, snd) = breakOn x xs
                               in (fst, fromMaybe "" $ stripPrefix x snd)
 
 
-authBasic :: Maybe BasicAuth -> ActionT LText APIM a -> ActionT LText APIM a
+authBasic :: Maybe BasicAuth -> ActionT APIM a -> ActionT APIM a
 authBasic Nothing m = m
 authBasic (Just basic) m = do
     DBUser {..} <- verifyBasic basic
@@ -148,7 +149,7 @@ authBasic (Just basic) m = do
         , statePermissions = permissions
         }
 
-verifyBasic :: BasicAuth -> ActionT LText APIM (DBUser APIM)
+verifyBasic :: BasicAuth -> ActionT APIM (DBUser APIM)
 verifyBasic BasicAuth {..} = do
     maybeUser <- lift $ dbGetUserByEmail emailAddress
     let unauthorized = do
@@ -162,7 +163,7 @@ verifyBasic BasicAuth {..} = do
           pure user
 
 newtype APIM a = APIM (ReaderT RequestState IO a)
-    deriving (Functor, Applicative, Monad, MonadIO, MonadReader RequestState)
+    deriving (Functor, Applicative, Monad, MonadIO, MonadReader RequestState, MonadUnliftIO)
 
 data RequestState = RequestState
     { stateCurrentUser :: Maybe UserID

backend/src/Datarekisteri/Backend/API.hs

@@ -22,6 +22,7 @@ import Relude hiding (Undefined, get)
 
 import "cryptonite" Crypto.Random (getRandomBytes, MonadRandom)
 import qualified "base64" Data.ByteString.Base64 as B64
+import qualified "base64" Data.Base64.Types as B64
 
 import Control.Monad.Except (MonadError, throwError, catchError)
 import Data.Morpheus.Server (deriveApp, runApp)
@@ -106,7 +107,7 @@ updateUser user args = do
 newTokenArgsToData :: (MonadRandom m, MonadTime m, MonadPermissions m) =>
     NewTokenArgs -> UserID -> m NewTokenData
 newTokenArgsToData NewTokenArgs {..} user = do
-    tokenData <- B64.encodeBase64 <$> getRandomBytes 128
+    tokenData <- B64.extractBase64 . B64.encodeBase64 <$> getRandomBytes 128
     issued <- currentTime
     permissions <- maybe currentPermissions pure =<< maybe (pure Nothing) toPermissions permissions
     let expires = Nothing

channels.scm

@@ -3,7 +3,7 @@
         (url "https://git.savannah.gnu.org/git/guix.git")
         (branch "master")
         (commit
-          "27ae140024b6d05506cdf0d9fd5b91c25466f295")
+          "86813d5779253bb50002d79ab791eeda5a8b4729")
         (introduction
           (make-channel-introduction
             "9edb3f66fd807b096b48283debdcddccfea34bad"

core/src/Datarekisteri/Core/Types.hs

@@ -35,6 +35,7 @@ module Datarekisteri.Core.Types
 import Relude
 
 import qualified "base64" Data.ByteString.Base64 as B64
+import qualified "base64" Data.Base64.Types as B64
 
 import Data.Aeson (ToJSON(..), FromJSON(..))
 import Data.Char (isSpace)
@@ -51,10 +52,10 @@ import Text.Email.Validate (EmailAddress, toByteString, validate, emailAddress)
 import qualified Data.Text as T
 
 base64Encode :: ByteString -> Base64
-base64Encode = Base64 . B64.encodeBase64
+base64Encode = Base64 . B64.extractBase64 . B64.encodeBase64
 
 base64Decode :: Base64 -> Maybe ByteString
-base64Decode (Base64 x) = either (const Nothing) Just $ B64.decodeBase64 $ encodeUtf8 x
+base64Decode (Base64 x) = either (const Nothing) Just $ B64.decodeBase64Untyped $ encodeUtf8 x
 
 toEmail :: Text -> Maybe Email
 toEmail = fmap Email . emailAddress . encodeUtf8

frontend/src/Datarekisteri/Frontend/Auth.hs

@@ -15,6 +15,7 @@ module Datarekisteri.Frontend.Auth where
 import Relude
 
 import qualified "base64" Data.ByteString.Base64 as B64
+import qualified "base64" Data.Base64.Types as B64
 
 import Yesod
 import Yesod.Auth
@@ -37,7 +38,7 @@ postLoginR authReq = do
         <$> ireq textField "email" <*> ireq textField "password"
     case res of
       FormSuccess auth -> do
-          maybeAuth <- liftHandler $ authReq $ ("Basic " <> ) $ B64.encodeBase64 $ encodeUtf8 auth
+          maybeAuth <- liftHandler $ authReq $ ("Basic " <> ) $ B64.extractBase64 $ B64.encodeBase64 $ encodeUtf8 auth
           case maybeAuth of
             Nothing -> loginErrorMessageI LoginR Msg.InvalidEmailPass -- invalid creds
             Just txt -> do