diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,4 @@
+0.3.2.0
+=======
+
+* Initial factor out from parent package.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Anton Gushcha (c) 2016-2017
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of NCrashed nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,60 @@
+# servant-auth-token-acid
+
+Storage backend on acid for [servant-auth-token](https://github.com/NCrashed/servant-auth-token) server.
+
+As `acid-state` is bad at composing states, the integration of the library in your project requires a massive TH mixins.
+The authentification state's queries are simply copied to your app.
+
+First, define you own global `acid-state` type:
+
+``` haskell
+import Data.SafeCopy
+import Servant.Server.Auth.Token.Acid.Schema as A
+
+-- | Application global state for acid-state
+data DB = DB {
+  dbAuth :: A.Model -- ^ Storage for Auth state
+, dbCustom :: () -- ^ Demo of custom state
+}
+
+-- | Generation of inital state
+newDB :: DB
+newDB = DB {
+    dbAuth = A.newModel
+  , dbCustom = ()
+  }
+
+-- | Extraction of Auth model from global state
+instance HasModelRead DB where
+  askModel = dbAuth
+
+-- | Extraction of Auth model from global state
+instance HasModelWrite DB where
+  putModel db m = db { dbAuth = m }
+
+deriveSafeCopy 0 'base ''DB
+
+-- Mixin auth state queries and derive acid-state instances for them
+A.deriveQueries ''DB
+A.makeModelAcidic ''DB
+```
+
+Next, define your monad stack for the authorization actions:
+``` haskell
+-- Derive HasStorage for 'AcidBackendT' with your 'DB'.
+-- It is important that it is come before the below newtype
+deriveAcidHasStorage ''DB
+
+-- | Special monad for authorisation actions
+newtype AuthM a = AuthM { unAuthM :: AcidBackendT DB IO a }
+  deriving (Functor, Applicative, Monad, MonadIO, MonadError ServantErr, HasAuthConfig, HasStorage)
+
+-- | Execution of authorisation actions that require 'AuthHandler' context
+runAuth :: AuthM a -> ServerM a
+runAuth m = do
+  cfg <- asks envAuthConfig
+  db <- asks envDB
+  liftHandler $ ExceptT $ runAcidBackendT cfg db $ unAuthM m
+```
+
+See a full example in [servant-auth-token-example-acid](https://github.com/NCrashed/servant-auth-token/tree/master/example/acid).
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/servant-auth-token-acid.cabal b/servant-auth-token-acid.cabal
new file mode 100644
--- /dev/null
+++ b/servant-auth-token-acid.cabal
@@ -0,0 +1,66 @@
+name:                servant-auth-token-acid
+version:             0.4.0.0
+synopsis:            Acid-state backend for servant-auth-token server
+description:         Please see README.md
+homepage:            https://github.com/ncrashed/servant-auth-token#readme
+license:             BSD3
+license-file:        LICENSE
+author:              NCrashed
+maintainer:          ncrashed@gmail.com
+copyright:           2016 Anton Gushcha
+category:            Web
+build-type:          Simple
+extra-source-files:
+  README.md
+  CHANGELOG.md
+cabal-version:       >=1.10
+
+library
+  hs-source-dirs:      src
+  exposed-modules:
+    Servant.Server.Auth.Token.Acid
+    Servant.Server.Auth.Token.Acid.Schema
+  build-depends:
+      base                    >= 4.7    && < 5
+    , acid-state              >= 0.14   && < 0.15
+    , aeson-injector          >= 1.0    && < 1.1
+    , bytestring              >= 0.10   && < 0.11
+    , containers              >= 0.5    && < 0.6
+    , ghc-prim                >= 0.5    && < 0.6
+    , monad-control           >= 1.0    && < 1.1
+    , mtl                     >= 2.2    && < 2.3
+    , safe                    >= 0.3    && < 0.4
+    , safecopy                >= 0.9    && < 0.10
+    , servant-auth-token      >= 0.4    && < 0.5
+    , servant-auth-token-api  >= 0.4    && < 0.5
+    , servant-server          >= 0.9    && < 0.10
+    , template-haskell        >= 2.11   && < 2.12
+    , text                    >= 1.2    && < 1.3
+    , time                    >= 1.5    && < 1.7
+    , transformers            >= 0.4    && < 0.6
+    , transformers-base       >= 0.4    && < 0.5
+    , uuid                    >= 1.3    && < 1.4
+  default-language:    Haskell2010
+  default-extensions:
+    BangPatterns
+    DataKinds
+    DeriveGeneric
+    FlexibleContexts
+    FlexibleInstances
+    FunctionalDependencies
+    GADTs
+    GeneralizedNewtypeDeriving
+    KindSignatures
+    MultiParamTypeClasses
+    OverloadedStrings
+    QuasiQuotes
+    RecordWildCards
+    ScopedTypeVariables
+    TemplateHaskell
+    TupleSections
+    TypeFamilies
+    TypeOperators
+
+source-repository head
+  type:     git
+  location: https://github.com/ncrashed/servant-auth-token
diff --git a/src/Servant/Server/Auth/Token/Acid.hs b/src/Servant/Server/Auth/Token/Acid.hs
new file mode 100644
--- /dev/null
+++ b/src/Servant/Server/Auth/Token/Acid.hs
@@ -0,0 +1,132 @@
+module Servant.Server.Auth.Token.Acid(
+    AcidBackendT
+  , runAcidBackendT
+  , deriveAcidHasStorage
+  ) where
+
+import Control.Monad.Except
+import Control.Monad.Reader
+import Data.Acid
+import Data.Acid.Core
+import Language.Haskell.TH
+import Servant.Server
+import Servant.Server.Auth.Token.Config
+import Servant.Server.Auth.Token.Model
+
+-- | Monad transformer that implements storage backend
+newtype AcidBackendT st m a = AcidBackendT { unAcidBackendT :: ReaderT (AuthConfig, AcidState st) (ExceptT ServantErr m) a }
+  deriving (Functor, Applicative, Monad, MonadIO, MonadError ServantErr, MonadReader (AuthConfig, AcidState st))
+
+instance Monad m => HasAuthConfig (AcidBackendT st m) where
+  getAuthConfig = fmap fst $ AcidBackendT ask
+
+-- | Execute backend action with given connection pool.
+runAcidBackendT :: AuthConfig -> AcidState st -> AcidBackendT st m a -> m (Either ServantErr a)
+runAcidBackendT cfg db ma = runExceptT $ runReaderT (unAcidBackendT ma) (cfg, db)
+
+-- | Derives acid-state 'HasStorage' instance for functions that are generated in 'makeModelAcidic'.
+--
+-- Use this as following:
+-- @
+-- instance HasModelRead MyState where
+--   askModel = authModel
+--
+-- instance HasModelWrite MyState where
+--   putModel m v = m { authModel = v }
+--
+-- makeModelAcidic ''MyState
+-- deriveAcidHasStorage
+-- @
+deriveAcidHasStorage :: Name -> DecsQ
+deriveAcidHasStorage globalState = [d|
+  -- | Helper to execute DB actions in backend monad
+  liftAcidQuery :: (QueryEvent event, MonadIO m, MethodState event ~ $st) => event -> AcidBackendT $st m (EventResult event)
+  liftAcidQuery e = do
+    (_, db) <- ask
+    liftIO $ query db e
+
+  -- | Helper to execute DB actions in backend monad
+  liftAcidUpdate :: (UpdateEvent event, MonadIO m, MethodState event ~ $st) => event -> AcidBackendT $st m (EventResult event)
+  liftAcidUpdate e = do
+    (_, db) <- ask
+    liftIO $ update db e
+
+  instance MonadIO m => HasStorage (AcidBackendT $st m) where
+    getUserImpl = liftAcidQuery . $(conE $ mkName "GetUserImpl")
+    getUserImplByLogin = liftAcidQuery . $(conE $ mkName "GetUserImplByLogin")
+    listUsersPaged page size = liftAcidQuery $ $(conE $ mkName "ListUsersPaged") page size
+    getUserImplPermissions = liftAcidQuery . $(conE $ mkName "GetUserImplPermissions")
+    deleteUserPermissions = liftAcidUpdate . $(conE $ mkName "DeleteUserPermissions")
+    insertUserPerm = liftAcidUpdate . $(conE $ mkName "InsertUserPerm")
+    insertUserImpl = liftAcidUpdate . $(conE $ mkName "InsertUserImpl")
+    replaceUserImpl i v = liftAcidUpdate $ $(conE $ mkName "ReplaceUserImpl") i v
+    deleteUserImpl = liftAcidUpdate . $(conE $ mkName "DeleteUserImpl")
+    hasPerm i p = liftAcidQuery $ $(conE $ mkName "HasPerm") i p
+    getFirstUserByPerm = liftAcidQuery . $(conE $ mkName "GetFirstUserByPerm")
+    selectUserImplGroups = liftAcidQuery . $(conE $ mkName "SelectUserImplGroups")
+    clearUserImplGroups = liftAcidUpdate . $(conE $ mkName "ClearUserImplGroups")
+    insertAuthUserGroup = liftAcidUpdate . $(conE $ mkName "InsertAuthUserGroup")
+    insertAuthUserGroupUsers = liftAcidUpdate . $(conE $ mkName "InsertAuthUserGroupUsers")
+    insertAuthUserGroupPerms = liftAcidUpdate . $(conE $ mkName "InsertAuthUserGroupPerms")
+    getAuthUserGroup = liftAcidQuery . $(conE $ mkName "GetAuthUserGroup")
+    listAuthUserGroupPermissions = liftAcidQuery . $(conE $ mkName "ListAuthUserGroupPermissions")
+    listAuthUserGroupUsers = liftAcidQuery . $(conE $ mkName "ListAuthUserGroupUsers")
+    replaceAuthUserGroup i v = liftAcidUpdate $ $(conE $ mkName "ReplaceAuthUserGroup") i v
+    clearAuthUserGroupUsers = liftAcidUpdate . $(conE $ mkName "ClearAuthUserGroupUsers")
+    clearAuthUserGroupPerms = liftAcidUpdate . $(conE $ mkName "ClearAuthUserGroupPerms")
+    deleteAuthUserGroup = liftAcidUpdate . $(conE $ mkName "DeleteAuthUserGroup")
+    listGroupsPaged page size = liftAcidQuery $ $(conE $ mkName "ListGroupsPaged") page size
+    setAuthUserGroupName i n = liftAcidUpdate $ $(conE $ mkName "SetAuthUserGroupName") i n
+    setAuthUserGroupParent i mp = liftAcidUpdate $ $(conE $ mkName "SetAuthUserGroupParent") i mp
+    insertSingleUseCode = liftAcidUpdate . $(conE $ mkName "InsertSingleUseCode")
+    setSingleUseCodeUsed i mt = liftAcidUpdate $ $(conE $ mkName "SetSingleUseCodeUsed") i mt
+    getUnusedCode c i t = liftAcidQuery $ $(conE $ mkName "GetUnusedCode") c i t
+    invalidatePermamentCodes i t = liftAcidUpdate $ $(conE $ mkName "InvalidatePermamentCodes") i t
+    selectLastRestoreCode i t = liftAcidQuery $ $(conE $ mkName "SelectLastRestoreCode") i t
+    insertUserRestore = liftAcidUpdate . $(conE $ mkName "InsertUserRestore")
+    findRestoreCode i rc t = liftAcidQuery $ $(conE $ mkName "FindRestoreCode") i rc t
+    replaceRestoreCode i v = liftAcidUpdate $ $(conE $ mkName "ReplaceRestoreCode") i v
+    findAuthToken i t = liftAcidQuery $ $(conE $ mkName "FindAuthToken") i t
+    findAuthTokenByValue t = liftAcidQuery $ $(conE $ mkName "FindAuthTokenByValue") t
+    insertAuthToken = liftAcidUpdate . $(conE $ mkName "InsertAuthToken")
+    replaceAuthToken i v = liftAcidUpdate $ $(conE $ mkName "ReplaceAuthToken") i v
+    {-# INLINE getUserImpl #-}
+    {-# INLINE getUserImplByLogin #-}
+    {-# INLINE listUsersPaged #-}
+    {-# INLINE getUserImplPermissions #-}
+    {-# INLINE deleteUserPermissions #-}
+    {-# INLINE insertUserPerm #-}
+    {-# INLINE insertUserImpl #-}
+    {-# INLINE replaceUserImpl #-}
+    {-# INLINE deleteUserImpl #-}
+    {-# INLINE hasPerm #-}
+    {-# INLINE getFirstUserByPerm #-}
+    {-# INLINE selectUserImplGroups #-}
+    {-# INLINE clearUserImplGroups #-}
+    {-# INLINE insertAuthUserGroup #-}
+    {-# INLINE insertAuthUserGroupUsers #-}
+    {-# INLINE insertAuthUserGroupPerms #-}
+    {-# INLINE getAuthUserGroup #-}
+    {-# INLINE listAuthUserGroupPermissions #-}
+    {-# INLINE listAuthUserGroupUsers #-}
+    {-# INLINE replaceAuthUserGroup #-}
+    {-# INLINE clearAuthUserGroupUsers #-}
+    {-# INLINE clearAuthUserGroupPerms #-}
+    {-# INLINE deleteAuthUserGroup #-}
+    {-# INLINE listGroupsPaged #-}
+    {-# INLINE setAuthUserGroupName #-}
+    {-# INLINE setAuthUserGroupParent #-}
+    {-# INLINE insertSingleUseCode #-}
+    {-# INLINE setSingleUseCodeUsed #-}
+    {-# INLINE getUnusedCode #-}
+    {-# INLINE invalidatePermamentCodes #-}
+    {-# INLINE selectLastRestoreCode #-}
+    {-# INLINE insertUserRestore #-}
+    {-# INLINE findRestoreCode #-}
+    {-# INLINE replaceRestoreCode #-}
+    {-# INLINE findAuthToken #-}
+    {-# INLINE findAuthTokenByValue #-}
+    {-# INLINE insertAuthToken #-}
+    {-# INLINE replaceAuthToken #-}
+  |]
+  where st = conT globalState
diff --git a/src/Servant/Server/Auth/Token/Acid/Schema.hs b/src/Servant/Server/Auth/Token/Acid/Schema.hs
new file mode 100644
--- /dev/null
+++ b/src/Servant/Server/Auth/Token/Acid/Schema.hs
@@ -0,0 +1,467 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE NoDisambiguateRecordFields, NoRecordWildCards #-}
+module Servant.Server.Auth.Token.Acid.Schema where
+
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.Acid
+import Data.Aeson.WithField
+import Data.Int
+import Data.List (sortBy)
+import Data.Map.Strict (Map)
+import Data.Ord
+import Data.SafeCopy
+import Data.Text (Text)
+import Data.Time
+import Language.Haskell.TH
+import Safe
+
+import Servant.API.Auth.Token
+import Servant.API.Auth.Token.Pagination
+import Servant.Server.Auth.Token.Common
+import Servant.Server.Auth.Token.Model(
+    UserImplId
+  , UserImpl(..)
+  , UserPermId
+  , UserPerm(..)
+  , AuthTokenId
+  , AuthToken(..)
+  , UserRestoreId
+  , UserRestore(..)
+  , UserSingleUseCodeId
+  , UserSingleUseCode(..)
+  , AuthUserGroupId
+  , AuthUserGroup(..)
+  , AuthUserGroupUsersId
+  , AuthUserGroupUsers(..)
+  , AuthUserGroupPermsId
+  , AuthUserGroupPerms(..)
+  )
+
+import qualified Data.Map.Strict as M
+import qualified Data.Foldable as F
+
+-- | Holds all data for auth server in acid-state container
+data Model = Model {
+  -- | Holds users by id
+  modelUsers                    :: !(Map UserImplId UserImpl)
+  -- | Holds users by login (same content as 'modelUsers')
+, modelUsersByLogin             :: !(Map Login (WithId UserImplId UserImpl))
+  -- | Holds 'UserPerm'
+, modelUserPerms                :: !(Map UserPermId UserPerm)
+  -- | Holds 'AuthToken'
+, modelAuthTokens               :: !(Map AuthTokenId AuthToken)
+  -- | Holds 'UserRestore'
+, modelUserRestores             :: !(Map UserRestoreId UserRestore)
+  -- | Holds 'UserSingleUseCode'
+, modelUserSingleUseCodes       :: !(Map UserSingleUseCodeId UserSingleUseCode)
+  -- | Holds 'AuthUserGroup'
+, modelAuthUserGroups           :: !(Map AuthUserGroupId AuthUserGroup)
+  -- | Holds 'AuthUserGroupUsers'
+, modelAuthUserGroupUsers       :: !(Map AuthUserGroupUsersId AuthUserGroupUsers)
+  -- | Holds 'AuthUserGroupPerms'
+, modelAuthUserGroupPerms       :: !(Map AuthUserGroupPermsId AuthUserGroupPerms)
+  -- | Holds next id for entities
+, modelNextUserImplId           :: !Int64
+-- | Holds next id for entities
+, modelNextUserPermId           :: !Int64
+-- | Holds next id for entities
+, modelNextAuthTokenId          :: !Int64
+-- | Holds next id for entities
+, modelNextUserRestoreId        :: !Int64
+-- | Holds next id for entities
+, modelNextUserSingleUseCodeId  :: !Int64
+-- | Holds next id for entities
+, modelNextAuthUserGroupId      :: !Int64
+-- | Holds next id for entities
+, modelNextAuthUserGroupUserId  :: !Int64
+-- | Holds next id for entities
+, modelNextAuthUserGroupPermId  :: !Int64
+}
+
+-- | Defines empty model for new database
+newModel :: Model
+newModel = Model {
+    modelUsers = mempty
+  , modelUsersByLogin = mempty
+  , modelUserPerms = mempty
+  , modelAuthTokens = mempty
+  , modelUserRestores = mempty
+  , modelUserSingleUseCodes = mempty
+  , modelAuthUserGroups = mempty
+  , modelAuthUserGroupUsers = mempty
+  , modelAuthUserGroupPerms = mempty
+  , modelNextUserImplId = 0
+  , modelNextUserPermId = 0
+  , modelNextAuthTokenId = 0
+  , modelNextUserRestoreId = 0
+  , modelNextUserSingleUseCodeId = 0
+  , modelNextAuthUserGroupId = 0
+  , modelNextAuthUserGroupUserId = 0
+  , modelNextAuthUserGroupPermId = 0
+  }
+
+-- | The end user should implement this for his global type
+class HasModelRead a where
+  askModel :: a -> Model
+
+-- | The end user should implement this fot his global type
+class HasModelRead a => HasModelWrite a where
+  putModel :: a -> Model -> a
+
+-- | The end user should inline this TH in his code
+makeModelAcidic :: Name -> DecsQ
+makeModelAcidic globalStateName = makeAcidic globalStateName [
+    mkName "getUserImpl"
+  , mkName "getUserImplByLogin"
+  , mkName "listUsersPaged"
+  , mkName "getUserImplPermissions"
+  , mkName "deleteUserPermissions"
+  , mkName "insertUserPerm"
+  , mkName "insertUserImpl"
+  , mkName "replaceUserImpl"
+  , mkName "deleteUserImpl"
+  , mkName "hasPerm"
+  , mkName "getFirstUserByPerm"
+  , mkName "selectUserImplGroups"
+  , mkName "clearUserImplGroups"
+  , mkName "insertAuthUserGroup"
+  , mkName "insertAuthUserGroupUsers"
+  , mkName "insertAuthUserGroupPerms"
+  , mkName "getAuthUserGroup"
+  , mkName "listAuthUserGroupPermissions"
+  , mkName "listAuthUserGroupUsers"
+  , mkName "replaceAuthUserGroup"
+  , mkName "clearAuthUserGroupUsers"
+  , mkName "clearAuthUserGroupPerms"
+  , mkName "deleteAuthUserGroup"
+  , mkName "listGroupsPaged"
+  , mkName "setAuthUserGroupName"
+  , mkName "setAuthUserGroupParent"
+  , mkName "insertSingleUseCode"
+  , mkName "setSingleUseCodeUsed"
+  , mkName "getUnusedCode"
+  , mkName "invalidatePermamentCodes"
+  , mkName "selectLastRestoreCode"
+  , mkName "insertUserRestore"
+  , mkName "findRestoreCode"
+  , mkName "replaceRestoreCode"
+  , mkName "findAuthToken"
+  , mkName "findAuthTokenByValue"
+  , mkName "insertAuthToken"
+  , mkName "replaceAuthToken"
+  ]
+
+instance HasModelRead Model where
+  askModel = id
+
+instance HasModelWrite Model where
+  putModel = const id
+
+asksM :: HasModelRead a => (Model -> b) -> Query a b
+asksM f = fmap (f . askModel) ask
+
+modifyM :: HasModelWrite a => (Model -> Model) -> Update a ()
+modifyM f = modify' (\a -> putModel a . f . askModel $ a)
+
+getM :: HasModelWrite a => Update a Model
+getM = fmap askModel get
+
+putM :: HasModelWrite a => Model -> Update a ()
+putM m = modifyM (const m)
+
+-- | Mixin queries to work with auth state
+deriveQueries :: Name -> DecsQ
+deriveQueries globalStateName = [d|
+    -- | Getting user from storage
+    getUserImpl :: HasModelRead $a => UserImplId -> Query $a (Maybe UserImpl)
+    getUserImpl i = M.lookup i <$> asksM modelUsers
+
+    -- | Getting user from storage by login
+    getUserImplByLogin :: HasModelRead $a => Login -> Query $a (Maybe (WithId UserImplId UserImpl))
+    getUserImplByLogin l = M.lookup l <$> asksM modelUsersByLogin
+
+    -- | Helper to get page from map
+    getPagedList :: Ord i => Page -> PageSize -> Map i a -> ([WithId i a], Word)
+    getPagedList p s m = (uncurry WithField <$> es, fromIntegral $ F.length m)
+      where
+        es = take (fromIntegral s) . drop (fromIntegral $ p * s) . sortBy (comparing fst) . M.toList $ m
+
+    -- | Get paged list of users and total count of users
+    listUsersPaged :: HasModelRead $a => Page -> PageSize -> Query $a ([WithId UserImplId UserImpl], Word)
+    listUsersPaged p s = getPagedList p s <$> asksM modelUsers
+
+    -- | Get user permissions, ascending by tag
+    getUserImplPermissions :: HasModelRead $a => UserImplId -> Query $a [WithId UserPermId UserPerm]
+    getUserImplPermissions i = fmap (uncurry WithField) . M.toList . M.filter ((i ==) . userPermUser) <$> asksM modelUserPerms
+
+    -- | Delete user permissions
+    deleteUserPermissions :: HasModelWrite $a => UserImplId -> Update $a ()
+    deleteUserPermissions i = modifyM $ \m -> m { modelUserPerms = f $ modelUserPerms m }
+      where
+        f m = m `M.difference` M.filter ((i ==) . userPermUser) m
+
+    -- | Insertion of new user permission
+    insertUserPerm :: HasModelWrite $a => UserPerm -> Update $a UserPermId
+    insertUserPerm p = do
+      m <- getM
+      let
+        i = toKey $ modelNextUserPermId m
+        perms = M.insert i p . modelUserPerms $ m
+        m' = m { modelUserPerms = perms, modelNextUserPermId = modelNextUserPermId m + 1 }
+      m' `seq` putM m'
+      return i
+
+    -- | Insertion of new user
+    insertUserImpl :: HasModelWrite $a => UserImpl -> Update $a UserImplId
+    insertUserImpl v = do
+      m <- getM
+      let
+        i = toKey $ modelNextUserImplId m
+        vals = M.insert i v . modelUsers $ m
+        vals' = M.insert (userImplLogin v) (WithField i v) . modelUsersByLogin $ m
+        m' = m { modelUsers = vals, modelUsersByLogin = vals', modelNextUserImplId = modelNextUserImplId m + 1 }
+      m' `seq` putM m'
+      return i
+
+    -- | Replace user with new value
+    replaceUserImpl :: HasModelWrite $a => UserImplId -> UserImpl -> Update $a ()
+    replaceUserImpl i v = modifyM $ \m -> m {
+        modelUsers = M.insert i v . modelUsers $ m
+      , modelUsersByLogin = M.insert (userImplLogin v) (WithField i v) . modelUsersByLogin $ m
+      }
+
+    -- | Delete user by id
+    deleteUserImpl :: HasModelWrite $a => UserImplId -> Update $a ()
+    deleteUserImpl i = do
+      deleteUserPermissions i
+      modifyM $ \m -> case M.lookup i . modelUsers $ m of
+        Nothing -> m
+        Just ui -> m {
+            modelUsers = M.delete i . modelUsers $ m
+          , modelUsersByLogin = M.delete (userImplLogin ui) . modelUsersByLogin $ m
+          }
+
+    -- | Check whether the user has particular permission
+    hasPerm :: HasModelRead $a => UserImplId -> Permission -> Query $a Bool
+    hasPerm i p = (> 0) . F.length . M.filter (\up -> userPermUser up == i && userPermPermission up == p) <$> asksM modelUserPerms
+
+    -- | Get any user with given permission
+    getFirstUserByPerm :: HasModelRead $a => Permission -> Query $a (Maybe (WithId UserImplId UserImpl))
+    getFirstUserByPerm perm = do
+      m <- asksM modelUserPerms
+      case M.toList . M.filter (\p -> userPermPermission p == perm) $ m of
+        [] -> return Nothing
+        ((_, p) : _) -> fmap (WithField $ userPermUser p) <$> getUserImpl (userPermUser p)
+
+    -- | Select user groups and sort them by ascending name
+    selectUserImplGroups :: HasModelRead $a => UserImplId -> Query $a [WithId AuthUserGroupUsersId AuthUserGroupUsers]
+    selectUserImplGroups i = fmap (uncurry WithField) . M.toList . M.filter ((i ==) . authUserGroupUsersUser) <$> asksM modelAuthUserGroupUsers
+
+    -- | Remove user from all groups
+    clearUserImplGroups :: HasModelWrite $a => UserImplId -> Update $a ()
+    clearUserImplGroups i = modifyM $ \m -> m { modelAuthUserGroupUsers = f $ modelAuthUserGroupUsers m }
+      where
+        f m = m `M.difference` M.filter ((i ==) . authUserGroupUsersUser) m
+
+    -- | Add new user group
+    insertAuthUserGroup :: HasModelWrite $a => AuthUserGroup -> Update $a AuthUserGroupId
+    insertAuthUserGroup v = do
+      m <- getM
+      let
+        i = toKey $ modelNextAuthUserGroupId m
+        vals = M.insert i v . modelAuthUserGroups $ m
+        m' = m { modelAuthUserGroups = vals, modelNextAuthUserGroupId = modelNextAuthUserGroupId m + 1 }
+      m' `seq` putM m'
+      return i
+
+    -- | Add user to given group
+    insertAuthUserGroupUsers :: HasModelWrite $a => AuthUserGroupUsers -> Update $a AuthUserGroupUsersId
+    insertAuthUserGroupUsers v = do
+      m <- getM
+      let
+        i = toKey $ modelNextAuthUserGroupUserId m
+        vals = M.insert i v . modelAuthUserGroupUsers $ m
+        m' = m { modelAuthUserGroupUsers = vals, modelNextAuthUserGroupUserId = modelNextAuthUserGroupUserId m + 1 }
+      m' `seq` putM m'
+      return i
+
+    -- | Add permission to given group
+    insertAuthUserGroupPerms :: HasModelWrite $a => AuthUserGroupPerms -> Update $a AuthUserGroupPermsId
+    insertAuthUserGroupPerms v = do
+      m <- getM
+      let
+        i = toKey $ modelNextAuthUserGroupPermId m
+        vals = M.insert i v . modelAuthUserGroupPerms $ m
+        m' = m { modelAuthUserGroupPerms = vals, modelNextAuthUserGroupPermId = modelNextAuthUserGroupPermId m + 1 }
+      m' `seq` putM m'
+      return i
+
+    -- | Find user group by id
+    getAuthUserGroup :: HasModelRead $a => AuthUserGroupId -> Query $a (Maybe AuthUserGroup)
+    getAuthUserGroup i = M.lookup i <$> asksM modelAuthUserGroups
+
+    -- | Get list of permissions of given group
+    listAuthUserGroupPermissions :: HasModelRead $a => AuthUserGroupId -> Query $a [WithId AuthUserGroupPermsId AuthUserGroupPerms]
+    listAuthUserGroupPermissions i = fmap (uncurry WithField) . M.toList . M.filter ((i ==) . authUserGroupPermsGroup) <$> asksM modelAuthUserGroupPerms
+
+    -- | Get list of all users of the group
+    listAuthUserGroupUsers :: HasModelRead $a => AuthUserGroupId -> Query $a [WithId AuthUserGroupUsersId AuthUserGroupUsers]
+    listAuthUserGroupUsers i = fmap (uncurry WithField) . M.toList . M.filter ((i ==) . authUserGroupUsersGroup) <$> asksM modelAuthUserGroupUsers
+
+    -- | Replace record of user group
+    replaceAuthUserGroup :: HasModelWrite $a => AuthUserGroupId -> AuthUserGroup -> Update $a ()
+    replaceAuthUserGroup i v = modifyM $ \m -> m { modelAuthUserGroups = M.insert i v $ modelAuthUserGroups m }
+
+    -- | Remove all users from group
+    clearAuthUserGroupUsers :: HasModelWrite $a => AuthUserGroupId -> Update $a ()
+    clearAuthUserGroupUsers i = modifyM $ \m -> m { modelAuthUserGroupUsers = f $ modelAuthUserGroupUsers m }
+      where
+        f m = m `M.difference` M.filter ((i ==) . authUserGroupUsersGroup) m
+
+    -- | Remove all permissions from group
+    clearAuthUserGroupPerms :: HasModelWrite $a => AuthUserGroupId -> Update $a ()
+    clearAuthUserGroupPerms i = modifyM $ \m -> m { modelAuthUserGroupPerms = f $ modelAuthUserGroupPerms m }
+      where
+        f m = m `M.difference` M.filter ((i ==) . authUserGroupPermsGroup) m
+
+    -- | Delete user group from storage
+    deleteAuthUserGroup :: HasModelWrite $a => AuthUserGroupId -> Update $a ()
+    deleteAuthUserGroup i = do
+      clearAuthUserGroupUsers i
+      clearAuthUserGroupPerms i
+      modifyM $ \m -> m { modelAuthUserGroups = M.delete i $ modelAuthUserGroups m }
+
+    -- | Get paged list of user groups with total count
+    listGroupsPaged :: HasModelRead $a => Page -> PageSize -> Query $a ([WithId AuthUserGroupId AuthUserGroup], Word)
+    listGroupsPaged p s = getPagedList p s <$> asksM modelAuthUserGroups
+
+    -- | Set group name
+    setAuthUserGroupName :: HasModelWrite $a => AuthUserGroupId -> Text -> Update $a ()
+    setAuthUserGroupName i n = modifyM $ \m -> m { modelAuthUserGroups = M.adjust (\v -> v { authUserGroupName = n }) i $ modelAuthUserGroups m }
+
+    -- | Set group parent
+    setAuthUserGroupParent :: HasModelWrite $a => AuthUserGroupId -> Maybe AuthUserGroupId -> Update $a ()
+    setAuthUserGroupParent i p = modifyM $ \m -> m { modelAuthUserGroups = M.adjust (\v -> v { authUserGroupParent = p }) i $ modelAuthUserGroups m }
+
+    -- | Add new single use code
+    insertSingleUseCode :: HasModelWrite $a => UserSingleUseCode -> Update $a UserSingleUseCodeId
+    insertSingleUseCode v = do
+      m <- getM
+      let
+        i = toKey $ modelNextUserSingleUseCodeId m
+        vals = M.insert i v . modelUserSingleUseCodes $ m
+        m' = m { modelUserSingleUseCodes = vals, modelNextUserSingleUseCodeId = modelNextUserSingleUseCodeId m + 1 }
+      m' `seq` putM m'
+      return i
+
+    -- | Set usage time of the single use code
+    setSingleUseCodeUsed :: HasModelWrite $a => UserSingleUseCodeId -> Maybe UTCTime -> Update $a ()
+    setSingleUseCodeUsed i mt = modifyM $ \m -> m { modelUserSingleUseCodes = M.adjust (\v -> v { userSingleUseCodeUsed = mt }) i $ modelUserSingleUseCodes m }
+
+    -- | Find unused code for the user and expiration time greater than the given time
+    getUnusedCode :: HasModelRead $a => SingleUseCode -> UserImplId -> UTCTime -> Query $a (Maybe (WithId UserSingleUseCodeId UserSingleUseCode))
+    getUnusedCode c i t = fmap (uncurry WithField) . headMay . sorting . M.toList . M.filter f <$> asksM modelUserSingleUseCodes
+      where
+        sorting = sortBy (comparing $ Down . userSingleUseCodeExpire . snd)
+        f usc =
+             userSingleUseCodeValue usc == c
+          && userSingleUseCodeUser usc == i
+          && userSingleUseCodeUsed usc == Nothing
+          && (userSingleUseCodeExpire usc == Nothing || userSingleUseCodeExpire usc >= Just t)
+
+    -- | Invalidate all permament codes for user and set use time for them
+    invalidatePermamentCodes :: HasModelWrite $a => UserImplId -> UTCTime -> Update $a ()
+    invalidatePermamentCodes i t = modifyM $ \m -> m { modelUserSingleUseCodes = f $ modelUserSingleUseCodes m }
+      where
+        f m = (fmap invalidate . M.filter isPermament $ m) `M.union` m
+        invalidate su = su { userSingleUseCodeUsed = Just t }
+        isPermament usc =
+             userSingleUseCodeUser usc == i
+          && userSingleUseCodeUsed usc == Nothing
+          && userSingleUseCodeExpire usc == Nothing
+
+    -- | Select last valid restoration code by the given current time
+    selectLastRestoreCode :: HasModelRead $a => UserImplId -> UTCTime -> Query $a (Maybe (WithId UserRestoreId UserRestore))
+    selectLastRestoreCode i t = fmap (uncurry WithField) . headMay . sorting . M.toList . M.filter f <$> asksM modelUserRestores
+      where
+        sorting = sortBy (comparing $ Down . userRestoreExpire . snd)
+        f ur = userRestoreUser ur == i && userRestoreExpire ur > t
+
+    -- | Insert new restore code
+    insertUserRestore :: HasModelWrite $a => UserRestore -> Update $a UserRestoreId
+    insertUserRestore v = do
+      m <- getM
+      let
+        i = toKey $ modelNextUserRestoreId m
+        vals = M.insert i v . modelUserRestores $ m
+        m' = m { modelUserRestores = vals, modelNextUserRestoreId = modelNextUserRestoreId m + 1 }
+      m' `seq` putM m'
+      return i
+
+    -- | Find unexpired by the time restore code
+    findRestoreCode :: HasModelRead $a => UserImplId -> RestoreCode -> UTCTime -> Query $a (Maybe (WithId UserRestoreId UserRestore))
+    findRestoreCode i rc t = fmap (uncurry WithField) . headMay . sorting . M.toList . M.filter f <$> asksM modelUserRestores
+      where
+        sorting = sortBy (comparing $ Down . userRestoreExpire . snd)
+        f ur = userRestoreUser ur == i && userRestoreValue ur == rc && userRestoreExpire ur > t
+
+    -- | Replace restore code with new value
+    replaceRestoreCode :: HasModelWrite $a => UserRestoreId -> UserRestore -> Update $a ()
+    replaceRestoreCode i v = modifyM $ \m -> m { modelUserRestores = M.insert i v $ modelUserRestores m }
+
+    -- | Find first non-expired by the time token for user
+    findAuthToken :: HasModelRead $a => UserImplId -> UTCTime -> Query $a (Maybe (WithId AuthTokenId AuthToken))
+    findAuthToken i t = fmap (uncurry WithField) . headMay . M.toList . M.filter f <$> asksM modelAuthTokens
+      where
+        f atok = authTokenUser atok == i && authTokenExpire atok > t
+
+    -- | Find token by value
+    findAuthTokenByValue :: HasModelRead $a => SimpleToken -> Query $a (Maybe (WithId AuthTokenId AuthToken))
+    findAuthTokenByValue v = fmap (uncurry WithField) . headMay . M.toList . M.filter f <$> asksM modelAuthTokens
+      where
+        f atok = authTokenValue atok == v
+
+    -- | Insert new token
+    insertAuthToken :: HasModelWrite $a => AuthToken -> Update $a AuthTokenId
+    insertAuthToken v = do
+      m <- getM
+      let
+        i = toKey $ modelNextAuthTokenId m
+        vals = M.insert i v . modelAuthTokens $ m
+        m' = m { modelAuthTokens = vals, modelNextAuthTokenId = modelNextAuthTokenId m + 1 }
+      m' `seq` putM m'
+      return i
+
+    -- | Replace auth token with new value
+    replaceAuthToken :: HasModelWrite $a => AuthTokenId -> AuthToken -> Update $a ()
+    replaceAuthToken i v = modifyM $ \m -> m { modelAuthTokens = M.insert i v $ modelAuthTokens m }
+    |]
+  where
+    a = conT globalStateName
+
+deriveSafeCopy 0 'base ''UserImplId
+deriveSafeCopy 0 'base ''UserImpl
+deriveSafeCopy 0 'base ''UserPermId
+deriveSafeCopy 0 'base ''UserPerm
+deriveSafeCopy 0 'base ''AuthTokenId
+deriveSafeCopy 0 'base ''AuthToken
+deriveSafeCopy 0 'base ''UserRestoreId
+deriveSafeCopy 0 'base ''UserRestore
+deriveSafeCopy 0 'base ''UserSingleUseCodeId
+deriveSafeCopy 0 'base ''UserSingleUseCode
+deriveSafeCopy 0 'base ''AuthUserGroupId
+deriveSafeCopy 0 'base ''AuthUserGroup
+deriveSafeCopy 0 'base ''AuthUserGroupUsersId
+deriveSafeCopy 0 'base ''AuthUserGroupUsers
+deriveSafeCopy 0 'base ''AuthUserGroupPermsId
+deriveSafeCopy 0 'base ''AuthUserGroupPerms
+deriveSafeCopy 0 'base ''Model
+
+instance (SafeCopy k, SafeCopy v) => SafeCopy (WithField i k v) where
+  putCopy (WithField k v) = contain $ do
+    safePut k
+    safePut v
+  getCopy = contain $ WithField
+    <$> safeGet
+    <*> safeGet